lib/Frey/ClassLoader.pm

package Frey::ClassLoader;
use Moose;

extends 'Frey';

use Data::Dump qw/dump/;
use File::Find;

our $package_path;

sub classes {
        my $self = shift;
        return keys %$package_path if $package_path;

        # FIXME there must be better way to do this in Moose style
        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";
        } }, 'lib');
        warn "## package_path = ",dump( $package_path ) if $self->debug;

        return keys %$package_path;
}

sub package_path {
        my ( $self, $package ) = @_;
        die "can't find path for package $package" unless defined $package_path->{$package};
        return $package_path->{$package};
}

=head2 load_package

  my ( $class, $meta, $is_role ) = $o->load_package( 'Some::Package' );

=cut

sub load_package {
        my ( $self, $package ) = @_;

        #intercept role application so we can accurately generate
        #method and attribute information for the parent class.
        #this is fragile, but there is not better way that i am aware of
        my $rmeta = Moose::Meta::Role->meta;
        $rmeta->make_mutable if $rmeta->is_immutable;
        my $original_apply = $rmeta->get_method("apply")->body;
        $rmeta->remove_method("apply");
        my @roles_to_apply;
        $rmeta->add_method("apply", sub{push(@roles_to_apply, [@_])});
        #load the package with the hacked Moose::Meta::Role

        #eval { Class::MOP::load_class($package); };
        #confess "Failed to load package ${package} $@" if $@;
        Class::MOP::load_class($package);

        if ( ! $package->can('meta') ) {
                my $class = Moose::Meta::Class->create_anon_class;
                warn "package $package doesn't have meta faking anon class";
                return ( $class, $class->meta, 0 );
        }

        my $meta = $package->meta;

        my ($class, $is_role);
        if($package->meta->isa('Moose::Meta::Role')){
                $is_role = 1;
                # we need to apply the role to a class to be able to properly introspect it
                $class = Moose::Meta::Class->create_anon_class;
                $original_apply->($meta, $class);
        } else {
                #roles don't have superclasses ...
                $class = $meta;
        }
        return ( $class, $meta, $is_role );
}

sub load_all_classes {
        my $self = shift;
        my $loaded = 0;
        foreach ( $self->classes ) {
                Class::MOP::load_class($_);
                $loaded++;
        }
        $loaded;
}

1;
1	package Frey::ClassLoader;
2	use Moose;
3
4	extends 'Frey';
5
6	use Data::Dump qw/dump/;
7	use File::Find;
8
9	our $package_path;
10
11	sub classes {
12	my $self = shift;
13	return keys %$package_path if $package_path;
14
15	# FIXME there must be better way to do this in Moose style
16	finddepth({ no_chdir => 1, wanted => sub {
17	return unless s/\.pm$//;
18	my @a = split(m!/!,$_);
19	my $package = join('::', @a[ 1 .. $#a ]);
20	warn ">> $_ ",dump( @a ), " >> $package\n" if $self->debug;
21	$package_path->{ $package } = "$_.pm";
22	} }, 'lib');
23	warn "## package_path = ",dump( $package_path ) if $self->debug;
24
25	return keys %$package_path;
26	}
27
28	sub package_path {
29	my ( $self, $package ) = @_;
30	die "can't find path for package $package" unless defined $package_path->{$package};
31	return $package_path->{$package};
32	}
33
34	=head2 load_package
35
36	my ( $class, $meta, $is_role ) = $o->load_package( 'Some::Package' );
37
38	=cut
39
40	sub load_package {
41	my ( $self, $package ) = @_;
42
43	#intercept role application so we can accurately generate
44	#method and attribute information for the parent class.
45	#this is fragile, but there is not better way that i am aware of
46	my $rmeta = Moose::Meta::Role->meta;
47	$rmeta->make_mutable if $rmeta->is_immutable;
48	my $original_apply = $rmeta->get_method("apply")->body;
49	$rmeta->remove_method("apply");
50	my @roles_to_apply;
51	$rmeta->add_method("apply", sub{push(@roles_to_apply, [@_])});
52	#load the package with the hacked Moose::Meta::Role
53
54	#eval { Class::MOP::load_class($package); };
55	#confess "Failed to load package ${package} $@" if $@;
56	Class::MOP::load_class($package);
57
58	if ( ! $package->can('meta') ) {
59	my $class = Moose::Meta::Class->create_anon_class;
60	warn "package $package doesn't have meta faking anon class";
61	return ( $class, $class->meta, 0 );
62	}
63
64	my $meta = $package->meta;
65
66	my ($class, $is_role);
67	if($package->meta->isa('Moose::Meta::Role')){
68	$is_role = 1;
69	# we need to apply the role to a class to be able to properly introspect it
70	$class = Moose::Meta::Class->create_anon_class;
71	$original_apply->($meta, $class);
72	} else {
73	#roles don't have superclasses ...
74	$class = $meta;
75	}
76	return ( $class, $meta, $is_role );
77	}
78
79	sub load_all_classes {
80	my $self = shift;
81	my $loaded = 0;
82	foreach ( $self->classes ) {
83	Class::MOP::load_class($_);
84	$loaded++;
85	}
86	$loaded;
87	}
88
89	1;