File Coverage

blib/lib/Trav/Dir.pm
Criterion Covered Total %
statement 12 104 11.5
branch 0 60 0.0
condition 0 21 0.0
subroutine 4 7 57.1
pod 2 3 66.6
total 18 195 9.2


line stmt bran cond sub pod time code
1             package Trav::Dir;
2 1     1   795 use warnings;
  1         2  
  1         33  
3 1     1   5 use strict;
  1         2  
  1         18  
4 1     1   4 use Carp;
  1         2  
  1         53  
5 1     1   5 use utf8;
  1         2  
  1         5  
6             our $VERSION = '0.01';
7              
8             sub new
9             {
10 0     0 1   my ($class, %options) = @_;
11 0           my $o;
12 0 0         if ($options{verbose}) {
13 0           $o->{verbose} = $options{verbose};
14 0           delete $options{verbose};
15             }
16 0 0         if ($options{rejfile}) {
17 0           $o->{rejfile} = $options{rejfile};
18 0           delete $options{rejfile};
19             }
20 0 0         if ($options{no_trav}) {
21 0           $o->{no_trav} = $options{no_trav};
22 0           delete $options{no_trav};
23             }
24 0           $o->{minsize} = 0;
25 0 0         if ($options{minsize}) {
26 0           $o->{minsize} = $options{minsize};
27 0           delete $options{minsize};
28 0           $o->{size} = 1;
29             }
30 0           $o->{maxsize} = 'inf';
31 0 0         if ($options{maxsize}) {
32 0           $o->{maxsize} = $options{maxsize};
33 0           delete $options{maxsize};
34 0           $o->{size} = 1;
35             }
36 0 0         if ($options{only}) {
37 0           $o->{only} = $options{only};
38 0           delete $options{only};
39             }
40 0 0         if ($options{callback}) {
41 0           $o->{callback} = $options{callback};
42 0           delete $options{callback};
43             }
44 0 0         if ($options{no_dir}) {
45 0           $o->{no_dir} = $options{no_dir};
46 0           delete $options{no_dir};
47             }
48 0 0         if ($options{data}) {
49 0           $o->{data} = $options{data};
50 0           delete $options{data};
51             }
52 0 0         if ($options{preprocess}) {
53 0           $o->{preprocess} = $options{preprocess};
54 0           delete $options{preprocess};
55             }
56 0           for my $k (keys %options) {
57 0           carp "Unknown option $k";
58 0           delete $options{$k};
59             }
60 0           bless $o, $class;
61             }
62              
63             sub find_files
64             {
65 0     0 1   my ($o, $dir, $f) = @_;
66 0 0 0       if (! $f && ! $o->{callback}) {
67             # There is no work for us to do
68 0           carp "No file list and no callback";
69 0           return;
70             }
71 0           my $dh;
72 0 0         if (! opendir ($dh, $dir)) {
73 0           warn "opendir $dir failed: $!";
74 0           return;
75             }
76 0           my @files = readdir ($dh);
77 0           closedir ($dh);
78 0 0         if ($o->{preprocess}) {
79 0           &{$o->{preprocess}} ($o->{data}, $dir, \@files);
  0            
80             }
81 0           for my $file (@files) {
82 0 0 0       if ($file eq '.' || $file eq '..') {
83 0           next;
84             }
85 0 0 0       if ($o->{rejfile} && $file =~ $o->{rejfile}) {
86 0 0         if ($o->{verbose}) {
87 0           print "Skipping $file\n";
88             }
89 0           next;
90             }
91 0           my $dfile = "$dir/$file";
92 0 0         if ($o->{verbose}) {
93 0           print "$dir $file\n";
94             }
95 0           my $is_dir = 0;
96 0 0         if (-d $dfile) {
97 0 0 0       if (! $o->{no_trav} || $dfile !~ $o->{no_trav}) {
98 0 0         if (-l $dfile) {
99             # Skip symbolic links
100 0 0         if ($o->{verbose}) {
101 0           print "Skipping symbolic link '$dfile'.\n";
102             }
103 0           next;
104             }
105 0           find_files ($o, $dfile, $f);
106             }
107 0 0         if ($o->{no_dir}) {
108 0           next;
109             }
110 0           $is_dir = 1;
111             }
112 0 0         if (-l $dfile) {
113             # Skip symbolic links
114 0 0         if ($o->{verbose}) {
115 0           print "Skipping symbolic link '$dfile'.\n";
116             }
117 0           next;
118             }
119 0 0 0       if (! $is_dir && $o->{size}) {
120 0           my $size = -s $dfile;
121 0 0 0       if ($size > $o->{maxsize} || $size < $o->{minsize}) {
122 0 0         if ($o->{verbose}) {
123 0           print "Skipping $file due to size $size > $o->{maxsize} or < $o->{minsize}\n";
124             }
125 0           next;
126             }
127             }
128 0 0 0       if (! $o->{only} || $file =~ $o->{only}) {
129 0           $o->save ($dfile, $f);
130             }
131             }
132             }
133              
134             sub save
135             {
136 0     0 0   my ($o, $dfile, $f) = @_;
137 0 0         if ($f) {
138 0           push @$f, $dfile;
139             }
140 0 0         if ($o->{callback}) {
141 0           &{$o->{callback}} ($o->{data}, $dfile);
  0            
142             }
143             }
144              
145             1;