lib/Frey/ClassLoader.pm

package Frey::ClassLoader;
use Moose;

=head1 DESCRIPTION

Load L<Frey> classes

=cut

extends 'Frey';

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

our $class_path;
our @classes;

=head2 classes

  my @classes = $o->classes;

=cut

sub classes {
        my $self = shift;
        return @classes if @classes;

        # 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 $class = join('::', @a[ 1 .. $#a ]);
                warn ">> $_ ",dump( @a ), " >> $class\n" if $self->debug;
                $class_path->{ $class } = "$_.pm";
        } }, 'lib');
        warn "## class_path = ",dump( $class_path ) if $self->debug;

        @classes = sort keys %$class_path;
}

=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 loaded_classes

  my $available = $o->loaded_classes;
  $available->{'Frey'} # true

=cut

our $loaded_class;
sub loaded_classes { $loaded_class };

=head2 class_meta

  my ( $meta, $is_role ) = $o->class_meta( 'Some::Class' );

=cut

sub class_meta {
        my ( $self, $class ) = @_;

        $class ||= $self->class if $self->can('class');
        warn "# class_meta $class";

        $self->load_class($class);

        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 $instance;

        if($class->meta->isa('Moose::Meta::Role')){
                $is_role = 1;
                $instance = Moose::Meta::Class->create_anon_class;
                $class->meta->apply( $instance );
                $meta = $instance->meta;
                die $@ if $@;
        } else {
                $meta = $class->meta;
        }
        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;
        warn "# loaded_class = ",dump( $loaded_class );
        $self->load_class( $_ ) foreach ( $self->classes );
        $loaded_class;
}

1;
1	dpavlin	100	package Frey::ClassLoader;
2			use Moose;
3
4	dpavlin	308	=head1 DESCRIPTION
5
6			Load L<Frey> classes
7
8			=cut
9
10	dpavlin	100	extends 'Frey';
11
12			use Data::Dump qw/dump/;
13			use File::Find;
14
15	dpavlin	308	our $class_path;
16	dpavlin	112	our @classes;
17	dpavlin	100
18	dpavlin	308	=head2 classes
19
20			my @classes = $o->classes;
21
22			=cut
23
24	dpavlin	101	sub classes {
25			my $self = shift;
26	dpavlin	112	return @classes if @classes;
27	dpavlin	101
28			# FIXME there must be better way to do this in Moose style
29			finddepth({ no_chdir => 1, wanted => sub {
30			return unless s/\.pm$//;
31			my @a = split(m!/!,$_);
32	dpavlin	308	my $class = join('::', @a[ 1 .. $#a ]);
33			warn ">> $_ ",dump( @a ), " >> $class\n" if $self->debug;
34			$class_path->{ $class } = "$_.pm";
35	dpavlin	101	} }, 'lib');
36	dpavlin	308	warn "## class_path = ",dump( $class_path ) if $self->debug;
37	dpavlin	101
38	dpavlin	308	@classes = sort keys %$class_path;
39	dpavlin	101	}
40
41	dpavlin	308	=head2 class_path
42
43			$path = $o->class_path( $class );
44
45			=cut
46
47			sub class_path {
48			my ( $self, $class ) = @_;
49			$self->classes unless $class_path;
50			confess "can't find path for class $class" unless defined $class_path->{$class};
51			return $class_path->{$class};
52	dpavlin	101	}
53
54	dpavlin	308	=head2 loaded_classes
55	dpavlin	100
56	dpavlin	308	my $available = $o->loaded_classes;
57			$available->{'Frey'} # true
58	dpavlin	100
59			=cut
60
61	dpavlin	308	our $loaded_class;
62			sub loaded_classes { $loaded_class };
63	dpavlin	100
64	dpavlin	308	=head2 class_meta
65	dpavlin	100
66	dpavlin	308	my ( $meta, $is_role ) = $o->class_meta( 'Some::Class' );
67
68			=cut
69
70			sub class_meta {
71			my ( $self, $class ) = @_;
72
73			$class \|\|= $self->class if $self->can('class');
74			warn "# class_meta $class";
75
76			$self->load_class($class);
77
78			if ( ! $class->can('meta') ) {
79			my $instance = Moose::Meta::Class->create_anon_class;
80			warn "class $class isn't Moose, faking anon class";
81			return ( $instance, 0 );
82	dpavlin	101	}
83
84	dpavlin	308	my $meta;
85	dpavlin	137	my $is_role = 0;
86	dpavlin	308	my $instance;
87	dpavlin	100
88	dpavlin	308	if($class->meta->isa('Moose::Meta::Role')){
89	dpavlin	100	$is_role = 1;
90	dpavlin	308	$instance = Moose::Meta::Class->create_anon_class;
91			$class->meta->apply( $instance );
92			$meta = $instance->meta;
93	dpavlin	137	die $@ if $@;
94	dpavlin	100	} else {
95	dpavlin	308	$meta = $class->meta;
96	dpavlin	100	}
97	dpavlin	308	return ( $meta, $is_role );
98	dpavlin	100	}
99
100	dpavlin	308	sub load_class {
101			my ( $self, $class ) = @_;
102			eval {
103			Class::MOP::load_class($class) if ! $loaded_class->{$class}++;
104			};
105			warn $@ if $@; # && $@ !~ m/role/;
106			warn "# load_class $class" if $loaded_class->{$class} == 1;
107			}
108
109	dpavlin	101	sub load_all_classes {
110			my $self = shift;
111	dpavlin	308	warn "# loaded_class = ",dump( $loaded_class );
112			$self->load_class( $_ ) foreach ( $self->classes );
113			$loaded_class;
114	dpavlin	101	}
115	dpavlin	100
116			1;