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   190084 use strict;
  4         36  
  4         113  
6 4     4   19 use warnings;
  4         8  
  4         99  
7              
8 4     4   2008 use File::Find::Rule;
  4         32018  
  4         33  
9 4     4   214 use File::Basename;
  4         8  
  4         276  
10 4     4   26 use List::Util qw(first);
  4         8  
  4         452  
11              
12 4     4   1838 use EPublisher::Source::Base;
  4         12  
  4         130  
13 4     4   1646 use EPublisher::Utils::PPI qw(extract_pod extract_package);
  4         13  
  4         2429  
14              
15             our @ISA = qw( EPublisher::Source::Base );
16              
17             our $VERSION = 1.1;
18              
19             sub load_source{
20 26     26 1 4124 my ($self, $source_path) = @_;
21            
22 26         75 my $options = $self->_config;
23            
24 26   100     111 my $path = $source_path || $options->{path};
25              
26 26 100       62 if ( !defined $path ) {
27 1         4 $self->publisher->debug( "400: No path given" );
28 1         5 return;
29             }
30            
31 25 100       91 my @paths = ref $path eq 'ARRAY' ? @{$path} : ($path);
  8         24  
32 25         41 my @paths_to_use;
33            
34 25         48 for my $path_to_check ( @paths ) {
35 29 100       89 if ( !defined $path_to_check ) {
36 1         4 $self->publisher->debug( "400: undefined path given" );
37 1         4 next;
38             }
39 28 100       501 if ( !-d $path_to_check ) {
40 3         19 $self->publisher->debug( "400: $path_to_check does not exist" );
41 3         18 next;
42             }
43            
44 25         98 push @paths_to_use, $path_to_check;
45             }
46            
47 25 100       69 return if !@paths_to_use;
48            
49 23         39 my @testrule;
50 23 100       59 if ( $options->{testfiles} ) {
51 1         8 @testrule = (qr/\.t\z/);
52             }
53              
54 23         686 my $rule = File::Find::Rule->file->name( qr/\.p(?:m|od|l)\z/, @testrule );
55              
56 23 100 100     1767 if ( defined $options->{subdirs} && $options->{subdirs} == 0 ) {
57 1         5 $rule->maxdepth( 1 );
58             }
59              
60 23         100 my @files = sort $rule->in( @paths_to_use );
61 23         18848 my @pods;
62            
63             my @excludes;
64 23 100       83 if ( $options->{exclude} ) {
65 4 100       40 @excludes = ref $options->{exclude} eq 'ARRAY' ? @{ $options->{exclude} } : ($options->{exclude});
  1         4  
66             }
67              
68 23 100       68 $options->{title} = '' if !defined $options->{title};
69            
70             FILE:
71 23         49 for my $file ( @files ) {
72            
73 60 100   8   494 next FILE if first{ $file =~ m{\A \Q$_\E }xms }@excludes;
  8         70  
74            
75 58         369 my $pod = extract_pod( $file, $self->_config );
76            
77 58 100       57640 next FILE if !$pod;
78              
79 31         1086 my $filename = basename $file;
80 31         78 my $title = $filename;
81              
82 31 100       126 if ( $options->{title} eq 'pod' ) {
    100          
    100          
83 18         88 ($title) = $pod =~ m{ =head1 \s+ (.*) }x;
84 18 100       59 $title = '' if !defined $title;
85             }
86             elsif ( $options->{title} eq 'package' ) {
87 6         22 my $package = extract_package( $file, $self->_config );
88 6 100       611 $title = $package if $package;
89             }
90             elsif ( length $options->{title} ) {
91 1         4 $title = $options->{title};
92             }
93            
94 31         169 push @pods, { pod => $pod, title => $title, filename => $filename };
95             }
96            
97 23         256 return @pods;
98             }
99              
100             1;
101              
102             __END__