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;

=cut

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

        my ( $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(/::/, $self->package, 2);
        my $filename = $m . '.' . ( $c ? "$c." : '' ) . 'js';

        $c ||= '';

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

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

                my $attr = $meta->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 " . $self->package . " from $filename' );\n";

        warn "method_list = ",dump( $meta->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 ( $meta, $is_role ) = $self->load_package;

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

        return sort @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 ) = @_;

        $self->add_css( 'static/introspect.css' );
        warn "## css = ",dump( $self->css );

        while (1) {

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

                my $package = $self->package;

                my @methods;
                @methods = map { qq|<td><a href="/~/$package/$_">$_</a></td>| } $self->methods;

                my @attributes;
                if ( $meta->get_attribute_list ) {
                @attributes = map {
                                my $attr = $meta->get_attribute($_);
                                my ( $before, $title, $after ) = ( '', '', '' );
                                ( $before, $title, $after ) = ( '<b>', ' title="required"', '</b>' ) if $attr->is_required;
                                qq|<td>$before<a href="/~/$package/?$_">$_</a>$after</td>|
                        } sort $meta->get_attribute_list
                }

                my $table = qq|<table><tr><th>Methods</th><th>Attributes</th></tr>|;
                while ( @methods || @attributes ) {
                        my ($m,$a) = ( shift @methods, shift @attributes );
                        $m ||= '<td></td>';
                        $a ||= '<td></td>';
                        $table .= qq|<tr>$m$a</tr>|;
                }
                $table .= qq|</table>|;

                my $classes =
                        qq|<div class="classes">| .
                        Frey::ClassBrowser->new->markup .
                        qq|</div>|;

                my ( $superclasses, $roles ) = ( '<b>Role</b>', '' );
                if ( ! $is_role ) {
                        if ( $meta->superclasses ) {
                                $superclasses = 'Superclasses: ' .
                                        join(', ',
                                                map { my $s = $_->meta->name; qq|<a href="/~/$s">$s</a>| }
                                                #grep { $_ ne 'Moose::Object' }
                                                $meta->superclasses
                                        );
                        }
                }

                if ( $meta->can('roles') ) {
                        $roles = join(', ',
                                grep { ! m/\Q$package\E/ }      # skip me
                                map { my $r = $_->name; qq|<a href="/~/$r">$r</a>| }
                                $meta->calculate_all_roles
                        );
                        $roles = " with roles: $roles" if $roles;
                }

                my $pod = Frey::Pod->new( class => $package )->markup;

                my $html = $self->page(
                        title => "Introspect $package",
                        body => qq|<h1>$package</h1>|
                                . qq|$superclasses\n$roles\n|
                                . ( $pod ? qq|<a href="#___top" title="Skip to POD" style="font-size: 80%; color: #aaa;">&darr;pod&darr</a>| : '' )
                                . qq|$table\n$pod\n$classes|,

                );

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