/[Frey]/trunk/lib/Frey/ClassLoader.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/ClassLoader.pm

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

revision 456 by dpavlin, Wed Nov 19 00:40:03 2008 UTC revision 457 by dpavlin, Wed Nov 19 16:53:13 2008 UTC
# Line 29  sub classes { Line 29  sub classes {
29    
30          # FIXME there must be better way to do this in Moose style          # FIXME there must be better way to do this in Moose style
31          finddepth({ no_chdir => 1, wanted => sub {          finddepth({ no_chdir => 1, wanted => sub {
32                  return unless s/\.pm$//;                  return unless m{\.pm$};
33                  my @a = split(m!/!,$_);                  my $class = $_;
34                  my $class = join('::', @a[ 1 .. $#a ]);                  $class =~ s{^lib/}{};
35                  warn ">> $_ ",dump( @a ), " >> $class\n" if $self->debug;                  $class =~ s{\.pm$}{};
36                  $class_path->{ $class } = "$_.pm";                  $class =~ s{/}{::}g;
37                    $class_path->{ $class } = $_;
38          } }, 'lib');          } }, 'lib');
39          warn "## class_path = ",dump( $class_path ) if $self->debug;          warn "## class_path = ",dump( $class_path ) if $self->debug;
40    
# Line 92  sub class_meta { Line 93  sub class_meta {
93    
94          if ( ! $class->can('meta') ) {          if ( ! $class->can('meta') ) {
95                  $instance = Moose::Meta::Class->create_anon_class;                  $instance = Moose::Meta::Class->create_anon_class;
96                  warn "class $class isn't Moose, faking anon class" if $self->debug;                  warn "# class $class isn't Moose, faking anon class" if $self->debug;
97                  $meta = $instance->meta;                  $meta = $instance->meta;
98          } elsif( $class->meta->isa('Moose::Meta::Role') ) {          } elsif( $class->meta->isa('Moose::Meta::Role') ) {
99                  $is_role = 1;                  $is_role = 1;
# Line 108  sub class_meta { Line 109  sub class_meta {
109    
110  sub load_class {  sub load_class {
111          my ( $self, $class ) = @_;          my ( $self, $class ) = @_;
112            return if $loaded_class->{$class}++;
113          eval {          eval {
114                  Class::MOP::load_class($class) if ! $loaded_class->{$class}++;                  Class::MOP::load_class($class)
115          };          };
116          warn $@ if $@; # && $@ !~ m/role/;          warn $@ if $@; # && $@ !~ m/role/;
117          warn "# load_class $class" if $self->debug && $loaded_class->{$class} == 1;          warn "# load_class $class" if $self->debug && $loaded_class->{$class} == 1;
# Line 138  sub class_methods { Line 140  sub class_methods {
140    
141          confess "need class" unless $class;          confess "need class" unless $class;
142          if ( ! $class->can('meta') ) {          if ( ! $class->can('meta') ) {
143                  warn "$class doesn't have meta (isn't Moose class)" if $self->debug;                  warn "# $class doesn't have meta (isn't Moose class)" if $self->debug;
144                  return;                  return;
145          }          }
146          my $meta = $class->meta;          my $meta = $class->meta;
# Line 153  sub class_methods { Line 155  sub class_methods {
155          return $methods;          return $methods;
156  }  }
157    
158    =head2 class_runnable
159    
160      my @runnable_methods = $o->class_runnable( $class );
161    
162    =cut
163    
164    sub class_runnable {
165            my ( $self, $class ) = @_;
166            my @methods = grep { m{^as_} } $self->class_methods( $class );
167            return @methods if wantarray;
168            return \@methods;
169    }
170    
171    sub class_inputs {
172            my ( $self, $class ) = @_;
173            my @inputs = grep { m{^(markup/as_data/as_sponge)$} } $self->class_methods( $class );
174            return @inputs if wantarray;
175            return \@inputs;
176    }
177    
178    =head2 new_frey_class
179    
180      my $instance = $o->new_frey_class( $class, $params );
181    
182    This will apply L<Moose::Role> on the fly to provide accessors for
183    C<data> and C<sponge> in form of C<as_*>
184    
185    See L<http://www.perlmonks.org/?node_id=602389>
186    
187    It is used by L<Frey::Run> and L<Frey::Pipe> to create objects
188    
189    =cut
190    
191    {
192            package Frey::Role::as_data;
193            use Moose::Role;
194    
195            sub as_data {
196                    my ($self) = @_;
197                    $self->data;
198            }
199    
200            package Frey::Role::as_data;
201            use Moose::Role;
202            sub as_sponge {
203                    my ($self) = @_;
204                    $self->sponge;
205            }
206    }
207    
208    sub new_frey_class {
209            my ( $self, $class, $params ) = @_;
210            my $instance = $class->new( %$params );
211            if ( $instance->can('data') && ! $instance->can('as_data') ) {
212                    Frey::Role::as_data->meta->apply( $instance );
213                    warn "# apply as_data role to $class";
214            }
215            if ( $instance->can('sponge') && ! $instance->can('as_sponge') ) {
216                    Frey::Role::as_sponge->meta->apply( $instance );
217                    warn "# apply as_sponge role to $class";
218            }
219            return $instance;
220    }
221    
222  1;  1;
Legend:
Removed from v.456  
changed lines
  Added in v.457
  ViewVC Help
Powered by ViewVC 1.1.26