--- trunk/lib/Frey/ClassLoader.pm 2008/11/27 21:01:39 559 +++ trunk/lib/Frey/Class/Loader.pm 2009/06/30 19:22:43 1136 @@ -1,4 +1,4 @@ -package Frey::ClassLoader; +package Frey::Class::Loader; use Moose; =head1 DESCRIPTION @@ -8,6 +8,7 @@ =cut extends 'Frey'; +with 'Frey::Session'; use Data::Dump qw/dump/; use File::Find; @@ -34,8 +35,8 @@ $class =~ s{^lib/}{}; $class =~ s{\.pm$}{}; $class =~ s{/}{::}g; - if ( $class =~ m{Mojo} ) { - warn "# skip Mojo class $class"; + if ( 0 && $class =~ m{Mojo} ) { # FIXME remove dead code + $self->TODO( "Mojo support" ); return; } $class_path->{ $class } = $_; @@ -60,9 +61,15 @@ my $path = $class; $path =~ s{::}{/}g; $path .= '.pm'; - $path = $INC{$path}; - warn "# $class from INC $path"; - $class_path->{$class} = $path || confess "can't find path for $class"; + if ( defined $INC{$path} ) { + $path = $INC{$path}; + warn "# $class from INC $path"; + $class_path->{$class} = $path; + } elsif ( $path =~ s{\.pm$}{} && -e "lib/${path}.pod" ) { + return "lib/${path}.pod"; + } else { + confess "can't find $class at $path"; + } } return $class_path->{$class}; } @@ -102,9 +109,8 @@ } elsif( $class->meta->isa('Moose::Meta::Role') ) { $is_role = 1; $instance = Frey->new; - warn "# apply $class on $instance"; - $class->meta->apply( $instance ); - $meta = $instance->meta; + warn "# use meta from role $class"; + $meta = ref $class ? ref($class)->meta : $class->meta; } else { $meta = $class->meta; } @@ -165,9 +171,11 @@ =cut +sub class_runnable_re { m{^as_} || m{_as_} || m{sql} } + sub class_runnable { my ( $self, $class ) = @_; - my @methods = grep { m{^as_} } $self->class_methods( $class ); + my @methods = grep { class_runnable_re } $self->class_methods( $class ); return @methods if wantarray; return \@methods; } @@ -207,11 +215,37 @@ my ($self) = @_; $self->sponge; } + + no Moose::Role; } +our $syntax_checked_last; + sub new_frey_class { my ( $self, $class, $params ) = @_; - my $instance = $class->new( %$params ); + my $instance; + + my $path = $self->class_path( $class ); + if ( $syntax_checked_last->{$class} != -C $path ) { + my $syntax = `perl -Ilib -wc $path 2>&1`; + warn "# syntax: $syntax"; + $syntax_checked_last->{$class} = -C $class; + } + + if ( $class->meta->isa('Moose::Meta::Role') ) { + $instance = Frey->new; + Frey::Web->meta->apply( $instance ); + warn "new_frey_class $class role with Frey::Web"; + } else { + if ( $self->can('request_url') ) { + $params->{request_url} = $self->request_url; + } else { + warn "## $self doesn't have request_url"; + } + $instance = $class->new( %$params ) or confess "can't $class->new".dump( %$params ); + warn "new_frey_class $class"; + } + if ( $instance->can('data') && ! $instance->can('as_data') ) { Frey::Role::as_data->meta->apply( $instance ); warn "# apply as_data role to $class"; @@ -221,8 +255,16 @@ warn "# apply as_sponge role to $class"; } - $self->add_status({ $class => $params }) if $self->can('add_status'); + if ( ! $instance->can('add_status') ) { + Frey::Web->meta->apply( $instance ); + warn "# apply Frey::Web role to $class"; + } + + $self->add_status({ $class => $params }); return $instance; } +__PACKAGE__->meta->make_immutable; +no Moose; + 1;