--- trunk/lib/Frey/ClassLoader.pm	2008/07/11 19:19:42	100
+++ trunk/lib/Frey/ClassLoader.pm	2008/12/02 01:06:46	668
@@ -1,69 +1,254 @@
 package Frey::ClassLoader;
 use Moose;
 
+=head1 DESCRIPTION
+
+Load L<Frey> classes
+
+=cut
+
 extends 'Frey';
+with 'Frey::Session';
 
 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' );
+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 m{\.pm$};
+		my $class = $_;
+		$class =~ s{^lib/}{};
+		$class =~ s{\.pm$}{};
+		$class =~ s{/}{::}g;
+		if ( $class =~ m{Mojo} ) {
+			$self->TODO( "Mojo support" );
+			return;
+		}
+		$class_path->{ $class } = $_;
+	} }, '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, $instance ) = $o->class_meta( 'Some::Class' );
 
 =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);
+sub class_meta {
+	my ( $self, $class ) = @_;
 
-	my $meta = $package->meta;
+	$class ||= $self->class if $self->can('class');
+	warn "# class_meta $class";
 
-	my ($class, $is_role);
-	if($package->meta->isa('Moose::Meta::Role')){
+	$self->load_class($class);
+
+	my $meta;
+	my $is_role = 0;
+	my $instance;
+
+	if ( ! $class->can('meta') ) {
+		$instance = Moose::Meta::Class->create_anon_class;
+		warn "# class $class isn't Moose, faking anon class" if $self->debug;
+		$meta = $instance->meta;
+	} elsif( $class->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);
+		$instance = Frey->new;
+		warn "# apply $class on $instance";
+		$class->meta->apply( $instance );
+		$meta = $instance->meta;
 	} else {
-		#roles don't have superclasses ...
-		$class = $meta;
+		$meta = $class->meta;
 	}
-	return ( $class, $meta, $is_role );
+	return ( $meta, $is_role, $instance );
 }
 
+sub load_class {
+	my ( $self, $class ) = @_;
+	return if $loaded_class->{$class}++;
+	eval {
+		Class::MOP::load_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;
+}
+
+=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)" if $self->debug;
+		return;
+	}
+	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;
+}
+
+=head2 class_runnable
+
+  my @runnable_methods = $o->class_runnable( $class );
+
+=cut
+
+sub class_runnable {
+	my ( $self, $class ) = @_;
+	my @methods = grep { m{^as_} || m{_as_} } $self->class_methods( $class );
+	return @methods if wantarray;
+	return \@methods;
+}
+
+sub class_inputs {
+	my ( $self, $class ) = @_;
+	my @inputs = grep { m{^(markup/as_data/as_sponge)$} } $self->class_methods( $class );
+	return @inputs if wantarray;
+	return \@inputs;
+}
+
+=head2 new_frey_class
+
+  my $instance = $o->new_frey_class( $class, $params );
+
+This will apply L<Moose::Role> on the fly to provide accessors for
+C<data> and C<sponge> in form of C<as_*>
+
+See L<http://www.perlmonks.org/?node_id=602389>
+
+It is used by L<Frey::Run> and L<Frey::Pipe> to create objects
+
+=cut
+
+{
+	package Frey::Role::as_data;
+	use Moose::Role;
+
+	sub as_data {
+		my ($self) = @_;
+		$self->data;
+	}
+
+	package Frey::Role::as_sponge;
+	use Moose::Role;
+	sub as_sponge {
+		my ($self) = @_;
+		$self->sponge;
+	}
+}
+
+our $syntax_checked_last;
+
+sub new_frey_class {
+	my ( $self, $class, $params ) = @_;
+	my $instance;
+
+	my $path = $self->class_path( $class );
+	if ( $syntax_checked_last->{$class} != -C $path ) {
+		my $syntax = `perl -Ilib -wc $path 2>&1`;
+		warn "# syntax: $syntax";
+		$syntax_checked_last->{$class} = -C $class;
+	}
+
+	if ( $class->meta->isa('Moose::Meta::Role') ) {
+		$instance = Frey->new;
+		Frey::Web->meta->apply( $instance );
+		warn "new_frey_class $class role with Frey::Web";
+	} else {
+		$params->{request_url} = $self->request_url;
+		$instance = $class->new( %$params ) or confess "can't $class->new".dump( %$params );
+		warn "new_frey_class $class";
+	}
+
+	if ( $instance->can('data') && ! $instance->can('as_data') ) {
+		Frey::Role::as_data->meta->apply( $instance );
+		warn "# apply as_data role to $class";
+	}
+	if ( $instance->can('sponge') && ! $instance->can('as_sponge') ) {
+		Frey::Role::as_sponge->meta->apply( $instance );
+		warn "# apply as_sponge role to $class";
+	}
+
+	if ( ! $instance->can('add_status') ) {
+		Frey::Web->meta->apply( $instance );
+		warn "# apply Frey::Web role to $class";
+	}
+
+	$self->add_status({ $class => $params });
+	return $instance;
+}
 
 1;