--- trunk/lib/Frey/PPI.pm	2008/11/18 14:15:45	414
+++ trunk/lib/Frey/PPI.pm	2009/06/28 20:34:40	1097
@@ -1,10 +1,11 @@
 package Frey::PPI;
 use Moose;
 
-extends 'Frey::ClassLoader';
+extends 'Frey::Class::Loader';
 
 use PPI;
 use Data::Dump qw/dump/;
+use File::Find;
 
 has 'class' => (
 	is => 'rw',
@@ -19,8 +20,10 @@
 	lazy => 1,
 	default => sub {
 		my ( $self ) = @_;
-		warn "# doc from ", $self->class if $self->debug;
-		my $doc = PPI::Document->new( $self->class_path( $self->class ) );
+		my $path = $self->class;
+		$path = $self->class_path( $path ) unless $path =~ m{/};
+		warn "# doc from ", $self->class, " at ", $path if $self->debug;
+		my $doc = PPI::Document->new( $path );
 		$doc->prune('PPI::Token::Whitespace');
 		return $doc;
 	},
@@ -43,7 +46,10 @@
 	my @attribute_order;
 	$self->find(sub {
 		my ($doc,$el) = @_;
-		return unless ( $el->isa('PPI::Statement') && $el->{children}->[0]->isa('PPI::Token::Word') && $el->{children}->[0]->literal eq 'has' );
+		return unless 
+			$el->isa('PPI::Statement') &&
+			$el->{children}->[0]->isa('PPI::Token::Word') &&
+			$el->{children}->[0]->literal eq 'has';
 
 		warn "## has ",$el->{children}->[1]->literal if $self->debug;
 		push @attribute_order, $el->{children}->[1]->literal;
@@ -64,17 +70,77 @@
 		return unless $el->isa('PPI::Statement::Include');
 
 		warn "## include ",dump( $el->module, $el->type, $el->pragma ) if $self->debug;
-		push @{ $include->{ $el->type } }, $el->module 
+		push @{ $include->{ $el->type } }, $el->module
+			unless $el->module eq 'lib'; # skip use lib 'lib';
 	});
 	warn "# ", $self->class, " include ", dump( $include ) if $self->debug;
 	return $include;
 }
 
-sub data {
+our $class_has_tests;
+
+sub parse_tests {
+	my ( $self ) = @_;
+
+	finddepth({ no_chdir => 1, wanted => sub {
+		return unless m{\.t$};
+
+		warn "## ppi test $_" if $self->debug;
+
+		my $doc = Frey::PPI->new( class => $_ );
+		my @tests;
+
+#		warn "## ",dump( $doc );
+
+		$doc->find(sub {
+			my ($doc,$el) = @_;
+			return unless 
+				$el->isa('PPI::Statement') &&
+				$el->{children}->[0]->isa('PPI::Token::Word') &&
+				$el->{children}->[0]->literal eq 'use_ok';
+
+#			warn "## ",dump( $el );
+			my $class = $el->child(1)->child(0)->child(0)->literal;
+			$class_has_tests->{$class}->{$_}++;
+		});
+	} }, 't/');
+	warn "# collected class tests ",dump( $class_has_tests ) if $self->debug;
+
+	return $class_has_tests;
+}
+
+=head2 has_tests
+
+  my @tests = $self->has_tests;
+
+=cut
+
+sub has_tests {
+	my ($self) = shift;
+	
+	$self->parse_tests unless $class_has_tests;
+
+	my $class = $self->class;
+
+	if ( my $tests = $class_has_tests->{ $class } ) {
+		my @tests = keys %$tests;
+		warn "# has_tests $class ",dump( @tests );
+		return @tests if wantarray;
+		return \@tests;
+	}
+}
+
+=head2 as_data
+
+Debugging output
+
+=cut
+
+sub as_data {
 	my $self = shift;
 	return {
 		includes => $self->includes,
-		attribute_order => $self->attribute_order,
+		attribute_order => [ $self->attribute_order ],
 		doc => $self->doc,
 	};
 }