/[Frey]/branches/mojo/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 /branches/mojo/lib/Frey/Introspect.pm

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

revision 51 by dpavlin, Thu Jul 3 19:51:18 2008 UTC revision 54 by dpavlin, Sat Jul 5 16:50:17 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(\"/~/${m}::${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 = Continuity::Widget::DomNode->create(
181                            map {
182                                    ( script => { type => 'text/javascript', src => $_ } )
183                            } @javascript
184                    )->to_string;
185    
186                    $js .= << '__END_OF_JS__';
187    <script type="text/javascript">
188    joose.loadComponents("../lib")
189    
190    function $(id) {
191            return document.getElementById(id)
192    }
193    
194    </script>
195    __END_OF_JS__
196    
197                    warn "# >>> js\n$js\n";
198    
199                    my $methods;
200    
201                    my ( $class, $meta, $is_role ) = $self->load_package();
202                    if ( $class->can('meta') ) {
203                            $methods = Continuity::Widget::DomNode->create(
204                                    ul => [
205                                            map { (
206                                                    li => [ a => { href => '/~/' . $self->package . '/' . $_ } => [ $_ ] ]
207                                            ) } $self->methods
208                                    ]
209                            )->to_string;
210                    } else {
211                            $methods = '<b>not introspectable</b>';
212                    }
213    
214                    my $attributes = Continuity::Widget::DomNode->create(
215                            ul => [
216                                    map {
217                                            my $attr = $class->get_attribute($_);
218                                            warn "## $_ ", $attr->is_required ? 'required' : 'optional';
219                                            ( li => [ a => { href => '/~/' . $self->package . '/' . $_ } => [ $_, ( $attr->is_required ? ' <b>required</b>' : '' ) ] ] )
220                                    } $class->get_attribute_list
221                            ],
222                    )->to_string;
223    
224                    my $doc = Continuity::Widget::DomNode->create(
225                            html => [
226                                    head => [
227                                            link => { rel=>"stylesheet", href=>"/static/app.css", type=>"text/css", media=>"screen" },
228                                            $js,
229                                            title => [ 'Introspect ', $self->package ],
230                                    ],
231                                    body => [
232                                            h1 => [ $self->package ],
233                                            h2 => [ 'Methods' ],
234                                            $methods,
235                                            h2 => [ 'Atrributes' ],
236                                            $attributes,
237                                    ],
238                            ]
239                    );
240    
241                    $request->print($doc->to_string);
242                    warn "# >>> html\n", $doc->to_string, "\n";
243                    $request->next;
244            }
245            warn "# exit html";
246    }
247    
248  =head1 SEE ALSO  =head1 SEE ALSO
249    
250  L<MooseX::AutoDoc> on which this code is based  L<MooseX::AutoDoc> on which this code is based
Legend:
Removed from v.51  
changed lines
  Added in v.54
  ViewVC Help
Powered by ViewVC 1.1.26