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

Return all local classes by reading from disk

  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

Return any local or loaded class

  $path = $o->class_path( $class );

=cut

sub class_path {
        my ( $self, $class ) = @_;
        $self->classes unless $class_path;
        if ( ! defined $class_path->{$class} ) {
                my $path = $class;
                $path =~ s{::}{/}g;
                $path .= '.pm';
                $path = $INC{$path};
                warn "# $class from INC $path";
                $class_path->{$class} = $path || confess "can't find path for $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 = $class->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 $self->debug && $loaded_class->{$class} == 1;
}

sub load_all_classes {
        my $self = shift;
        warn "# loaded_class = ",dump( $loaded_class ) if $self->debug;
        $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	dpavlin	382	Return all local classes by reading from disk
21
22	dpavlin	308	my @classes = $o->classes;
23
24			=cut
25
26	dpavlin	101	sub classes {
27			my $self = shift;
28	dpavlin	112	return @classes if @classes;
29	dpavlin	101
30			# FIXME there must be better way to do this in Moose style
31			finddepth({ no_chdir => 1, wanted => sub {
32			return unless s/\.pm$//;
33			my @a = split(m!/!,$_);
34	dpavlin	308	my $class = join('::', @a[ 1 .. $#a ]);
35			warn ">> $_ ",dump( @a ), " >> $class\n" if $self->debug;
36			$class_path->{ $class } = "$_.pm";
37	dpavlin	101	} }, 'lib');
38	dpavlin	308	warn "## class_path = ",dump( $class_path ) if $self->debug;
39	dpavlin	101
40	dpavlin	308	@classes = sort keys %$class_path;
41	dpavlin	101	}
42
43	dpavlin	308	=head2 class_path
44
45	dpavlin	382	Return any local or loaded class
46
47	dpavlin	308	$path = $o->class_path( $class );
48
49			=cut
50
51			sub class_path {
52			my ( $self, $class ) = @_;
53			$self->classes unless $class_path;
54	dpavlin	382	if ( ! defined $class_path->{$class} ) {
55			my $path = $class;
56			$path =~ s{::}{/}g;
57			$path .= '.pm';
58			$path = $INC{$path};
59			warn "# $class from INC $path";
60	dpavlin	404	$class_path->{$class} = $path \|\| confess "can't find path for $class";
61	dpavlin	382	}
62	dpavlin	308	return $class_path->{$class};
63	dpavlin	101	}
64
65	dpavlin	308	=head2 loaded_classes
66	dpavlin	100
67	dpavlin	308	my $available = $o->loaded_classes;
68			$available->{'Frey'} # true
69	dpavlin	100
70			=cut
71
72	dpavlin	308	our $loaded_class;
73			sub loaded_classes { $loaded_class };
74	dpavlin	100
75	dpavlin	308	=head2 class_meta
76	dpavlin	100
77	dpavlin	308	my ( $meta, $is_role ) = $o->class_meta( 'Some::Class' );
78
79			=cut
80
81			sub class_meta {
82			my ( $self, $class ) = @_;
83
84			$class \|\|= $self->class if $self->can('class');
85			warn "# class_meta $class";
86
87			$self->load_class($class);
88
89			if ( ! $class->can('meta') ) {
90			my $instance = Moose::Meta::Class->create_anon_class;
91			warn "class $class isn't Moose, faking anon class";
92			return ( $instance, 0 );
93	dpavlin	101	}
94
95	dpavlin	308	my $meta;
96	dpavlin	137	my $is_role = 0;
97	dpavlin	308	my $instance;
98	dpavlin	100
99	dpavlin	308	if($class->meta->isa('Moose::Meta::Role')){
100	dpavlin	100	$is_role = 1;
101	dpavlin	308	$instance = Moose::Meta::Class->create_anon_class;
102			$class->meta->apply( $instance );
103	dpavlin	331	$meta = $class->meta;
104	dpavlin	137	die $@ if $@;
105	dpavlin	100	} else {
106	dpavlin	308	$meta = $class->meta;
107	dpavlin	100	}
108	dpavlin	308	return ( $meta, $is_role );
109	dpavlin	100	}
110
111	dpavlin	308	sub load_class {
112			my ( $self, $class ) = @_;
113			eval {
114			Class::MOP::load_class($class) if ! $loaded_class->{$class}++;
115			};
116			warn $@ if $@; # && $@ !~ m/role/;
117	dpavlin	320	warn "# load_class $class" if $self->debug && $loaded_class->{$class} == 1;
118	dpavlin	308	}
119
120	dpavlin	101	sub load_all_classes {
121			my $self = shift;
122	dpavlin	320	warn "# loaded_class = ",dump( $loaded_class ) if $self->debug;
123	dpavlin	308	$self->load_class( $_ ) foreach ( $self->classes );
124			$loaded_class;
125	dpavlin	101	}
126	dpavlin	100
127			1;