File Coverage

blib/lib/Filesys/POSIX/Userland/Find.pm
Criterion Covered Total %
statement 50 65 76.9
branch 15 40 37.5
condition 13 39 33.3
subroutine 7 7 100.0
pod 1 1 100.0
total 86 152 56.5


line stmt bran cond sub pod time code
1             # Copyright (c) 2014, cPanel, Inc.
2             # All rights reserved.
3             # http://cpanel.net/
4             #
5             # This is free software; you can redistribute it and/or modify it under the same
6             # terms as Perl itself. See the LICENSE file for further details.
7              
8             package Filesys::POSIX::Userland::Find;
9              
10 8     8   421 use strict;
  8         8  
  8         168  
11 8     8   23 use warnings;
  8         8  
  8         129  
12              
13 8     8   24 use Filesys::POSIX::Bits;
  8         8  
  8         2216  
14 8     8   38 use Filesys::POSIX::Module ();
  8         4  
  8         89  
15 8     8   23 use Filesys::POSIX::Path ();
  8         7  
  8         85  
16              
17 8     8   17 use Errno;
  8         12  
  8         3817  
18              
19             my @METHODS = qw(find);
20              
21             Filesys::POSIX::Module->export_methods( __PACKAGE__, @METHODS );
22              
23             =head1 NAME
24              
25             Filesys::POSIX::Userland::Find - Crawl directories in a filesystem
26              
27             =head1 SYNOPSIS
28              
29             use Filesys::POSIX;
30             use Filesys::POSIX::Real;
31             use Filesys::POSIX::Userland::Find;
32              
33             my $fs = Filesys::POSIX->new(Filesys::POSIX::Real->new,
34             'special' => 'real:/home/foo',
35             'noatime' => 1
36             );
37              
38             $fs->find(sub {
39             my ($path, $inode) = @_;
40             printf("0%o %s\n", $inode->{'mode'}, $path->full);
41             }, '/');
42              
43             =head1 DESCRIPTION
44              
45             This module provides an extension module to L that operates
46             very similarly in principle to the Perl Core module L, albeit with
47             some minor differences and fewer options. For the sake of efficiency, tail
48             recursion, rather than pure call recursion, is used to handle very deep
49             hierarchies.
50              
51             =head1 USAGE
52              
53             =over
54              
55             =item C<$fs-Efind($callback, @paths)>
56              
57             =item C<$fs-Efind($callback, $options, @paths)>
58              
59             C<$fs-Efind> will perform recursive descent into each path passed, printing
60             the full pathname of each item found relative to each item found in the
61             C<@paths> list. For each item found, both a Filesys::POSIX::Path object, and an
62             inode, respectively, are passed as the sole arguments to the callback. With
63             this mechanism, it is possible to retrieve path data from each item in every way
64             currently provided by L, without retaining global state to do so.
65             As a reference to the corresponding item's inode object is passed, there is no
66             need to perform a C<$fs-Estat> call to further inspect the item.
67              
68             When called with an C<$options> argument, specified in the form of an anonymous
69             HASH, the following flags (whose values are set nonzero) are honored:
70              
71             =over
72              
73             =item C
74              
75             Any symlinks found along the way are resolved; if the paths they resolve to are
76             those of directories, then further descent will be made into said directories.
77              
78             =item C
79              
80             Specifies the strategy to use when recursing through directories. Available
81             options are:
82              
83             =over
84              
85             =item breadth
86              
87             Traverse in a breadth-first manner. This is the default mode.
88              
89             =item depth
90              
91             Traverse in a depth-first manner.
92              
93             =item device
94              
95             Traverse inodes that are on the same device first. This mode also tracks the
96             current filesystem it is processing and invokes the C<$fs-Eenter_filesystem>
97             and C<$fs-Eexit_filesystem> methods when the current filesystem changes to
98             optimize these calls.
99              
100             =back
101              
102             =item C
103              
104             When set, ignore if a file or directory becomes missing during recursion. If the
105             value is a coderef, calls that function with the name of the missing file.
106              
107             =item C
108              
109             When set, ignore if a file or directory becomes unreadable during recursion. If
110             the value is a coderef, calls that function with the name of the inaccessible file.
111              
112             =cut
113              
114             sub find {
115 13     13 1 806 my $self = shift;
116 13         22 my $callback = shift;
117 13 100       83 my %opts = ref $_[0] eq 'HASH' ? %{ (shift) } : ();
  12         53  
118 13         28 my @args = @_;
119              
120 13         93 my @paths = map { Filesys::POSIX::Path->new($_) } @args;
  13         173  
121 13 100       22 my @inodes = map { $opts{'follow'} ? $self->stat($_) : $self->lstat($_) } @args;
  13         122  
122              
123 13 50       54 my $recursion_mode = defined $opts{'recursion_mode'} ? $opts{'recursion_mode'} : 'breadth';
124 13 0 33     62 if ( $recursion_mode ne 'breadth' && $recursion_mode ne 'depth' && $recursion_mode ne 'device' ) {
      33        
125 0         0 die "Invalid recursion mode $recursion_mode specified";
126             }
127              
128 13         31 my $current_dev;
129              
130 13         56 while ( my $inode = pop @inodes ) {
131 115         130 my $path = pop @paths;
132              
133 115 0 0     155 if ( $recursion_mode eq 'device' && ( !defined $current_dev || $current_dev != $inode->{'dev'} ) ) {
      33        
134 0 0 0     0 if ( defined $current_dev && $current_dev->can('exit_filesystem') ) {
135 0         0 $current_dev->exit_filesystem();
136             }
137 0 0 0     0 if ( defined $inode->{'dev'} && $inode->{'dev'}->can('enter_filesystem') ) {
138 0         0 $inode->{'dev'}->enter_filesystem();
139             }
140 0         0 $current_dev = $inode->{'dev'};
141             }
142              
143 115         202 $callback->( $path, $inode );
144              
145 114 100       247 if ( $inode->dir ) {
146 67         45 my $directory;
147 67         62 eval { $directory = $inode->directory->open; };
  67         120  
148 67 50       117 if ($@) {
149 0 0 0     0 if ( $! == &Errno::ENOENT && $opts{'ignore_missing'} ) {
    0 0        
150             $opts{'ignore_missing'}->( $path->full() )
151 0 0       0 if ref $opts{'ignore_missing'} eq 'CODE';
152             }
153             elsif ( $! == &Errno::EACCES && $opts{'ignore_inaccessible'} ) {
154             $opts{'ignore_inaccessible'}->( $path->full() )
155 0 0       0 if ref $opts{'ignore_inaccessible'} eq 'CODE';
156             }
157             else {
158 0         0 die $@;
159             }
160             }
161              
162 67 50       94 if ( defined $directory ) {
163 67         121 while ( defined( my $item = $directory->read ) ) {
164 236 100 100     790 next if $item eq '.' || $item eq '..';
165 102         183 my $subpath = Filesys::POSIX::Path->new( $path->full . "/$item" );
166 102         237 my $subnode = $self->{'vfs'}->vnode( $directory->get($item) );
167              
168 102 100 66     227 if ( $opts{'follow'} && defined $subnode && $subnode->link ) {
      100        
169 1         4 $subnode = $self->stat( $subnode->readlink );
170             }
171              
172 102 50 33     372 if ( !defined $subnode ) {
    50 33        
173 0 0       0 if ( $opts{'ignore_inaccessible'} ) {
174             $opts{'ignore_inaccessible'}->( $path->full() . "/$item" )
175 0 0       0 if ref $opts{'ignore_inaccessible'} eq 'CODE';
176             }
177             else {
178 0         0 die "Failed to read " . $path->full() . "/$item";
179             }
180             }
181             elsif ( $recursion_mode eq 'depth' || ( $recursion_mode eq 'device' && $current_dev == $subnode->{'dev'} ) ) {
182 0         0 push @paths, $subpath;
183 0         0 push @inodes, $subnode;
184             }
185             else {
186 102         128 unshift @paths, $subpath;
187 102         202 unshift @inodes, $subnode;
188             }
189             }
190 67         114 $directory->close;
191             }
192             }
193             }
194             }
195              
196             1;
197              
198             __END__