/[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 52 by dpavlin, Thu Jul 3 19:51:18 2008 UTC revision 53 by dpavlin, Sat Jul 5 15:19:55 2008 UTC
# Line 10  use Data::Dump qw/dump/; Line 10  use Data::Dump qw/dump/;
10  use File::Slurp;  use File::Slurp;
11  use List::Util;  use List::Util;
12    
13    use Continuity::Widget::DomNode;
14    
15  extends 'Frey';  extends 'Frey';
16    
17  has 'package' => (  has 'package' => (
# Line 18  has 'package' => ( Line 20  has 'package' => (
20          required => 1,          required => 1,
21  );  );
22    
 has 'renderHTML' => (  
         is => 'rw',  
         isa => 'Str',  
 );  
   
23  has 'path' => (  has 'path' => (
24          is => 'rw',          is => 'rw',
25  );  );
26    
27  =head2 examine  =head2 load_package
28    
29    my $js = $o->examine( 'Some::Package' );    my ( $class, $meta, $is_role ) = $o->load_package( 'Some::Package' );
30    
31  =cut  =cut
32    
33  sub examine {  sub load_package {
34          my ($self) = @_;          my ( $self ) = @_;
35    
36          my $package = $self->package;          my $package = $self->package;
37    
# Line 51  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 63  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 103  sub examine { Line 115  sub examine {
115          $out .= "\t\t},\n\t\tmeta: Frey.HTML,          $out .= "\t\t},\n\t\tmeta: Frey.HTML,
116                  classMethods: {                  classMethods: {
117                          renderHTML: function () {                          renderHTML: function () {
118                                  return new Joose.SimpleRequest().getText(\"json?class=$c\")                                  return new Joose.SimpleRequest().getText(\"inspect?module=$m;class=$c\")
119                          },\n";                          },\n";
120    
121          $out .= "\t\t},\n";          $out .= "\t\t},\n";
# Line 117  sub examine { Line 129  sub examine {
129    
130          warn $class->dump(2);          warn $class->dump(2);
131    
         my $attr;  
         $attr->{$_}++ foreach $class->get_attribute_list;  
         my @methods = grep { ! defined($attr->{$_}) } $class->get_method_list;  
         warn "methods = ",dump( @methods );  
   
132          warn "method_list = ",dump( $class->get_method_list );          warn "method_list = ",dump( $class->get_method_list );
133          warn dump( map{ $class->get_method($_)->name } sort $class->get_method_list );          warn dump( map{ $class->get_method($_)->name } sort $class->get_method_list );
134    
# Line 134  sub examine { Line 141  sub examine {
141          return $out;          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
223    
224  L<MooseX::AutoDoc> on which this code is based  L<MooseX::AutoDoc> on which this code is based
Legend:
Removed from v.52  
changed lines
  Added in v.53
  ViewVC Help
Powered by ViewVC 1.1.26