File Coverage

lib/Badger/Filesystem.pm
Criterion Covered Total %
statement 244 253 96.4
branch 97 140 69.2
condition 49 96 51.0
subroutine 54 59 91.5
pod 49 49 100.0
total 493 597 82.5


line stmt bran cond sub pod time code
1             #========================================================================
2             #
3             # Badger::Filesystem
4             #
5             # DESCRIPTION
6             # OO representation of a filesystem.
7             #
8             # AUTHOR
9             # Andy Wardley
10             #
11             #========================================================================
12              
13             package Badger::Filesystem;
14              
15 70     70   10866 use File::Spec;
  70         145  
  70         2194  
16 70     70   335 use Cwd 'getcwd';
  70         112  
  70         16274  
17             use Badger::Class
18             version => 0.01,
19             debug => 0,
20             base => 'Badger::Prototype Badger::Filesystem::Base',
21             import => 'class',
22             utils => 'params is_object random_name',
23             constants => 'HASH ARRAY TRUE REFS PKG',
24             constant => {
25             virtual => 0,
26             NO_FILENAME => 1,
27             FILESPEC => 'File::Spec',
28             FINDBIN => 'FindBin',
29             ROOTDIR => File::Spec->rootdir,
30             CURDIR => File::Spec->curdir,
31             UPDIR => File::Spec->updir,
32             FS => 'Badger::Filesystem',
33             VFS => 'Badger::Filesystem::Virtual',
34             UFS => 'Badger::Filesystem::Universal',
35             PATH => 'Badger::Filesystem::Path',
36             FILE => 'Badger::Filesystem::File',
37             DIRECTORY => 'Badger::Filesystem::Directory',
38             VISITOR => 'Badger::Filesystem::Visitor',
39             },
40             exports => {
41             any => 'FS PATH FILE DIR DIRECTORY cwd getcwd rel2abs abs2rel',
42             tags => {
43             types => 'Path File Dir Directory Cwd Bin',
44             dirs => 'ROOTDIR UPDIR CURDIR',
45             },
46             hooks => {
47             VFS => sub {
48             # load VFS module and call its export() method
49 2         12 class(shift->VFS)->load->pkg->export(shift, shift)
50             },
51             UFS => sub {
52             # load UFS module and call its export() method
53 1         5 class(shift->UFS)->load->pkg->export(shift, shift)
54             },
55 70         3668 '$Bin' => \&_export_findbin_hook,
56             },
57             },
58             messages => {
59             open_failed => 'Failed to open %s %s: %s',
60             delete_failed => 'Failed to delete %s %s: %s',
61             bad_volume => 'Volume mismatch: %s vs %s',
62             bad_stat => 'Nothing known about %s',
63             copy_failed => 'Failed to %s file from %s to %s: %s',
64             no_path => 'Unable to determine location of %s',
65 70     70   3996 };
  70         324  
66              
67 70     70   31847 use Badger::Filesystem::File;
  70         174  
  70         560  
68 70     70   475 use Badger::Filesystem::Directory;
  70         145  
  70         441  
69              
70             #-----------------------------------------------------------------------
71             # special export hooks to make $Bin available from FindBin
72             #-----------------------------------------------------------------------
73              
74             sub _export_findbin_hook {
75 2     2   7 my ($class, $target) = @_;
76 2         8 class($class->FINDBIN)->load;
77 2         22 $class->export_symbol($target, Bin => \$FindBin::Bin);
78             };
79              
80              
81             #-----------------------------------------------------------------------
82             # aliases
83             #-----------------------------------------------------------------------
84              
85             *DIR = \&DIRECTORY; # constant class name
86             *Dir = \&Directory; # constructor sub
87             *dir = \&directory; # object method
88             *split_dir = \&split_directory; # ...because typing 'directory'
89             *join_dir = \&join_directory; # gets tedious quickly
90             *collapse_dir = \&collapse_directory;
91             *dir_exists = \&directory_exists;
92             *create_dir = \&create_directory;
93             *delete_dir = \&delete_directory;
94             *open_dir = \&open_directory;
95             *read_dir = \&read_directory;
96             *temp_dir = \&temp_directory;
97             *dir_child = \&directory_child;
98             *dir_children = \&directory_children;
99             *mkdir = \&create_directory;
100             *rmdir = \&delete_directory;
101             *touch = \&touch_file;
102              
103              
104             #-----------------------------------------------------------------------
105             # In this base class definitive paths are the same as absolute paths.
106             # However, in subclasses (like Badger::Filesystem::Virtual) we want
107             # to differentiate between absolute paths in a virtual filesystem
108             # (e.g. /about/badger.html) and the definitive paths that they map to
109             # in a real file system (e.g. /home/abw/web/badger/about/badger.html).
110             # We make the further distinction between definitive paths used for
111             # reading or writing, and call the appropriate method to perform any
112             # virtual -> real mapping before operating on any file or directory.
113             # But like I said, these are just hooks for subclasses to use if they
114             # need them. In the base class, we patch them straight into the plain
115             # old absolute() method.
116             #-----------------------------------------------------------------------
117              
118             *definitive = \&absolute;
119             *definitive_read = \&absolute;
120             *definitive_write = \&absolute;
121              
122              
123             #-----------------------------------------------------------------------
124             # factory subroutines
125             #-----------------------------------------------------------------------
126              
127             sub Path {
128 58 100   58 1 273 return PATH unless @_;
129 28 50 66     112 return @_ == 1 && is_object(PATH, $_[0])
130             ? $_[0] # return existing Path object
131             : FS->path(@_); # or construct a new one
132             }
133              
134             sub File {
135 296 100   296 1 1075 return FILE unless @_;
136 10 50 66     76 return @_ == 1 && is_object(FILE, $_[0])
137             ? $_[0] # ditto for File object
138             : FS->file(@_);
139             }
140              
141             sub Directory {
142 246 100   246 1 1176 return DIRECTORY unless @_;
143 12 50 66     80 return @_ == 1 && is_object(DIRECTORY, $_[0])
144             ? $_[0] # ditto for Directory object
145             : FS->directory(@_);
146             }
147              
148             sub Cwd {
149 3     3 1 12 FS->directory
150             }
151              
152             sub Bin {
153 17     17 1 92 class(FINDBIN)->load;
154 17         98 FS->directory($FindBin::Bin);
155             }
156              
157              
158             #-----------------------------------------------------------------------
159             # generated methods
160             #-----------------------------------------------------------------------
161              
162             class->methods(
163             # define methods for path/root/updir/curdir that access a prototype
164             # object when called as class methods.
165             map {
166             my $name = $_; # fresh copy of lexical for binding in closure
167             $name => sub {
168 4     4   14 $_[0]->prototype->{ $name };
        0      
169             }
170             }
171             qw( rootdir updir curdir separator )
172             );
173              
174              
175             #-----------------------------------------------------------------------
176             # constructor methods
177             #-----------------------------------------------------------------------
178              
179             sub init {
180 26     26 1 73 my ($self, $config) = @_;
181              
182             # NEW CODE: trying to abstract out the file specification so that I
183             # can slot in a Universal file spec decoy which always generates URIs
184             my $spec = $self->{ spec }
185             = $config->{ spec }
186             || $config->{ filespec }
187 26   33     374 || $self->FILESPEC;
188            
189 26         48 $self->debug("spec is $spec") if DEBUG;
190            
191             # The tokens used to represent the root directory ('/'), the
192             # parent directory ('..') and current directory ('.') default to
193             # constants grokked from File::Spec. To determine the path separator
194             # we have to resort to an ugly hack. The File::Spec module hard-codes
195             # the path separator in the catdir() method so we have to make a round-
196             # trip through catdir() to grok the separator in a cross-platform manner
197 26   33     244 $self->{ rootdir } = $config->{ rootdir } || $spec->rootdir;
198 26   33     181 $self->{ updir } = $config->{ updir } || $spec->updir;
199 26   33     234 $self->{ curdir } = $config->{ curdir } || $spec->curdir;
200 26   33     95 $self->{ separator } = $config->{ separator } || do {
201             my $sep = FILESPEC->catdir(('badger') x 2);
202             $sep =~ s/badger//g;
203             $sep;
204             };
205              
206             # flag to indicate if directory scans should return all entries
207 26   50     124 $self->{ all_entries } = $config->{ all_entries } || 0;
208              
209             # current working can be specified explicitly, otherwise we leave it
210             # undefined and let cwd() call getcwd() determine it dynamically
211 26         61 $self->{ cwd } = $config->{ cwd };
212            
213             # additional options, e.g. codec, encoding
214 26         177 $self->init_options($config);
215            
216 26         61 return $self;
217             }
218              
219             sub spec {
220             return ref $_[0] eq HASH
221             ? $_[0]->{ spec }
222 4014 50   4014 1 13153 : FILESPEC;
223             }
224              
225             sub path {
226 29     29 1 59 Path->new( shift->_child_args( path => @_ ) );
227             }
228              
229             sub file {
230 285     285 1 664 File->new( shift->_child_args( file => @_ ) );
231             }
232              
233             sub directory {
234 232     232 1 515 my $self = shift;
235 232         486 my $args = $self->_child_args( directory => @_ );
236            
237             # default directory is the current working directory
238             $args->{ path } = $self->cwd
239 232 100 66     846 if exists $args->{ path } && ! defined $args->{ path };
240            
241 232         463 Directory->new($args);
242             }
243              
244             sub root {
245 1     1 1 3 my $self = shift->prototype;
246 1         6 $self->directory($self->{ rootdir });
247             }
248              
249             sub cwd {
250 548     548 1 679 my $cwd;
251 548 100       834 if (@_) {
252             # called as an object or class method
253 541         1063 my $self = shift->prototype;
254             # if we have a hard-coded cwd set then return that, otherwise call
255             # getcwd to return the real current working directory. NOTE: we don't
256             # cache the dynamically resolved cwd as it'll change if chdir() is called
257 541   66     5298 $cwd = $self->{ cwd } || getcwd;
258             }
259             else {
260             # called as a subroutine
261 7         64 $cwd = getcwd;
262             }
263             # pass through File::Spec to sanitise path to local filesystem
264             # convention - otherwise we get /forward/slashes on Win32
265 548         9122 FILESPEC->canonpath($cwd);
266             }
267              
268              
269             #-----------------------------------------------------------------------
270             # path manipulation methods
271             #-----------------------------------------------------------------------
272              
273             sub merge_paths {
274 99     99 1 207 my ($self, $base, $path) = @_;
275 99         160 my $spec = $self->spec;
276 99         884 my @p1 = $spec->splitpath($base);
277 99         594 my @p2 = $spec->splitpath($path);
278              
279             # check volumes match
280 99 50 33     383 if (defined $p2[0] and length $p2[0]) {
281 0   0     0 $p1[0] ||= $p2[0];
282 0 0       0 return $self->error_msg( bad_volume => $p1[0], $p1[0] )
283             unless $p1[0] eq $p2[0];
284             }
285 99         137 shift(@p2);
286 99   50     265 my $vol = shift(@p1) || '';
287 99         133 my $file = pop @p2;
288            
289 99         1010 $spec->catpath($vol, $spec->catdir(@p1, @p2), $file);
290             }
291            
292             sub join_path {
293 6     6 1 11 my $self = shift;
294 6 50       13 my @args = map { defined($_) ? $_ : '' } @_[0..2];
  18         33  
295 6         13 my $spec = $self->spec;
296 6         74 $spec->canonpath( $spec->catpath(@args) );
297             }
298              
299             sub join_directory {
300 2488     2488 1 2768 my $self = shift;
301 2488 100       4280 my $dir = @_ == 1 ? shift : [ @_ ];
302 2488         3630 my $spec = $self->spec;
303 2488 0       4126 $self->debug("join_dir(", ref $dir eq ARRAY ? '[' . join(', ', @$dir) . ']' : $dir, ")\n") if $DEBUG;
    50          
304 2488 100       11385 ref $dir eq ARRAY
305             ? $spec->catdir(@$dir)
306             : $spec->canonpath($dir);
307             }
308              
309             sub split_path {
310 532     532 1 677 my $self = shift;
311 532         861 my $path = $self->join_directory(@_);
312 532 50       979 my @split = map { defined($_) ? $_ : '' } $self->spec->splitpath($path);
  1596         3336  
313 532 50       1148 $self->debug("split_path($path) => ", join(', ', @split), "\n") if $DEBUG;
314 532 50       2490 return wantarray ? @split : \@split;
315             }
316              
317             sub split_directory {
318 98     98 1 133 my $self = shift;
319 98         198 my $path = $self->join_directory(@_);
320 98         202 my @split = $self->spec->splitdir($path);
321 98 100       470 return wantarray ? @split : \@split;
322             }
323              
324             sub collapse_directory {
325 78     78 1 316 my $self = shift->prototype;
326 78         216 my @dirs = $self->split_directory(shift);
327 78         220 my ($up, $cur) = @$self{qw( updir curdir )};
328 78         127 my ($node, @path);
329 78         211 while (@dirs) {
330 473         570 $node = shift @dirs;
331 473 50       814 if ($node eq $cur) {
    100          
332             # do nothing
333             }
334             elsif ($node eq $up) {
335 20 50       63 pop @path if @path;
336             }
337             else {
338 453         821 push(@path, $node);
339             }
340             }
341 78         211 $self->join_directory(@path);
342             }
343              
344             sub slash_directory {
345 4     4 1 22 my $self = shift->prototype;
346 4         13 my $path = $self->absolute(shift);
347 4   66     15 my $slash = $self->{ slashed } ||= do {
348 2         8 my $sep = quotemeta $self->{ separator };
349 2         44 qr/$sep$/;
350             };
351 4 50       28 $path .= $self->{ separator } unless $path =~ $slash;
352 4         20 return $path;
353             }
354              
355              
356             #-----------------------------------------------------------------------
357             # absolute and relative path tests and transmogrifiers
358             #-----------------------------------------------------------------------
359              
360             sub is_absolute {
361 107     107 1 170 my $self = shift;
362             # $self->debug("args: ", $self->dump_data(\@_));
363 107 100       191 $self->spec->file_name_is_absolute(
364             $self->join_directory(@_)
365             ) ? 1 : 0;
366             }
367              
368             sub is_relative {
369 1 50   1 1 8 shift->is_absolute(@_) ? 0 : 1;
370             }
371              
372             sub absolute {
373 617     617 1 786 my $self = shift;
374 617         1055 my $path = $self->join_directory(shift);
375 617         1008 my $spec = $self->spec;
376 617 100       2800 return $path if $spec->file_name_is_absolute($path);
377 528   33     1521 $spec->catdir(shift || $self->cwd, $path);
378             }
379              
380             sub relative {
381 1     1 1 2 my $self = shift;
382 1   33     2 $self->spec->abs2rel($self->join_directory(shift), shift || $self->cwd);
383             }
384              
385              
386             #-----------------------------------------------------------------------
387             # file/directory test methods
388             #-----------------------------------------------------------------------
389              
390             sub path_exists {
391 0     0 1 0 shift->stat_path(@_);
392             }
393              
394             sub file_exists {
395 74     74 1 98 my $self = shift;
396 74   100     153 my $stats = $self->stat_path(shift) || return;
397 72 100       429 return -f _ ? $stats : 0; # relies on cached stat
398             }
399              
400             sub directory_exists {
401 38     38 1 70 my $self = shift;
402 38   100     111 my $stats = $self->stat_path(shift) || return;
403 35 100       177 return -d _ ? $stats : 0; # relies on cached stat
404             }
405              
406             sub stat_path {
407 150     150 1 180 my $self = shift;
408 150   100     315 my $path = $self->definitive_read(shift) || return;
409 145         3797 my @stats = (stat($path), -r _, -w _, -x _, -o _, $path);
410              
411             return $self->error_msg( bad_stat => $self->{ path } )
412 145 50       436 unless @stats;
413              
414             return wantarray
415             ? @stats
416 145 50       589 : \@stats;
417             }
418              
419             sub chmod_path {
420 1     1 1 2 my $self = shift;
421 1         3 my $path = $self->definitive_write(shift);
422 1         32 chmod(shift, $path);
423             }
424              
425              
426             #-----------------------------------------------------------------------
427             # file manipulation methods
428             #-----------------------------------------------------------------------
429              
430             sub create_file {
431 2     2 1 6 my ($self, $path) = @_;
432 2 50       6 unless (-e $self->definitive_write($path)) {
433 2         46 $self->write_file($path); # calls definitive_write again
434             }
435 2         16 return 1;
436             }
437              
438             sub touch_file {
439 2     2 1 10 my ($self, $path) = @_;
440 2         6 my $definitive = $self->definitive_write($path);
441 2 100       47 if (-e $definitive) {
442 1         9 my $now = time();
443 1         28 utime $now, $now, $definitive;
444             }
445             else {
446 1         4 $self->write_file($path); # calls definitive_write again
447             }
448             }
449              
450             sub delete_file {
451 13     13 1 44 my $self = shift;
452 13         50 my $path = $self->definitive_write(shift);
453 13 50       1501 unlink($path)
454             || return $self->error_msg( delete_failed => file => $path => $! );
455             }
456              
457             sub open_file {
458 51     51 1 84 my $self = shift;
459 51         69 my $name = shift;
460 51   50     107 my $mode = $_[0] || 'r'; # leave it in @_ for IO::File
461 51 50 33     231 my $opts = @_ && ref $_[-1] eq HASH ? pop(@_) : { };
462 51 100       164 my $path = $mode eq 'r'
463             ? $self->definitive_read($name)
464             : $self->definitive_write($name);
465 51 50 33     320 return $self->error_msg( no_path => $name )
466             unless defined $path && length $path;
467              
468 51         4548 require IO::File;
469 51 50       68396 $self->debug("about to open file $path (", join(', ', @_), ")\n") if $DEBUG;
470              
471 51   33     250 my $fh = IO::File->new($path, @_)
472             || $self->error_msg( open_failed => file => $path => $! );
473              
474             $fh->binmode( $opts->{ encoding } )
475 51 100       10594 if $opts->{ encoding };
476              
477 51         145 return $fh;
478             }
479              
480             sub read_file {
481 29     29 1 66 my $self = shift;
482 29 50 33     161 my $opts = @_ && ref $_[-1] eq HASH ? pop(@_) : { };
483 29         104 my $fh = $self->open_file(shift, 'r', $opts);
484             return wantarray
485             ? <$fh>
486 29 100       309 : do { local $/ = undef; <$fh> };
  25         107  
  25         1109  
487             }
488              
489             sub write_file {
490 15     15 1 30 my $self = shift;
491 15 100 66     84 my $opts = @_ && ref $_[-1] eq HASH ? pop(@_) : { };
492 15         48 my $fh = $self->open_file(shift, 'w', $opts);
493 15 100       85 return $fh unless @_; # return handle if no args
494 11         106 print $fh @_; # or print args and close
495 11         89 $fh->close;
496 11         1056 return 1;
497             }
498              
499             sub append_file {
500 4     4 1 10 my $self = shift;
501 4 50 33     30 my $opts = @_ && ref $_[-1] eq HASH ? pop(@_) : { };
502 4         28 my $fh = $self->open_file(shift, 'a', $opts);
503 4 100       30 return $fh unless @_; # return handle if no args
504 1         23 print $fh @_; # or print args and close
505 1         6 $fh->close;
506 1         39 return 1;
507             }
508              
509              
510             sub copy_file {
511 3     3 1 9 shift->_file_copy( copy => @_ );
512             }
513              
514             sub move_file {
515 1     1 1 3 shift->_file_copy( move => @_ );
516             }
517              
518             sub _file_copy {
519 4     4   540 require File::Copy;
520              
521 4         2709 my ($self, $action, $from, $to, $params)
522             = (shift, shift, shift, shift, params(@_));
523            
524 4 100       11 my $src
    50          
525             = is_object(PATH, $from) ? $from->definitive # path object
526             : ref($from) ? $from # file handle
527             : $self->definitive_read($from); # file path
528              
529 4 50       14 my $dest
    100          
530             = is_object(PATH, $to) ? $to->definitive # as above
531             : ref($to) ? $to
532             : $self->definitive_write($to);
533            
534 4 50       33 my $code
    100          
535             = $action eq 'copy' ? \&File::Copy::copy
536             : $action eq 'move' ? \&File::Copy::move
537             : return $self->error( invalid => action => $action );
538              
539 4         6 my $file;
540              
541 4 50       7 unless (ref $dest) {
542             # NOTE: don't use $self->file($dest) because $self could be a
543             # VFS and $dest is already a definitive path
544 4         9 $file = File($dest);
545             # capture our current working directory
546 4         7 my $cwd = cwd;
547             eval {
548             # Change to the destination volume if one exists.
549             # Should work for any volume except Windows shares
550             # where resulting behavior is version dependent.
551 4 50       12 chdir $file->volume if ($file->volume);
552             # this code strips volume information
553             $file->directory->must_exist(
554             $params->{ mkdir },
555             $params->{ dir_mode },
556 4         11 );
557             # change back to the current working directory
558 4         49 chdir $cwd;
559 4 50       8 } or do {
560             # capture any exception from above
561             # change back to the oringial cwd
562             # and rethrow the execption.
563 0 0       0 if ($@) {
564 0         0 chdir $cwd;
565 0         0 die $@;
566             }
567             }
568             }
569              
570 4 50       16 $code->($src, $dest)
571             || return $self->error_msg( copy_failed => $action, $from, $to, $! );
572              
573 4         18629 my $mode = $params->{ file_mode };
574 4 100       13 $mode = $params->{ mode } unless defined $mode;
575              
576 4 100 66     84 $file->chmod($mode)
577             if $file && defined $mode;
578              
579 4   33     42 return $file || $dest;
580             }
581              
582              
583             #-----------------------------------------------------------------------
584             # directory manipulation methods
585             #-----------------------------------------------------------------------
586              
587             sub create_directory {
588 5     5 1 11 my $self = shift;
589 5         16 my $path = $self->definitive_write(shift);
590              
591 5         28 require File::Path;
592              
593 5 50       20 eval {
594 5         13 local $Carp::CarpLevel = 1;
595 5         1205 File::Path::mkpath($path, 0, @_)
596             } || return $self->error($@);
597             }
598            
599             sub delete_directory {
600 3     3 1 6 my $self = shift;
601 3         8 my $path = $self->definitive_write(shift);
602              
603 3         14 require File::Path;
604 3         825 File::Path::rmtree($path, @_)
605             }
606              
607             sub open_directory {
608 67     67 1 71 my $self = shift;
609 67         119 my $path = $self->definitive_read(shift);
610              
611 67         1320 require IO::Dir;
612 67 50       35523 $self->debug("Opening directory: $path\n") if $DEBUG;
613              
614 67   33     205 return IO::Dir->new($path, @_)
615             || $self->error_msg( open_failed => directory => $path => $! );
616             }
617              
618             sub read_directory {
619 67     67 1 75 my $self = shift;
620 67         109 my $dirh = $self->open_directory(shift);
621 67         4690 my $all = shift;
622 67         119 my ($path, @paths);
623 67         157 while (defined ($path = $dirh->read)) {
624 420         3931 push(@paths, $path);
625             }
626             @paths = $self->spec->no_upwards(@paths)
627 67 50 33     1135 unless $all || ref $self && $self->{ all_entries };
      66        
628              
629 67         225 $dirh->close;
630 67 50       1345 return wantarray ? @paths : \@paths;
631             }
632              
633             sub directory_child {
634 292     292 1 371 my $self = shift;
635 292         520 my $path = $self->join_directory(@_);
636 292         637 stat $self->definitive_read($path);
637 292 50       1550 -d _ ? $self->directory($path) :
    100          
638             -f _ ? $self->file($path) :
639             $self->path($path);
640             }
641            
642             sub directory_children {
643 68     68 1 89 my $self = shift;
644 68         83 my $dir = shift;
645             my @paths = map {
646 68         136 $self->directory_child($dir, $_)
  292         1567  
647             } $self->read_directory($dir, @_);
648 68 50       377 return wantarray ? @paths : \@paths;
649             }
650              
651              
652             #-----------------------------------------------------------------------
653             # temporary directory/file methods
654             #-----------------------------------------------------------------------
655              
656             sub temp_directory {
657 3     3 1 13 my $self = shift;
658 3         181 return $self->directory( FILESPEC->tmpdir, @_ )->must_exist(1);
659             }
660              
661             sub temp_file {
662 1     1 1 2 my $self = shift;
663 1 50       3 return $self->temp_directory->file( @_ ? @_ : random_name() )
664             }
665              
666              
667             #-----------------------------------------------------------------------
668             # visitor methods
669             #-----------------------------------------------------------------------
670              
671             sub visitor {
672 14     14 1 17 my $self = shift;
673 14         37 my $vtype = $self->VISITOR;
674 14         26 class($vtype)->load;
675            
676 14 100 100     44 return @_ && is_object($vtype => $_[0])
677             ? shift
678             : $vtype->new(@_);
679             }
680              
681             sub visit {
682 0     0 1 0 shift->root->visit(@_);
683             }
684              
685             sub collect {
686 0     0 1 0 shift->visit(@_)->collect;
687             }
688              
689             sub accept {
690 0     0 1 0 shift->root->accept(@_);
691             }
692              
693             #-----------------------------------------------------------------------
694             # internal methods
695             #-----------------------------------------------------------------------
696              
697             sub _child_args {
698 546     546   1294 my $self = shift->prototype;
699 546         790 my $type = shift;
700 546         608 my $args = { %{ $self->{ options } } };
  546         1184  
701              
702 546 100 100     1976 if (@_ && ref $_[-1] eq HASH) {
703 79         136 my $more = pop @_;
704 79         228 @$args{ keys %$more } = values %$more;
705             }
706              
707 546 100       1248 if (@_ > 1) {
    100          
708 11         37 $args->{ path } = [@_];
709             }
710             elsif (@_ == 1) {
711 530         1019 $args->{ path } = shift;
712             }
713             else {
714 5         18 $args->{ path } = undef;
715             }
716              
717 546         792 $args->{ filesystem } = $self;
718 546         1599 return $args;
719             }
720              
721              
722              
723             1;
724              
725             __END__