/[Frey]/trunk/lib/Frey/Introspect.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/Frey/Introspect.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 50 by dpavlin, Wed Jul 2 22:30:19 2008 UTC revision 53 by dpavlin, Sat Jul 5 15:19:55 2008 UTC
# Line 8  use Moose::Meta::Class; Line 8  use Moose::Meta::Class;
8  use Scalar::Util qw/blessed/;  use Scalar::Util qw/blessed/;
9  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
10  use File::Slurp;  use File::Slurp;
11    use List::Util;
12    
13    use Continuity::Widget::DomNode;
14    
15  extends 'Frey';  extends 'Frey';
16    
# Line 17  has 'package' => ( Line 20  has 'package' => (
20          required => 1,          required => 1,
21  );  );
22    
23  sub examine {  has 'path' => (
24          my ($self) = @_;          is => 'rw',
25    );
26    
27    =head2 load_package
28    
29      my ( $class, $meta, $is_role ) = $o->load_package( 'Some::Package' );
30    
31    =cut
32    
33    sub load_package {
34            my ( $self ) = @_;
35    
36          my $package = $self->package;          my $package = $self->package;
37    
# Line 35  sub examine { Line 48  sub examine {
48          eval { Class::MOP::load_class($package); };          eval { Class::MOP::load_class($package); };
49          confess "Failed to load package ${package} $@" if $@;          confess "Failed to load package ${package} $@" if $@;
50    
         #get on with analyzing the      package  
51          my $meta = $package->meta;          my $meta = $package->meta;
52          my $spec = {};  
53          my ($class, $is_role);          my ($class, $is_role);
54          if($package->meta->isa('Moose::Meta::Role')){          if($package->meta->isa('Moose::Meta::Role')){
55                  $is_role = 1;                  $is_role = 1;
# Line 47  sub examine { Line 59  sub examine {
59          } else {          } else {
60                  #roles don't have superclasses ...                  #roles don't have superclasses ...
61                  $class = $meta;                  $class = $meta;
62            }
63            return ( $class, $meta, $is_role );
64    }
65    
66    =head2 joose
67    
68      my $js = $o->joose( 'Some::Package' );
69    
70    =cut
71    
72    sub joose {
73            my ($self) = @_;
74    
75            my ( $class, $meta, $is_role ) = $self->load_package;
76    
77            if ( ! $is_role ) {
78                  my @superclasses = map{ $_->meta->name }                  my @superclasses = map{ $_->meta->name }
79                          grep { $_ ne 'Moose::Object' } $meta->superclasses;                          grep { $_ ne 'Moose::Object' } $meta->superclasses;
80                  warn "superclasses ",dump( @superclasses );                  warn "superclasses ",dump( @superclasses );
# Line 55  sub examine { Line 83  sub examine {
83          my $out;          my $out;
84    
85          my ( $m, $c ) = split(/::/, $class->name, 2);          my ( $m, $c ) = split(/::/, $class->name, 2);
86          my $filename = "$m.$c.js";          my $filename = $m . '.' . ( $c ? "$c." : '' ) . 'js';
87    
88          $out .= "Module(\"$m\", function (m) {\n\tClass(\"$c\", {\n\t\thas: {\n";          $out .= "Module(\"$m\", function (m) {\n\tClass(\"$c\", {\n\t\thas: {\n";
89    
# Line 84  sub examine { Line 112  sub examine {
112    
113          }          }
114    
115            $out .= "\t\t},\n\t\tmeta: Frey.HTML,
116                    classMethods: {
117                            renderHTML: function () {
118                                    return new Joose.SimpleRequest().getText(\"inspect?module=$m;class=$c\")
119                            },\n";
120    
121          $out .= "\t\t},\n";          $out .= "\t\t},\n";
122    
123          $out .= "\t}),\n";          $out .= "\t}),\n";
# Line 95  sub examine { Line 129  sub examine {
129    
130          warn $class->dump(2);          warn $class->dump(2);
131    
132          warn "get_attribute_list = ",dump( $class->get_attribute_list );          warn "method_list = ",dump( $class->get_method_list );
133  #       warn dump( map{ $class->get_attribute($_) } sort $class->get_attribute_list );          warn dump( map{ $class->get_method($_)->name } sort $class->get_method_list );
   
         warn dump( $class->get_method_list );  
134    
135          print $out;  #       print $out;
136          my $path = "static/blib/$filename";          my $path = "static/blib/$filename";
137          write_file( $path, $out );          write_file( $path, $out );
138          warn "# created $path\n";          warn "# created $path\n";
139            $self->path( $path );
140    
141            return $out;
142    }
143    
144    =head2 methods
145    
146      my @methods = $o->methods;
147    
148    =cut
149    
150    sub methods {
151            my $self = shift;
152    
153            my ( $class, $meta, $is_role ) = $self->load_package;
154    
155            my $attr;
156            $attr->{$_}++ foreach $class->get_attribute_list;
157            my @methods = grep { ! defined($attr->{$_}) } $class->get_method_list;
158            warn "# methods = ",dump( @methods );
159    
160            return @methods;
161    }
162    
163    =head1 OUTPUT GENERATION
164    
165    =head2 html
166    
167      $o->html( $request );
168    
169    =cut
170    
171    our @javascript = ( qw'
172    ../lib/Joose.js
173    ');
174    
175    sub html {
176            my ( $self, $request ) = @_;
177    
178            while (1) {
179    
180                    my $js = [ map {
181                            ( script => { type => 'text/javascript', src => $_ } )
182                    } @javascript ];
183                    warn "# js = ",dump( $js );
184    
185                    my $o;
186    
187                    my ( $class, $meta, $is_role ) = $self->load_package();
188                    if ( $class->can('meta') ) {
189                            $o = Continuity::Widget::DomNode->create(
190                                    ul => [
191                                            map { (
192                                                    li => [ a => { href => $_ } => [ $_ ] ]
193                                            ) } $self->methods
194                                    ]
195                            )->to_string;
196                    } else {
197                            $o = '<b>not introspectable</b>';
198                    }
199    
200                    warn "# o = ",dump( $o );
201                    
202                    my $doc = Continuity::Widget::DomNode->create(
203                            html => [
204                                    head => [
205                                            link => { rel=>"stylesheet", href=>"/static/app.css", type=>"text/css", media=>"screen" },
206    #                                       $js,
207                                    ],
208                                    body => [
209                                            h1 => [ 'Introspect ', $self->package ],
210                                            $o,
211                                    ],
212                            ]
213                    );
214    
215                    $request->print($doc->to_string);
216                    warn "# html = ", $doc->to_string;
217                    $request->next;
218            }
219            warn "# exit html";
220  }  }
221    
222  =head1 SEE ALSO  =head1 SEE ALSO
Legend:
Removed from v.50  
changed lines
  Added in v.53
  ViewVC Help
Powered by ViewVC 1.1.26