--- trunk/lib/Frey/PPI.pm	2008/11/08 16:12:39	331
+++ trunk/lib/Frey/PPI.pm	2008/11/16 19:50:36	364
@@ -13,32 +13,69 @@
 	documentation => 'Name of class to parse',
 );
 
-sub attribute_order {
-	my ( $self ) = @_;
+has 'doc' => (
+	is => 'ro',
+	isa => 'PPI::Document',
+	lazy => 1,
+	default => sub {
+		my ( $self ) = @_;
+		warn "doc from ", $self->class;
+		my $doc = PPI::Document->new( $self->class_path( $self->class ) ) || die $!;
+		$doc->prune('PPI::Token::Whitespace');
+		return $doc;
+	},
+);
 
-	my $doc = PPI::Document->new( $self->class_path( $self->class ) ) || die $!;
+sub find {
+	my ( $self, $coderef ) = @_;
 
-	$doc->prune('PPI::Token::Whitespace');
+	my $doc = $self->doc;
+	$doc->find(sub {
+		my ( $doc,$el ) = @_;
+		eval { $coderef->( $doc, $el ) };
+		warn "ERROR: $@" if $@;
+	});
+}
 
-	my @attribute_order;
+sub attribute_order {
+	my ( $self ) = @_;
 
-	$doc->find(sub {
+	my $attribute_order;
+	$self->find(sub {
 		my ($doc,$el) = @_;
-		if ( $el->isa('PPI::Statement') && $el->{children}->[0]->{content} eq 'has' ) {
-			warn "## has ",$el->{children}->[1]->string if $self->debug;
-			push @attribute_order, $el->{children}->[1]->string;
-		}
-		return 1;
+		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;
 	});
 
-	warn "# ", $self->class, " attribute_order ", dump( @attribute_order ) if $self->debug;
+	warn "# ", $self->class, " attribute_order ", dump( $attribute_order ) if $self->debug;
+
+	return $attribute_order;
+}
+
+sub includes {
+	my $self = shift;
+
+	my $include;
+	$self->find(sub {
+		my ($doc,$el) = @_;
+		return unless $el->isa('PPI::Statement::Include');
 
-	return @attribute_order;
+		warn "## include ",dump( $el->module, $el->type, $el->pragma ) if $self->debug;
+		push @{ $include->{ $el->type } }, $el->module 
+	});
+	warn "# ", $self->class, " include ", dump( $include ) if $self->debug;
+	return $include;
 }
 
 sub data {
 	my $self = shift;
-	[ $self->attribute_order ];
+	return {
+		includes => $self->includes,
+		attribute_order => $self->attribute_order,
+		doc => $self->doc,
+	};
 }
 
 1;