Frey/Class/Loader.pm

package Frey::ClassLoader;
use Moose;

extends 'Frey';

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

has 'classes' => (
        is => 'ro',
#       isa => 'HashRef[Str]',
        default => sub {
                my $self = shift;
                # FIXME there must be better way to do this in Moose style
                my $classes;
                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;
                        push @$classes, { $package => "$_.pm" };
                } }, 'lib');
                warn "## classes = ",dump( $classes ) if $self->debug;
                $classes;
        },
        lazy => 1,
);

=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);

        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 );
}


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			has 'classes' => (
10			is => 'ro',
11			# isa => 'HashRef[Str]',
12			default => sub {
13			my $self = shift;
14			# FIXME there must be better way to do this in Moose style
15			my $classes;
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			push @$classes, { $package => "$_.pm" };
22			} }, 'lib');
23			warn "## classes = ",dump( $classes ) if $self->debug;
24			$classes;
25			},
26			lazy => 1,
27			);
28
29			=head2 load_package
30
31			my ( $class, $meta, $is_role ) = $o->load_package( 'Some::Package' );
32
33			=cut
34
35			sub load_package {
36			my ( $self, $package ) = @_;
37
38			#intercept role application so we can accurately generate
39			#method and attribute information for the parent class.
40			#this is fragile, but there is not better way that i am aware of
41			my $rmeta = Moose::Meta::Role->meta;
42			$rmeta->make_mutable if $rmeta->is_immutable;
43			my $original_apply = $rmeta->get_method("apply")->body;
44			$rmeta->remove_method("apply");
45			my @roles_to_apply;
46			$rmeta->add_method("apply", sub{push(@roles_to_apply, [@_])});
47			#load the package with the hacked Moose::Meta::Role
48
49			#eval { Class::MOP::load_class($package); };
50			#confess "Failed to load package ${package} $@" if $@;
51			Class::MOP::load_class($package);
52
53			my $meta = $package->meta;
54
55			my ($class, $is_role);
56			if($package->meta->isa('Moose::Meta::Role')){
57			$is_role = 1;
58			# we need to apply the role to a class to be able to properly introspect it
59			$class = Moose::Meta::Class->create_anon_class;
60			$original_apply->($meta, $class);
61			} else {
62			#roles don't have superclasses ...
63			$class = $meta;
64			}
65			return ( $class, $meta, $is_role );
66			}
67
68
69			1;