File Coverage

blib/lib/EPublisher/Source/Plugin/Dir.pm
Criterion Covered Total %
statement 66 66 100.0
branch 34 34 100.0
condition 6 6 100.0
subroutine 9 9 100.0
pod 1 1 100.0
total 116 116 100.0


line stmt bran cond sub pod time code
1             package EPublisher::Source::Plugin::Dir;
2              
3             # ABSTRACT: Dir source plugin
4              
5 4     4   200550 use strict;
  4         34  
  4         112  
6 4     4   21 use warnings;
  4         6  
  4         114  
7              
8 4     4   2026 use File::Find::Rule;
  4         32149  
  4         36  
9 4     4   211 use File::Basename;
  4         8  
  4         274  
10 4     4   28 use List::Util qw(first);
  4         8  
  4         414  
11              
12 4     4   1835 use EPublisher::Source::Base;
  4         12  
  4         155  
13 4     4   1591 use EPublisher::Utils::PPI qw(extract_pod extract_package);
  4         14  
  4         2542  
14              
15             our @ISA = qw( EPublisher::Source::Base );
16              
17             our $VERSION = 1.1;
18              
19             sub load_source{
20 26     26 1 4294 my ($self, $source_path) = @_;
21            
22 26         115 my $options = $self->_config;
23            
24 26   100     108 my $path = $source_path || $options->{path};
25              
26 26 100       64 if ( !defined $path ) {
27 1         8 $self->publisher->debug( "400: No path given" );
28 1         5 return;
29             }
30            
31 25 100       77 my @paths = ref $path eq 'ARRAY' ? @{$path} : ($path);
  8         23  
32 25         39 my @paths_to_use;
33            
34 25         50 for my $path_to_check ( @paths ) {
35 29 100       57 if ( !defined $path_to_check ) {
36 1         4 $self->publisher->debug( "400: undefined path given" );
37 1         4 next;
38             }
39 28 100       497 if ( !-d $path_to_check ) {
40 3         18 $self->publisher->debug( "400: $path_to_check does not exist" );
41 3         19 next;
42             }
43            
44 25         129 push @paths_to_use, $path_to_check;
45             }
46            
47 25 100       73 return if !@paths_to_use;
48            
49 23         43 my @testrule;
50 23 100       57 if ( $options->{testfiles} ) {
51 1         7 @testrule = (qr/\.t\z/);
52             }
53              
54 23         746 my $rule = File::Find::Rule->file->name( qr/\.p(?:m|od|l)\z/, @testrule );
55              
56 23 100 100     1827 if ( defined $options->{subdirs} && $options->{subdirs} == 0 ) {
57 1         5 $rule->maxdepth( 1 );
58             }
59              
60 23         89 my @files = sort $rule->in( @paths_to_use );
61 23         18996 my @pods;
62            
63             my @excludes;
64 23 100       86 if ( $options->{exclude} ) {
65 4 100       32 @excludes = ref $options->{exclude} eq 'ARRAY' ? @{ $options->{exclude} } : ($options->{exclude});
  1         4  
66             }
67              
68 23 100       71 $options->{title} = '' if !defined $options->{title};
69            
70             FILE:
71 23         51 for my $file ( @files ) {
72            
73 61 100   8   489 next FILE if first{ $file =~ m{\A \Q$_\E }xms }@excludes;
  8         71  
74            
75 59         399 my $pod = extract_pod( $file, $self->_config );
76            
77 59 100       65475 next FILE if !$pod;
78              
79 31         1444 my $filename = basename $file;
80 31         73 my $title = $filename;
81              
82 31 100       138 if ( $options->{title} eq 'pod' ) {
    100          
    100          
83 18         99 ($title) = $pod =~ m{ =head1 \s+ (.*) }x;
84 18 100       66 $title = '' if !defined $title;
85             }
86             elsif ( $options->{title} eq 'package' ) {
87 6         22 my $package = extract_package( $file, $self->_config );
88 6 100       688 $title = $package if $package;
89             }
90             elsif ( length $options->{title} ) {
91 1         3 $title = $options->{title};
92             }
93            
94 31         168 push @pods, { pod => $pod, title => $title, filename => $filename };
95             }
96            
97 23         285 return @pods;
98             }
99              
100             1;
101              
102             __END__