/[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 66 by dpavlin, Wed Jul 9 12:08:07 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    use lib 'lib';
15    
16  extends 'Frey';  extends 'Frey';
17    
# Line 17  has 'package' => ( Line 21  has 'package' => (
21          required => 1,          required => 1,
22  );  );
23    
24  sub examine {  has 'path' => (
25          my ($self) = @_;          is => 'rw',
26    );
27    
28    =head2 load_package
29    
30      my ( $class, $meta, $is_role ) = $o->load_package( 'Some::Package' );
31    
32    =cut
33    
34    sub load_package {
35            my ( $self ) = @_;
36    
37          my $package = $self->package;          my $package = $self->package;
38    
# Line 32  sub examine { Line 46  sub examine {
46          my @roles_to_apply;          my @roles_to_apply;
47          $rmeta->add_method("apply", sub{push(@roles_to_apply, [@_])});          $rmeta->add_method("apply", sub{push(@roles_to_apply, [@_])});
48          #load the package with the hacked Moose::Meta::Role          #load the package with the hacked Moose::Meta::Role
         eval { Class::MOP::load_class($package); };  
         confess "Failed to load package ${package} $@" if $@;  
49    
50          #get on with analyzing the      package          #eval { Class::MOP::load_class($package); };
51            #confess "Failed to load package ${package} $@" if $@;
52            Class::MOP::load_class($package);
53    
54          my $meta = $package->meta;          my $meta = $package->meta;
55          my $spec = {};  
56          my ($class, $is_role);          my ($class, $is_role);
57          if($package->meta->isa('Moose::Meta::Role')){          if($package->meta->isa('Moose::Meta::Role')){
58                  $is_role = 1;                  $is_role = 1;
# Line 47  sub examine { Line 62  sub examine {
62          } else {          } else {
63                  #roles don't have superclasses ...                  #roles don't have superclasses ...
64                  $class = $meta;                  $class = $meta;
65            }
66            return ( $class, $meta, $is_role );
67    }
68    
69    =head2 joose
70    
71      my $js = $o->joose( 'Some::Package' );
72    
73    =cut
74    
75    sub joose {
76            my ($self) = @_;
77    
78            my ( $class, $meta, $is_role ) = $self->load_package;
79    
80            if ( ! $is_role ) {
81                  my @superclasses = map{ $_->meta->name }                  my @superclasses = map{ $_->meta->name }
82                          grep { $_ ne 'Moose::Object' } $meta->superclasses;                          grep { $_ ne 'Moose::Object' } $meta->superclasses;
83                  warn "superclasses ",dump( @superclasses );                  warn "superclasses ",dump( @superclasses );
# Line 55  sub examine { Line 86  sub examine {
86          my $out;          my $out;
87    
88          my ( $m, $c ) = split(/::/, $class->name, 2);          my ( $m, $c ) = split(/::/, $class->name, 2);
89          my $filename = "$m.$c.js";          my $filename = $m . '.' . ( $c ? "$c." : '' ) . 'js';
90    
91          $out .= "Module(\"$m\", function (m) {\n\tClass(\"$c\", {\n\t\thas: {\n";          $out .= "Module(\"$m\", function (m) {\n\tClass(\"$c\", {\n\t\thas: {\n";
92    
# Line 84  sub examine { Line 115  sub examine {
115    
116          }          }
117    
118            $out .= "\t\t},\n\t\tmeta: Frey.HTML,
119                    classMethods: {
120                            renderHTML: function () {
121                                    return new Joose.SimpleRequest().getText(\"/~/" . $self->package . "\")
122                            },\n";
123    
124          $out .= "\t\t},\n";          $out .= "\t\t},\n";
125    
126          $out .= "\t}),\n";          $out .= "\t}),\n";
# Line 95  sub examine { Line 132  sub examine {
132    
133          warn $class->dump(2);          warn $class->dump(2);
134    
135          warn "get_attribute_list = ",dump( $class->get_attribute_list );          warn "method_list = ",dump( $class->get_method_list );
136  #       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 );  
137    
138          print $out;  #       print $out;
139          my $path = "static/blib/$filename";          my $path = "static/blib/$filename";
140          write_file( $path, $out );          write_file( $path, $out );
141          warn "# created $path\n";          warn "# created $path\n";
142            $self->path( $path );
143    
144            return $out;
145    }
146    
147    =head2 methods
148    
149      my @methods = $o->methods;
150    
151    =cut
152    
153    sub methods {
154            my $self = shift;
155    
156            my ( $class, $meta, $is_role ) = $self->load_package;
157    
158            my $attr;
159            $attr->{$_}++ foreach $class->get_attribute_list;
160            my @methods = grep { ! defined($attr->{$_}) } $class->get_method_list;
161            warn "# methods = ",dump( @methods );
162    
163            return @methods;
164    }
165    
166    =head1 OUTPUT GENERATION
167    
168    =head2 html
169    
170      $o->html( $request );
171    
172    =cut
173    
174    our @javascript = ( qw'
175    ../lib/Joose.js
176    ');
177    
178    sub html {
179            my ( $self, $request ) = @_;
180    
181            while (1) {
182    
183                    my $js = Continuity::Widget::DomNode->create(
184                            map {
185                                    ( script => { type => 'text/javascript', src => $_ } )
186                            } @javascript
187                    )->to_string;
188    
189                    $js .= << '__END_OF_JS__';
190    <script type="text/javascript">
191    joose.loadComponents("../lib")
192    
193    function $(id) {
194            return document.getElementById(id)
195    }
196    
197    </script>
198    __END_OF_JS__
199    
200                    warn "# >>> js\n$js\n" if $self->debug;
201    
202                    my ( $class, $meta, $is_role ) = $self->load_package();
203    
204                    my $methods;
205                    if ( $class->can('meta') ) {
206                            $methods = Continuity::Widget::DomNode->create(
207                                    ul => [
208                                            map { (
209                                                    li => [ a => { href => '/~/' . $self->package . '/' . $_ } => [ $_ ] ]
210                                            ) } $self->methods
211                                    ]
212                            )->to_string;
213                    } else {
214                            $methods = '<b>not introspectable</b>';
215                    }
216    
217                    my $attributes = Continuity::Widget::DomNode->create(
218                            ul => [
219                                    map {
220                                            my $attr = $class->get_attribute($_);
221                                            warn "## $_ ", $attr->is_required ? 'required' : 'optional';
222                                            ( li => [ a => { href => '/~/' . $self->package . '/' . $_ } => [ $_ ], ( $attr->is_required ? ' <b>required</b>' : '' ) ] )
223                                    } $class->get_attribute_list
224                            ],
225                    )->to_string;
226    
227                    my $doc = Continuity::Widget::DomNode->create(
228                            html => [
229                                    head => [
230                                            link => { rel=>"stylesheet", href=>"/static/app.css", type=>"text/css", media=>"screen" },
231                                            $js,
232                                            title => [ 'Introspect ', $self->package ],
233                                    ],
234                                    body => [
235                                            h1 => [ $self->package ],
236                                            h2 => [ 'Methods' ],
237                                            $methods,
238                                            h2 => [ 'Atrributes' ],
239                                            $attributes,
240                                    ],
241                            ]
242                    );
243    
244                    $request->print($doc->to_string);
245                    warn "# >>> html\n", $doc->to_string, "\n";
246                    $request->next;
247            }
248            warn "# exit html";
249  }  }
250    
251  =head1 SEE ALSO  =head1 SEE ALSO
Legend:
Removed from v.50  
changed lines
  Added in v.66
  ViewVC Help
Powered by ViewVC 1.1.26