--- trunk/lib/Frey/ClassLoader.pm	2008/11/18 14:01:20	411
+++ trunk/lib/Frey/Class/Loader.pm	2008/12/24 13:51:59	887
@@ -1,4 +1,4 @@
-package Frey::ClassLoader;
+package Frey::Class::Loader;
 use Moose;
 
 =head1 DESCRIPTION
@@ -8,6 +8,7 @@
 =cut
 
 extends 'Frey';
+with 'Frey::Session';
 
 use Data::Dump qw/dump/;
 use File::Find;
@@ -29,11 +30,16 @@
 
 	# 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";
+		return unless m{\.pm$};
+		my $class = $_;
+		$class =~ s{^lib/}{};
+		$class =~ s{\.pm$}{};
+		$class =~ s{/}{::}g;
+		if ( 0 && $class =~ m{Mojo} ) { # FIXME remove dead code
+			$self->TODO( "Mojo support" );
+			return;
+		}
+		$class_path->{ $class } = $_;
 	} }, 'lib');
 	warn "## class_path = ",dump( $class_path ) if $self->debug;
 
@@ -55,9 +61,15 @@
 		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";
+		if ( defined $INC{$path} ) {
+			$path = $INC{$path};
+			warn "# $class from INC $path";
+			$class_path->{$class} = $path;
+		} elsif ( $path =~ s{\.pm$}{} && -e "lib/${path}.pod" ) {
+			return "lib/${path}.pod";
+		} else {
+			confess "can't find $class at $path";
+		}
 	}
 	return $class_path->{$class};
 }
@@ -74,7 +86,7 @@
 
 =head2 class_meta
 
-  my ( $meta, $is_role ) = $o->class_meta( 'Some::Class' );
+  my ( $meta, $is_role, $instance ) = $o->class_meta( 'Some::Class' );
 
 =cut
 
@@ -86,32 +98,31 @@
 
 	$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;
+	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;
+		$instance = Frey->new;
+		warn "# apply $class on $instance";
 		$class->meta->apply( $instance );
-		$meta = $class->meta;
-		die $@ if $@;
+		$meta = $instance->meta;
 	} else {
 		$meta = $class->meta;
 	}
-	return ( $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) if ! $loaded_class->{$class}++;
+		Class::MOP::load_class($class)
 	};
 	warn $@ if $@; # && $@ !~ m/role/;
 	warn "# load_class $class" if $self->debug && $loaded_class->{$class} == 1;
@@ -140,7 +151,7 @@
 
 	confess "need class" unless $class;
 	if ( ! $class->can('meta') ) {
-		warn "$class doesn't have meta (isn't Moose class)" if $self->debug;
+		warn "# $class doesn't have meta (isn't Moose class)" if $self->debug;
 		return;
 	}
 	my $meta = $class->meta;
@@ -155,4 +166,101 @@
 	return $methods;
 }
 
+=head2 class_runnable
+
+  my @runnable_methods = $o->class_runnable( $class );
+
+=cut
+
+sub class_runnable_re { m{^as_} || m{_as_} || m{sql} }
+
+sub class_runnable {
+	my ( $self, $class ) = @_;
+	my @methods = grep { class_runnable_re } $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 {
+		if ( $self->can('request_url') ) {
+			$params->{request_url} = $self->request_url;
+		} else {
+			warn "## $self doesn't have 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;