/[Frey]/trunk/lib/Frey/PPI.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/Frey/PPI.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 487 by dpavlin, Mon Nov 24 17:09:00 2008 UTC revision 1133 by dpavlin, Tue Jun 30 15:10:55 2009 UTC
# Line 1  Line 1 
1  package Frey::PPI;  package Frey::PPI;
2  use Moose;  use Moose;
3    
4  extends 'Frey::ClassLoader';  extends 'Frey::Class::Loader';
5    
6  use PPI;  use PPI;
7  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
8    use File::Find;
9    
10  has 'class' => (  has 'class' => (
11          is => 'rw',          is => 'rw',
# Line 28  has 'doc' => ( Line 29  has 'doc' => (
29          },          },
30  );  );
31    
32  sub find {  sub find_doc_el {
33          my ( $self, $coderef ) = @_;          my ( $self, $coderef ) = @_;
34    
35          my $doc = $self->doc;          my $doc = $self->doc;
# Line 43  sub attribute_order { Line 44  sub attribute_order {
44          my ( $self ) = @_;          my ( $self ) = @_;
45    
46          my @attribute_order;          my @attribute_order;
47          $self->find(sub {          $self->find_doc_el(sub {
48                  my ($doc,$el) = @_;                  my ($doc,$el) = @_;
49                  return unless                  return unless
50                          $el->isa('PPI::Statement') &&                          $el->isa('PPI::Statement') &&
# Line 64  sub includes { Line 65  sub includes {
65          my $self = shift;          my $self = shift;
66    
67          my $include;          my $include;
68          $self->find(sub {          $self->find_doc_el(sub {
69                  my ($doc,$el) = @_;                  my ($doc,$el) = @_;
70                  return unless $el->isa('PPI::Statement::Include');                  return unless $el->isa('PPI::Statement::Include');
71    
72                  warn "## include ",dump( $el->module, $el->type, $el->pragma ) if $self->debug;                  warn "## include ",dump( $el->module, $el->type, $el->pragma ) if $self->debug;
73                  push @{ $include->{ $el->type } }, $el->module                  push @{ $include->{ $el->type } }, $el->module
74                            unless $el->module eq 'lib'; # skip use lib 'lib';
75          });          });
76          warn "# ", $self->class, " include ", dump( $include ) if $self->debug;          warn "# ", $self->class, " include ", dump( $include ) if $self->debug;
77          return $include;          return $include;
# Line 80  our $class_has_tests; Line 82  our $class_has_tests;
82  sub parse_tests {  sub parse_tests {
83          my ( $self ) = @_;          my ( $self ) = @_;
84    
85          map {          finddepth({ no_chdir => 1, wanted => sub {
86                    return unless m{\.t$};
87    
88                  warn "## ppi test $_" if $self->debug;                  warn "## ppi test $_" if $self->debug;
89    
90                  my $doc = Frey::PPI->new( class => $_ );                  my $ppi = Frey::PPI->new( class => $_ );
91                  my @tests;                  my @tests;
92    
93  #               warn "## ",dump( $doc );  #               warn "## ",dump( $doc );
94    
95                  $doc->find(sub {                  $ppi->find_doc_el(sub {
96                          my ($doc,$el) = @_;                          my ($doc,$el) = @_;
97                          return unless                          return unless
98                                  $el->isa('PPI::Statement') &&                                  $el->isa('PPI::Statement') &&
# Line 99  sub parse_tests { Line 103  sub parse_tests {
103                          my $class = $el->child(1)->child(0)->child(0)->literal;                          my $class = $el->child(1)->child(0)->child(0)->literal;
104                          $class_has_tests->{$class}->{$_}++;                          $class_has_tests->{$class}->{$_}++;
105                  });                  });
106          } glob 't/*.t';          } }, 't/');
107          warn "# collected class tests ",dump( $class_has_tests ) if $self->debug;          warn "# collected class tests ",dump( $class_has_tests ) if $self->debug;
108    
109          return $class_has_tests;          return $class_has_tests;
# Line 114  sub parse_tests { Line 118  sub parse_tests {
118  sub has_tests {  sub has_tests {
119          my ($self) = shift;          my ($self) = shift;
120                    
121          $self->parse_tests unless defined $class_has_tests;          $self->parse_tests unless $class_has_tests;
122    
123          my $class = $self->class;          my $class = $self->class;
124    
125          if ( my $tests = $class_has_tests->{ $class } ) {          if ( my $tests = $class_has_tests->{ $class } ) {
126  #               warn "# has_tests $class ",dump( keys %$tests );                  my @tests = keys %$tests;
127                  return [ keys %$tests ];                  warn "# has_tests $class ",dump( @tests );
128                    return @tests;
129          }          }
         return [];  
130  }  }
131    
132  =head2 as_data  =head2 as_data
# Line 140  sub as_data { Line 144  sub as_data {
144          };          };
145  }  }
146    
147    __PACKAGE__->meta->make_immutable;
148    no Moose;
149    
150  1;  1;
Legend:
Removed from v.487  
changed lines
  Added in v.1133
  ViewVC Help
Powered by ViewVC 1.1.26