lib/Frey/Introspect.pm

package Frey::Introspect;

use Moose;
use Carp;
#use Moose::Meta::Role;
#use Moose::Meta::Class;
use Data::Dump qw/dump/;
use File::Slurp;
use List::Util;

use lib 'lib';

extends 'Frey';
with 'Frey::Web';

has 'package' => (
        is => 'rw',
        isa => 'Str',
        required => 1,
);

has 'path' => (
        is => 'rw',
);

=head2 joose

  my $js = $o->joose( 'Some::Package' );

=cut

sub joose {
        my ($self) = @_;

        my ( $class, $meta, $is_role ) = $self->load_package;

        if ( ! $is_role ) {
                my @superclasses = map{ $_->meta->name }
                        grep { $_ ne 'Moose::Object' } $meta->superclasses;
                warn "superclasses ",dump( @superclasses ) if $self->debug;
        }

        my $out;

        my ( $m, $c ) = split(/::/, $class->name, 2);
        my $filename = $m . '.' . ( $c ? "$c." : '' ) . 'js';

        $out .= "Module(\"$m\", function (m) {\n\tClass(\"$c\", {\n\t\thas: {\n";

        foreach ( $class->get_attribute_list ) {
                $out .= "\t\t\t$_: {\n";

                my $attr = $class->get_attribute($_);
                my $is = $attr->_is_metadata;
                $out .= "\t\t\t\tis: \"$is\",\n" if defined $is;
                $out .= "\t\t\t\tlazy: true,\n" if $attr->is_lazy;
                $out .= "\t\t\t\trequired: true,\n" if $attr->is_required;
                $out .= "\t\t\t\tinit: \"" . $attr->init_arg . "\",\n" if $attr->init_arg;      # FIXME

                if( defined(my $isa = $attr->_isa_metadata) ){
                        if( blessed $isa ){
                                while( blessed $isa ){
                                        $isa = $isa->name;
                                }
                        }
                        $isa =~ s/\s+\|\s+undef//gi;
                        $out .= "\t\t\t\tisa: Moose.$isa,\n";
                }


                $out .= "\t\t\t},\n";

        }

        $out .= "\t\t},\n\t\tmeta: Frey.HTML,
                classMethods: {
                        renderHTML: function () {
                                return new Joose.SimpleRequest().getText(\"/~/" . $self->package . "\")
                        },\n";

        $out .= "\t\t},\n";

        $out .= "\t}),\n";

        $out =~ s/,\n$/\n/;
        $out .= "});\n";

        $out .= "\nconsole.log( 'loaded " . $class->name . " from $filename' );\n";

        warn "method_list = ",dump( $class->get_method_list ) if $self->debug;

#       print $out;
        my $path = "static/blib/$filename";
        write_file( $path, $out );
        warn "# created $path\n";
        $self->path( $path );

        return $out;
}

=head2 methods

  my @methods = $o->methods;

=cut

sub methods {
        my $self = shift;

        my ( $class, $meta, $is_role ) = $self->load_package;

        my $attr;
        $attr->{$_}++ foreach $class->get_attribute_list;
        my @methods = grep { ! defined($attr->{$_}) } $class->get_method_list;
        warn "# methods = ",dump( @methods ) if $self->debug;

        return @methods;
}

use Frey::ClassLoader;

sub load_package {
        my $self = shift;
        return Frey::ClassLoader->load_package( $self->package );
}


=head1 OUTPUT GENERATION

=head2 html

  $o->html( $request );

=cut

sub html {
        my ( $self, $request ) = @_;

        while (1) {

                my $js = $self->head_javascript;
                $js .= << '__END_OF_JS__';
<script type="text/javascript">
joose.loadComponents("../lib")

function $(id) {
        return document.getElementById(id)
}

</script>
__END_OF_JS__

                my ( $class, $meta, $is_role ) = $self->load_package;

                my $methods;
                if ( $class->can('meta') ) {
                        $methods = dom2html(
                                ul => [
                                        map { (
                                                li => [ a => { href => '/~/' . $self->package . '/' . $_ } => [ $_ ] ]
                                        ) } $self->methods
                                ]
                        );
                        $methods = "<h2>Methods</h2>$methods" if $methods;
                } else {
                        $methods = '<b>not introspectable</b>';
                }

                my $attributes;
                if ( $class->get_attribute_list ) {
                        $attributes = dom2html(
                                table => [
                                        map {
                                                my $attr = $class->get_attribute($_);
                                                warn "## $_ ", $attr->is_required ? 'required' : 'optional';
                                                ( tr => [
                                                        td => [ a => { href => '/~/' . $self->package . '/' . $_ } => [ $_ ] ],
                                                        td => [ $attr->is_required ? ' <b>required</b>' : '' ],
                                                ] )
                                        } $class->get_attribute_list
                                ],
                        );
                        $attributes = "<h2>Attributes</h2>$attributes" if $attributes;
                } else {
                        $attributes = '<b>no attributes</b>';
                }


                my $html = dom2html(
                        html => [
                                head => [
                                        link => { rel=>"stylesheet", href=>"/static/app.css", type=>"text/css", media=>"screen" },
                                        $js,
                                        title => [ 'Introspect ', $self->package ],
                                ],
                                body => [
                                        h1 => [ $self->package ],
                                        $methods,
                                        $attributes,
                                ],
                        ]
                );

                $request->print($html);
                warn "# >>> html ",length($html)," bytes\n";
                $request->next;
        }
        warn "# exit html";
}

=head1 SEE ALSO

L<MooseX::AutoDoc> on which this code is based

=cut

1;
1	dpavlin	49	package Frey::Introspect;
2
3			use Moose;
4			use Carp;
5	dpavlin	100	#use Moose::Meta::Role;
6			#use Moose::Meta::Class;
7	dpavlin	49	use Data::Dump qw/dump/;
8			use File::Slurp;
9	dpavlin	51	use List::Util;
10	dpavlin	49
11	dpavlin	55	use lib 'lib';
12	dpavlin	53
13	dpavlin	49	extends 'Frey';
14	dpavlin	100	with 'Frey::Web';
15	dpavlin	49
16			has 'package' => (
17			is => 'rw',
18			isa => 'Str',
19			required => 1,
20			);
21
22	dpavlin	51	has 'path' => (
23			is => 'rw',
24			);
25
26	dpavlin	53	=head2 joose
27
28			my $js = $o->joose( 'Some::Package' );
29
30			=cut
31
32			sub joose {
33			my ($self) = @_;
34
35			my ( $class, $meta, $is_role ) = $self->load_package;
36
37			if ( ! $is_role ) {
38	dpavlin	50	my @superclasses = map{ $_->meta->name }
39			grep { $_ ne 'Moose::Object' } $meta->superclasses;
40	dpavlin	100	warn "superclasses ",dump( @superclasses ) if $self->debug;
41	dpavlin	50	}
42	dpavlin	49
43			my $out;
44
45			my ( $m, $c ) = split(/::/, $class->name, 2);
46	dpavlin	51	my $filename = $m . '.' . ( $c ? "$c." : '' ) . 'js';
47	dpavlin	49
48			$out .= "Module(\"$m\", function (m) {\n\tClass(\"$c\", {\n\t\thas: {\n";
49
50			foreach ( $class->get_attribute_list ) {
51			$out .= "\t\t\t$_: {\n";
52
53	dpavlin	50	my $attr = $class->get_attribute($_);
54			my $is = $attr->_is_metadata;
55			$out .= "\t\t\t\tis: \"$is\",\n" if defined $is;
56			$out .= "\t\t\t\tlazy: true,\n" if $attr->is_lazy;
57			$out .= "\t\t\t\trequired: true,\n" if $attr->is_required;
58			$out .= "\t\t\t\tinit: \"" . $attr->init_arg . "\",\n" if $attr->init_arg; # FIXME
59
60			if( defined(my $isa = $attr->_isa_metadata) ){
61			if( blessed $isa ){
62			while( blessed $isa ){
63			$isa = $isa->name;
64			}
65			}
66			$isa =~ s/\s+\\|\s+undef//gi;
67			$out .= "\t\t\t\tisa: Moose.$isa,\n";
68			}
69
70
71	dpavlin	49	$out .= "\t\t\t},\n";
72
73			}
74
75	dpavlin	51	$out .= "\t\t},\n\t\tmeta: Frey.HTML,
76			classMethods: {
77			renderHTML: function () {
78	dpavlin	66	return new Joose.SimpleRequest().getText(\"/~/" . $self->package . "\")
79	dpavlin	51	},\n";
80
81	dpavlin	49	$out .= "\t\t},\n";
82
83			$out .= "\t}),\n";
84	dpavlin	50
85			$out =~ s/,\n$/\n/;
86	dpavlin	49	$out .= "});\n";
87
88			$out .= "\nconsole.log( 'loaded " . $class->name . " from $filename' );\n";
89
90	dpavlin	100	warn "method_list = ",dump( $class->get_method_list ) if $self->debug;
91	dpavlin	49
92	dpavlin	51	# print $out;
93	dpavlin	49	my $path = "static/blib/$filename";
94			write_file( $path, $out );
95			warn "# created $path\n";
96	dpavlin	51	$self->path( $path );
97
98			return $out;
99	dpavlin	49	}
100
101	dpavlin	53	=head2 methods
102
103			my @methods = $o->methods;
104
105			=cut
106
107			sub methods {
108			my $self = shift;
109
110			my ( $class, $meta, $is_role ) = $self->load_package;
111
112			my $attr;
113			$attr->{$_}++ foreach $class->get_attribute_list;
114			my @methods = grep { ! defined($attr->{$_}) } $class->get_method_list;
115	dpavlin	100	warn "# methods = ",dump( @methods ) if $self->debug;
116	dpavlin	53
117			return @methods;
118			}
119
120	dpavlin	100	use Frey::ClassLoader;
121
122			sub load_package {
123			my $self = shift;
124			return Frey::ClassLoader->load_package( $self->package );
125			}
126
127
128	dpavlin	53	=head1 OUTPUT GENERATION
129
130			=head2 html
131
132			$o->html( $request );
133
134			=cut
135
136			sub html {
137			my ( $self, $request ) = @_;
138
139			while (1) {
140
141	dpavlin	100	my $js = $self->head_javascript;
142	dpavlin	54	$js .= << '__END_OF_JS__';
143			<script type="text/javascript">
144			joose.loadComponents("../lib")
145	dpavlin	53
146	dpavlin	54	function $(id) {
147			return document.getElementById(id)
148			}
149
150			</script>
151			__END_OF_JS__
152
153	dpavlin	100	my ( $class, $meta, $is_role ) = $self->load_package;
154	dpavlin	54
155			my $methods;
156	dpavlin	53	if ( $class->can('meta') ) {
157	dpavlin	100	$methods = dom2html(
158	dpavlin	53	ul => [
159			map { (
160	dpavlin	54	li => [ a => { href => '/~/' . $self->package . '/' . $_ } => [ $_ ] ]
161	dpavlin	53	) } $self->methods
162			]
163	dpavlin	100	);
164	dpavlin	116	$methods = "<h2>Methods</h2>$methods" if $methods;
165	dpavlin	53	} else {
166	dpavlin	54	$methods = '<b>not introspectable</b>';
167	dpavlin	53	}
168
169	dpavlin	100	my $attributes;
170			if ( $class->get_attribute_list ) {
171			$attributes = dom2html(
172			table => [
173			map {
174			my $attr = $class->get_attribute($_);
175			warn "## $_ ", $attr->is_required ? 'required' : 'optional';
176			( tr => [
177			td => [ a => { href => '/~/' . $self->package . '/' . $_ } => [ $_ ] ],
178			td => [ $attr->is_required ? ' <b>required</b>' : '' ],
179			] )
180			} $class->get_attribute_list
181			],
182			);
183	dpavlin	116	$attributes = "<h2>Attributes</h2>$attributes" if $attributes;
184	dpavlin	100	} else {
185			$attributes = '<b>no attributes</b>';
186			}
187	dpavlin	54
188	dpavlin	100
189			my $html = dom2html(
190	dpavlin	53	html => [
191			head => [
192			link => { rel=>"stylesheet", href=>"/static/app.css", type=>"text/css", media=>"screen" },
193	dpavlin	54	$js,
194			title => [ 'Introspect ', $self->package ],
195	dpavlin	53	],
196			body => [
197	dpavlin	54	h1 => [ $self->package ],
198			$methods,
199			$attributes,
200	dpavlin	53	],
201			]
202			);
203
204	dpavlin	100	$request->print($html);
205			warn "# >>> html ",length($html)," bytes\n";
206	dpavlin	53	$request->next;
207			}
208			warn "# exit html";
209			}
210
211	dpavlin	49	=head1 SEE ALSO
212
213			L<MooseX::AutoDoc> on which this code is based
214
215			=cut
216
217			1;