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	dpavlin	100	package Frey::ClassLoader;
2			use Moose;
3
4			extends 'Frey';
5
6			use Data::Dump qw/dump/;
7			use File::Find;
8
9	dpavlin	101	our $package_path;
10	dpavlin	100
11	dpavlin	101	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	dpavlin	100	=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	dpavlin	101	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	dpavlin	100	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	dpavlin	101	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	dpavlin	100
89			1;