lib/Frey/PPI.pm

package Frey::PPI;
use Moose;

extends 'Frey::ClassLoader';

use PPI;
use Data::Dump qw/dump/;

has 'class' => (
        is => 'rw',
        isa => 'Str',
        required => 1,
        documentation => 'Name of class to parse',
);

my $ppi_doc;

sub doc {
        my ( $self ) = @_;

        if ( ! $ppi_doc ) {
                warn "# parse ", $self->class;
                my $doc = PPI::Document->new( $self->class_path( $self->class ) ) || die $!;
                $doc->prune('PPI::Token::Whitespace');
                $ppi_doc = $doc;
        }
        return $ppi_doc;
}

sub attribute_order {
        my ( $self ) = @_;

        my $doc = $self->doc;

        my @attribute_order;

        $doc->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;
        });

        warn "# ", $self->class, " attribute_order ", dump( @attribute_order ) if $self->debug;

        return @attribute_order;
}

sub data {
        my $self = shift;
        my $doc = $self->doc;
        my $include;
        $doc->find( sub {
                my ($doc,$el) = @_;
                if ( $el->isa('PPI::Statement::Include') ) {
                        warn dump( $el->module, $el->type, $el->pragma );
                        push @{ $include->{ $el->type } }, $el->module 
                }
                return 1;
        });
        warn "# ", $self->class, " ", dump( $include ) if $self->debug;

        return {
                include => $include,
                doc => $doc,
        };
}

1;
1	dpavlin	331	package Frey::PPI;
2			use Moose;
3
4			extends 'Frey::ClassLoader';
5
6			use PPI;
7			use Data::Dump qw/dump/;
8
9			has 'class' => (
10			is => 'rw',
11			isa => 'Str',
12			required => 1,
13			documentation => 'Name of class to parse',
14			);
15
16	dpavlin	362	my $ppi_doc;
17
18			sub doc {
19			my ( $self ) = @_;
20
21			if ( ! $ppi_doc ) {
22			warn "# parse ", $self->class;
23			my $doc = PPI::Document->new( $self->class_path( $self->class ) ) \|\| die $!;
24			$doc->prune('PPI::Token::Whitespace');
25			$ppi_doc = $doc;
26			}
27			return $ppi_doc;
28			}
29
30	dpavlin	331	sub attribute_order {
31			my ( $self ) = @_;
32
33	dpavlin	362	my $doc = $self->doc;
34	dpavlin	331
35			my @attribute_order;
36
37			$doc->find(sub {
38			my ($doc,$el) = @_;
39			if ( $el->isa('PPI::Statement') && $el->{children}->[0]->{content} eq 'has' ) {
40			warn "## has ",$el->{children}->[1]->string if $self->debug;
41			push @attribute_order, $el->{children}->[1]->string;
42			}
43			return 1;
44			});
45
46			warn "# ", $self->class, " attribute_order ", dump( @attribute_order ) if $self->debug;
47
48			return @attribute_order;
49			}
50
51			sub data {
52			my $self = shift;
53	dpavlin	362	my $doc = $self->doc;
54			my $include;
55			$doc->find( sub {
56			my ($doc,$el) = @_;
57			if ( $el->isa('PPI::Statement::Include') ) {
58			warn dump( $el->module, $el->type, $el->pragma );
59			push @{ $include->{ $el->type } }, $el->module
60			}
61			return 1;
62			});
63			warn "# ", $self->class, " ", dump( $include ) if $self->debug;
64
65			return {
66			include => $include,
67			doc => $doc,
68			};
69	dpavlin	331	}
70
71			1;