--- trunk/lib/Frey/ClassLoader.pm 2008/11/05 18:32:16 307 +++ trunk/lib/Frey/ClassLoader.pm 2008/11/05 19:13:01 308 @@ -1,14 +1,26 @@ package Frey::ClassLoader; use Moose; +=head1 DESCRIPTION + +Load L classes + +=cut + extends 'Frey'; use Data::Dump qw/dump/; use File::Find; -our $package_path; +our $class_path; our @classes; +=head2 classes + + my @classes = $o->classes; + +=cut + sub classes { my $self = shift; return @classes if @classes; @@ -17,65 +29,88 @@ finddepth({ no_chdir => 1, wanted => sub { return unless s/\.pm$//; my @a = split(m!/!,$_); - my $package = join('::', @a[ 1 .. $#a ]); - warn ">> $_ ",dump( @a ), " >> $package\n" if $self->debug; - $package_path->{ $package } = "$_.pm"; + my $class = join('::', @a[ 1 .. $#a ]); + warn ">> $_ ",dump( @a ), " >> $class\n" if $self->debug; + $class_path->{ $class } = "$_.pm"; } }, 'lib'); - warn "## package_path = ",dump( $package_path ) if $self->debug; + warn "## class_path = ",dump( $class_path ) if $self->debug; - @classes = sort keys %$package_path; + @classes = sort keys %$class_path; } -sub package_path { - my ( $self, $package ) = @_; - $self->classes unless $package_path; - confess "can't find path for package $package" unless defined $package_path->{$package}; - return $package_path->{$package}; +=head2 class_path + + $path = $o->class_path( $class ); + +=cut + +sub class_path { + my ( $self, $class ) = @_; + $self->classes unless $class_path; + confess "can't find path for class $class" unless defined $class_path->{$class}; + return $class_path->{$class}; } -=head2 load_package +=head2 loaded_classes + + my $available = $o->loaded_classes; + $available->{'Frey'} # true + +=cut + +our $loaded_class; +sub loaded_classes { $loaded_class }; - my ( $class, $meta, $is_role ) = $o->load_package( 'Some::Package' ); +=head2 class_meta + + my ( $meta, $is_role ) = $o->class_meta( 'Some::Class' ); =cut -sub load_package { - my ( $self, $package ) = @_; +sub class_meta { + my ( $self, $class ) = @_; + + $class ||= $self->class if $self->can('class'); + warn "# class_meta $class"; - Class::MOP::load_class($package); + $self->load_class($class); - if ( ! $package->can('meta') ) { - my $class = Moose::Meta::Class->create_anon_class; - warn "package $package isn't Moose, faking anon class"; - return ( $class, $class->meta, 0 ); + if ( ! $class->can('meta') ) { + my $instance = Moose::Meta::Class->create_anon_class; + warn "class $class isn't Moose, faking anon class"; + return ( $instance, 0 ); } + my $meta; my $is_role = 0; - my $class; + my $instance; - if($package->meta->isa('Moose::Meta::Role')){ + if($class->meta->isa('Moose::Meta::Role')){ $is_role = 1; - $class = Moose::Meta::Class->create_anon_class; - $package->meta->apply( $class ); + $instance = Moose::Meta::Class->create_anon_class; + $class->meta->apply( $instance ); + $meta = $instance->meta; die $@ if $@; } else { - $class = $package->meta; + $meta = $class->meta; } - return ( $class, $is_role ); + return ( $meta, $is_role ); +} + +sub load_class { + my ( $self, $class ) = @_; + eval { + Class::MOP::load_class($class) if ! $loaded_class->{$class}++; + }; + warn $@ if $@; # && $@ !~ m/role/; + warn "# load_class $class" if $loaded_class->{$class} == 1; } sub load_all_classes { my $self = shift; - my $loaded = 0; - foreach ( $self->classes ) { - eval { Class::MOP::load_class($_); }; - if ( $@ ) { - warn $@; - } else { - $loaded++; - } - } - $loaded; + warn "# loaded_class = ",dump( $loaded_class ); + $self->load_class( $_ ) foreach ( $self->classes ); + $loaded_class; } 1;