--- trunk/lib/Frey/ClassLoader.pm	2008/07/15 18:06:27	137
+++ trunk/lib/Frey/ClassLoader.pm	2008/11/18 13:52:26	409
@@ -1,14 +1,28 @@
 package Frey::ClassLoader;
 use Moose;
 
+=head1 DESCRIPTION
+
+Load L<Frey> classes
+
+=cut
+
 extends 'Frey';
 
 use Data::Dump qw/dump/;
 use File::Find;
 
-our $package_path;
+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;
@@ -17,61 +31,128 @@
 	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";
+		my $class = join('::', @a[ 1 .. $#a ]);
+		warn ">> $_ ",dump( @a ), " >> $class\n" if $self->debug;
+		$class_path->{ $class } = "$_.pm";
 	} }, 'lib');
-	warn "## package_path = ",dump( $package_path ) if $self->debug;
+	warn "## class_path = ",dump( $class_path ) if $self->debug;
 
-	@classes = sort keys %$package_path;
+	@classes = sort keys %$class_path;
 }
 
-sub package_path {
-	my ( $self, $package ) = @_;
-	$self->classes unless $package_path;
-	confess "can't find path for package $package" unless defined $package_path->{$package};
-	return $package_path->{$package};
+=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 load_package
+=head2 loaded_classes
 
-  my ( $class, $meta, $is_role ) = $o->load_package( 'Some::Package' );
+  my $available = $o->loaded_classes;
+  $available->{'Frey'} # true
 
 =cut
 
-sub load_package {
-	my ( $self, $package ) = @_;
+our $loaded_class;
+sub loaded_classes { $loaded_class };
 
-	Class::MOP::load_class($package);
+=head2 class_meta
 
-	if ( ! $package->can('meta') ) {
-		my $class = Moose::Meta::Class->create_anon_class;
-		warn "package $package isn't Moose, faking anon class";
-		return ( $class, $class->meta, 0 );
+  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 $class;
+	my $instance;
 
-	if($package->meta->isa('Moose::Meta::Role')){
+	if($class->meta->isa('Moose::Meta::Role')){
 		$is_role = 1;
-		$class = Moose::Meta::Class->create_anon_class;
-		$package->meta->apply( $class );
+		$instance = Moose::Meta::Class->create_anon_class;
+		$class->meta->apply( $instance );
+		$meta = $class->meta;
 		die $@ if $@;
 	} else {
-		$class = $package->meta;
+		$meta = $class->meta;
 	}
-	return ( $class, $is_role );
+	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;
-	my $loaded = 0;
-	foreach ( $self->classes ) {
-		Class::MOP::load_class($_);
-		$loaded++;
+	warn "# loaded_class = ",dump( $loaded_class ) if $self->debug;
+	$self->load_class( $_ ) foreach ( $self->classes );
+	$loaded_class;
+}
+
+=head2 class_methods
+
+  my @all_methods = $o->class_methods( $class );
+
+  my $class_method = $o->class_methods( $class );
+  if ( $class_method->{ $method } ) {
+  	# $class has $method
+  }
+
+=cut
+
+sub class_methods {
+	my ( $self, $class ) = @_;
+
+	confess "need class" unless $class;
+	if ( ! $class->can('meta') ) {
+		warn "$class doesn't have meta (isn't Moose class)";
+		return;
 	}
-	$loaded;
+	my $meta = $class->meta;
+
+	my $attr;
+	my $methods;
+	$attr->{$_}++ foreach $meta->get_attribute_list;
+	my @methods = map { $methods->{$_}++; $_ } grep { ! defined($attr->{$_}) && $_ ne 'meta' } $meta->get_method_list;
+	warn "# methods = ",dump( @methods ) if $self->debug;
+
+	return @methods if wantarray;
+	return $methods;
 }
 
 1;