File Coverage

blib/lib/Metabrik/File/Find.pm
Criterion Covered Total %
statement 15 80 18.7
branch 0 18 0.0
condition 0 13 0.0
subroutine 5 10 50.0
pod 1 3 33.3
total 21 124 16.9


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # file::find Brik
5             #
6             package Metabrik::File::Find;
7 1     1   711 use strict;
  1         2  
  1         31  
8 1     1   5 use warnings;
  1         2  
  1         29  
9              
10 1     1   5 use base qw(Metabrik);
  1         2  
  1         356  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             path => [ qw($path_list) ],
20             },
21             attributes_default => {
22             path => [ '.' ],
23             },
24             commands => {
25             all => [ qw(directory_pattern file_pattern) ],
26             files => [ qw(directory|OPTIONAL file_pattern|OPTIONAL) ],
27             },
28             require_modules => {
29             'File::Find' => [ ],
30             },
31             };
32             }
33              
34             sub files {
35 0     0 0   my $self = shift;
36 0           my ($directory, $filepattern) = @_;
37              
38 0   0       $directory ||= '.';
39 0   0       $filepattern ||= '.*';
40 0 0         $self->brik_help_run_directory_not_found('files', $directory) or return;
41              
42 0           my $file_regex = qr/$filepattern/;
43 0           my $dot_regex = qr/^\.$/;
44 0           my $dot2_regex = qr/^\.\.$/;
45              
46 0           my @tmp_files = ();
47             my $sub = sub {
48 0     0     my $dir = $File::Find::dir;
49 0           my $name = $File::Find::name;
50 0           my $file = $_;
51             # Skip dot and double dot directories
52 0 0 0       if ($file =~ $dot_regex || $file =~ $dot2_regex) {
    0          
53             }
54             elsif ($file =~ $file_regex) {
55 0           push @tmp_files, $name;
56             }
57 0           };
58              
59             {
60 1     1   8 no warnings;
  1         2  
  1         459  
  0            
61 0           File::Find::find($sub, ( $directory ));
62             };
63              
64 0           @tmp_files = map { s/^\.\///; $_ } @tmp_files; # Remove leading dot slash
  0            
  0            
65 0           my %uniq_files = map { $_ => 1 } @tmp_files;
  0            
66 0           my @files = sort { $a cmp $b } keys %uniq_files;
  0            
67 0           @files = grep { -f $_ } @files; # Keep only files
  0            
68              
69 0           return \@files;
70             }
71              
72             #sub directories {
73             #}
74              
75             sub all {
76 0     0 0   my $self = shift;
77 0           my ($dirpattern, $filepattern) = @_;
78              
79 0           my $path = $self->path;
80 0 0         $self->brik_help_run_undef_arg('all', $dirpattern) or return;
81 0 0         $self->brik_help_run_undef_arg('all', $filepattern) or return;
82 0 0         $self->brik_help_run_undef_arg('all', $path) or return;
83 0 0         $self->brik_help_run_invalid_arg('all', $path, 'ARRAY') or return;
84              
85 0           my @dirs = ();
86 0           my @files = ();
87              
88             # Escape dirpattern if we are searching for a directory hierarchy
89 0           $dirpattern =~ s/\//\\\//g;
90              
91 0           my $dir_regex = qr/$dirpattern/;
92 0           my $file_regex = qr/$filepattern/;
93 0           my $dot_regex = qr/^\.$/;
94 0           my $dot2_regex = qr/^\.\.$/;
95              
96             my $sub = sub {
97 0     0     my $dir = $File::Find::dir;
98 0           my $file = $_;
99             # Skip dot and double dot directories
100 0 0 0       if ($file =~ $dot_regex || $file =~ $dot2_regex) {
    0 0        
101             }
102             elsif ($dir =~ $dir_regex && $file =~ $file_regex) {
103 0           push @dirs, "$dir/";
104 0           push @files, "$dir/$file";
105             }
106 0           };
107              
108             {
109 1     1   8 no warnings;
  1         2  
  1         209  
  0            
110 0           File::Find::find($sub, @$path);
111             };
112              
113 0           my %uniq_dirs = map { $_ => 1 } @dirs;
  0            
114 0           my %uniq_files = map { $_ => 1 } @files;
  0            
115 0           @dirs = sort { $a cmp $b } keys %uniq_dirs;
  0            
116 0           @files = sort { $a cmp $b } keys %uniq_files;
  0            
117              
118 0           @dirs = map { s/^\.\///; $_ } @dirs; # Remove leading dot slash
  0            
  0            
119 0           @files = map { s/^\.\///; $_ } @files; # Remove leading dot slash
  0            
  0            
120              
121             return {
122 0           directories => \@dirs,
123             files => \@files,
124             };
125             }
126              
127             1;
128              
129             __END__