File Coverage

blib/lib/Mojo/File.pm
Criterion Covered Total %
statement 146 146 100.0
branch 50 56 89.2
condition 12 15 80.0
subroutine 50 50 100.0
pod 32 32 100.0
total 290 299 96.9


line stmt bran cond sub pod time code
1             package Mojo::File;
2 79     1217   1092374 use Mojo::Base -strict;
  79         186  
  79         683  
3 79     79   774 use overload '@{}' => sub { shift->to_array }, bool => sub {1}, '""' => sub { ${$_[0]} }, fallback => 1;
  79     2342   236  
  79     2034   1465  
  1710     55   3875  
  126         821  
  5440         55009  
  5440         126188  
4              
5 79     79   9366 use Carp qw(croak);
  79         186  
  79         4920  
6 79     79   583 use Cwd qw(getcwd);
  79         160  
  79         4371  
7 79     79   514 use Exporter qw(import);
  79         254  
  79         2644  
8 79     79   533 use File::Basename ();
  79         190  
  79         2203  
9 79     79   42833 use File::Copy qw(copy move);
  79         202228  
  79         5389  
10 79     79   659 use File::Find qw(find);
  79         192  
  79         6865  
11 79     79   598 use File::Path ();
  79         170  
  79         1825  
12 79     79   34637 use File::Spec::Functions qw(abs2rel canonpath catfile file_name_is_absolute rel2abs splitdir);
  79         65942  
  79         6054  
13 79     79   40112 use File::stat ();
  79         560558  
  79         1898  
14 79     79   62016 use File::Temp ();
  79         862620  
  79         2236  
15 79     79   657 use IO::File ();
  79         202  
  79         1415  
16 79     79   34405 use Mojo::Collection;
  79         236  
  79         201823  
17              
18             our @EXPORT_OK = ('curfile', 'path', 'tempdir', 'tempfile');
19              
20 165     165 1 771 sub basename { File::Basename::basename ${shift()}, @_ }
  165         10924  
21              
22 467     467 1 3130 sub child { $_[0]->new(${shift()}, @_) }
  467         1863  
23              
24             sub chmod {
25 4     4 1 19 my ($self, $mode) = @_;
26 4 100       157 chmod $mode, $$self or croak qq{Can't chmod file "$$self": $!};
27 3         17 return $self;
28             }
29              
30             sub copy_to {
31 2     2 1 13 my ($self, $to) = @_;
32 2 50       10 copy($$self, $to) or croak qq{Can't copy file "$$self" to "$to": $!};
33 2 100       481 return $self->new(-d $to ? ($to, File::Basename::basename $self) : $to);
34             }
35              
36 270     270 1 69162 sub curfile { __PACKAGE__->new(Cwd::realpath((caller)[1])) }
37              
38 91     91 1 772 sub dirname { $_[0]->new(scalar File::Basename::dirname ${$_[0]}) }
  91         3339  
39              
40 92 100   92 1 348 sub extname { shift->basename =~ /.+\.([^.]+)$/ ? $1 : '' }
41              
42 49     49 1 89 sub is_abs { file_name_is_absolute ${shift()} }
  49         329  
43              
44             sub list {
45 31   100 31 1 170 my ($self, $options) = (shift, shift // {});
46              
47 31 100       510 return Mojo::Collection->new unless -d $$self;
48 29 50       1042 opendir(my $dir, $$self) or croak qq{Can't open directory "$$self": $!};
49 29 100       867 my @files = grep { $_ ne '.' && $_ ne '..' } readdir $dir;
  250         834  
50 29 100       136 @files = grep { !/^\./ } @files unless $options->{hidden};
  172         336  
51 29         60 @files = map { catfile $$self, $_ } @files;
  188         719  
52 29 100       123 @files = grep { !-d } @files unless $options->{dir};
  170         2559  
53              
54 29         182 return Mojo::Collection->new(map { $self->new($_) } sort @files);
  157         293  
55             }
56              
57             sub list_tree {
58 223   100 223 1 1354 my ($self, $options) = (shift, shift // {});
59              
60             # This may break in the future, but is worth it for performance
61 223 100       1938 local $File::Find::skip_pattern = qr/^\./ unless $options->{hidden};
62              
63             # The File::Find documentation lies, this is needed for CIFS
64 223 50       835 local $File::Find::dont_use_nlink = 1 if $options->{dont_use_nlink};
65              
66 223         436 my %all;
67             my $wanted = sub {
68 2668 100   2668   9243 if ($options->{max_depth}) {
69 62         180 (my $rel = $File::Find::name) =~ s!^\Q$$self\E/?!!;
70 62 100       193 $File::Find::prune = 1 if splitdir($rel) >= $options->{max_depth};
71             }
72 2668 100 100     133571 $all{$File::Find::name}++ if $options->{dir} || !-d $File::Find::name;
73 223         1319 };
74 223 100       21497 find {wanted => $wanted, no_chdir => 1}, $$self if -d $$self;
75 223         1415 delete $all{$$self};
76              
77 223         2037 return Mojo::Collection->new(map { $self->new(canonpath $_) } sort keys %all);
  1977         5891  
78             }
79              
80 1     1 1 819 sub lstat { File::stat::lstat(${shift()}) }
  1         12  
81              
82             sub make_path {
83 23     23 1 43 my $self = shift;
84 23         2048 File::Path::make_path $$self, @_;
85 23         124 return $self;
86             }
87              
88             sub move_to {
89 7     7 1 46 my ($self, $to) = @_;
90 7 50       55 move($$self, $to) or croak qq{Can't move file "$$self" to "$to": $!};
91 7 100       646 return $self->new(-d $to ? ($to, File::Basename::basename $self) : $to);
92             }
93              
94             sub new {
95 10145     10145 1 105615 my $class = shift;
96 10145 100       17208 croak 'Invalid path' if grep { !defined } @_;
  16372         42283  
97 10143 100       42053 my $value = @_ == 1 ? $_[0] : @_ > 1 ? catfile @_ : canonpath getcwd;
    100          
98 10143   66     53005 return bless \$value, ref $class || $class;
99             }
100              
101             sub open {
102 127     127 1 1798 my $self = shift;
103 127         912 my $handle = IO::File->new;
104 127 100       5466 $handle->open($$self, @_) or croak qq{Can't open file "$$self": $!};
105 126         12622 return $handle;
106             }
107              
108 3385     3385 1 66039 sub path { __PACKAGE__->new(@_) }
  55         2568  
109              
110 801     801 1 5700 sub realpath { $_[0]->new(Cwd::realpath ${$_[0]}) }
  801         65800  
111              
112             sub remove {
113 52     52 1 142 my ($self, $mode) = @_;
114 52 100 66     3676 unlink $$self or croak qq{Can't remove file "$$self": $!} if -e $$self;
115 51         851 return $self;
116             }
117              
118             sub remove_tree {
119 2     2 1 6 my $self = shift;
120 2         1000 File::Path::remove_tree $$self, @_;
121 2         59 return $self;
122             }
123              
124             sub sibling {
125 266     266 1 760 my $self = shift;
126 266         8110 return $self->new(scalar File::Basename::dirname($self), @_);
127             }
128              
129             sub slurp {
130 108     108 1 798 my $self = shift;
131              
132 108 100       4037 CORE::open my $file, '<', $$self or croak qq{Can't open file "$$self": $!};
133 107         682 my $ret = my $content = '';
134 107         906 while ($ret = $file->sysread(my $buffer, 131072, 0)) { $content .= $buffer }
  107         3784  
135 107 50       1787 croak qq{Can't read from file "$$self": $!} unless defined $ret;
136              
137 107         1996 return $content;
138             }
139              
140             sub spurt {
141 43     43 1 401 my ($self, $content) = (shift, join '', @_);
142 43 100       1948 CORE::open my $file, '>', $$self or croak qq{Can't open file "$$self": $!};
143 42 100 50     657 ($file->syswrite($content) // -1) == length $content or croak qq{Can't write to file "$$self": $!};
144 41         2644 return $self;
145             }
146              
147 4     4 1 28 sub stat { File::stat::stat(${shift()}) }
  4         25  
148              
149 1     1 1 12 sub tap { shift->Mojo::Base::tap(@_) }
150              
151 34     34 1 61192 sub tempdir { __PACKAGE__->new(File::Temp->newdir(@_)) }
152              
153 53     53 1 4655 sub tempfile { __PACKAGE__->new(File::Temp->new(@_)) }
154              
155 136     136 1 416 sub to_abs { $_[0]->new(rel2abs ${$_[0]}) }
  136         717  
156              
157 2119     2119 1 3125 sub to_array { [splitdir ${shift()}] }
  2119         5687  
158              
159 1997     1997 1 3304 sub to_rel { $_[0]->new(abs2rel(${$_[0]}, $_[1])) }
  1997         6155  
160              
161 3091     3091 1 4870 sub to_string {"${$_[0]}"}
  3091         32861  
162              
163             sub touch {
164 4     4 1 838 my $self = shift;
165 4 100       82 $self->open('>') unless -e $$self;
166 4 50       119 utime undef, undef, $$self or croak qq{Can't touch file "$$self": $!};
167 4         34 return $self;
168             }
169              
170 1     1 1 532 sub with_roles { shift->Mojo::Base::with_roles(@_) }
171              
172             1;
173              
174             =encoding utf8
175              
176             =head1 NAME
177              
178             Mojo::File - File system paths
179              
180             =head1 SYNOPSIS
181              
182             use Mojo::File;
183              
184             # Portably deal with file system paths
185             my $path = Mojo::File->new('/home/sri/.vimrc');
186             say $path->slurp;
187             say $path->dirname;
188             say $path->basename;
189             say $path->extname;
190             say $path->sibling('.bashrc');
191              
192             # Use the alternative constructor
193             use Mojo::File qw(path);
194             my $path = path('/tmp/foo/bar')->make_path;
195             $path->child('test.txt')->spurt('Hello Mojo!');
196              
197             =head1 DESCRIPTION
198              
199             L is a scalar-based container for file system paths that provides a friendly API for dealing with different
200             operating systems.
201              
202             # Access scalar directly to manipulate path
203             my $path = Mojo::File->new('/home/sri/test');
204             $$path .= '.txt';
205              
206             =head1 FUNCTIONS
207              
208             L implements the following functions, which can be imported individually.
209              
210             =head2 curfile
211              
212             my $path = curfile;
213              
214             Construct a new scalar-based L object for the absolute path to the current source file.
215              
216             =head2 path
217              
218             my $path = path;
219             my $path = path('/home/sri/.vimrc');
220             my $path = path('/home', 'sri', '.vimrc');
221             my $path = path(File::Temp->newdir);
222              
223             Construct a new scalar-based L object, defaults to using the current working directory.
224              
225             # "foo/bar/baz.txt" (on UNIX)
226             path('foo', 'bar', 'baz.txt');
227              
228             =head2 tempdir
229              
230             my $path = tempdir;
231             my $path = tempdir('tempXXXXX');
232              
233             Construct a new scalar-based L object for a temporary directory with L.
234              
235             # Longer version
236             my $path = path(File::Temp->newdir('tempXXXXX'));
237              
238             =head2 tempfile
239              
240             my $path = tempfile;
241             my $path = tempfile(DIR => '/tmp');
242              
243             Construct a new scalar-based L object for a temporary file with L.
244              
245             # Longer version
246             my $path = path(File::Temp->new(DIR => '/tmp'));
247              
248             =head1 METHODS
249              
250             L implements the following methods.
251              
252             =head2 basename
253              
254             my $name = $path->basename;
255             my $name = $path->basename('.txt');
256              
257             Return the last level of the path with L.
258              
259             # ".vimrc" (on UNIX)
260             path('/home/sri/.vimrc')->basename;
261              
262             # "test" (on UNIX)
263             path('/home/sri/test.txt')->basename('.txt');
264              
265             =head2 child
266              
267             my $child = $path->child('.vimrc');
268              
269             Return a new L object relative to the path.
270              
271             # "/home/sri/.vimrc" (on UNIX)
272             path('/home')->child('sri', '.vimrc');
273              
274             =head2 chmod
275              
276             $path = $path->chmod(0644);
277              
278             Change file permissions.
279              
280             =head2 copy_to
281              
282             my $destination = $path->copy_to('/home/sri');
283             my $destination = $path->copy_to('/home/sri/.vimrc.backup');
284              
285             Copy file with L and return the destination as a L object.
286              
287             =head2 dirname
288              
289             my $name = $path->dirname;
290              
291             Return all but the last level of the path with L as a L object.
292              
293             # "/home/sri" (on UNIX)
294             path('/home/sri/.vimrc')->dirname;
295              
296             =head2 extname
297              
298             my $ext = $path->extname;
299              
300             Return file extension of the path.
301              
302             # "js"
303             path('/home/sri/test.js')->extname;
304              
305             =head2 is_abs
306              
307             my $bool = $path->is_abs;
308              
309             Check if the path is absolute.
310              
311             # True (on UNIX)
312             path('/home/sri/.vimrc')->is_abs;
313              
314             # False (on UNIX)
315             path('.vimrc')->is_abs;
316              
317             =head2 list
318              
319             my $collection = $path->list;
320             my $collection = $path->list({hidden => 1});
321              
322             List all files in the directory and return a L object containing the results as L
323             objects. The list does not include C<.> and C<..>.
324              
325             # List files
326             say for path('/home/sri/myapp')->list->each;
327              
328             These options are currently available:
329              
330             =over 2
331              
332             =item dir
333              
334             dir => 1
335              
336             Include directories.
337              
338             =item hidden
339              
340             hidden => 1
341              
342             Include hidden files.
343              
344             =back
345              
346             =head2 list_tree
347              
348             my $collection = $path->list_tree;
349             my $collection = $path->list_tree({hidden => 1});
350              
351             List all files recursively in the directory and return a L object containing the results as
352             L objects. The list does not include C<.> and C<..>.
353              
354             # List all templates
355             say for path('/home/sri/myapp/templates')->list_tree->each;
356              
357             These options are currently available:
358              
359             =over 2
360              
361             =item dir
362              
363             dir => 1
364              
365             Include directories.
366              
367             =item dont_use_nlink
368              
369             dont_use_nlink => 1
370              
371             Force L to always stat directories.
372              
373             =item hidden
374              
375             hidden => 1
376              
377             Include hidden files and directories.
378              
379             =item max_depth
380              
381             max_depth => 3
382              
383             Maximum number of levels to descend when searching for files.
384              
385             =back
386              
387             =head2 lstat
388              
389             my $stat = $path->lstat;
390              
391             Return a L object for the symlink.
392              
393             # Get symlink size
394             say path('/usr/sbin/sendmail')->lstat->size;
395              
396             # Get symlink modification time
397             say path('/usr/sbin/sendmail')->lstat->mtime;
398              
399             =head2 make_path
400              
401             $path = $path->make_path;
402             $path = $path->make_path({mode => 0711});
403              
404             Create the directories if they don't already exist, any additional arguments are passed through to L.
405              
406             =head2 move_to
407              
408             my $destination = $path->move_to('/home/sri');
409             my $destination = $path->move_to('/home/sri/.vimrc.backup');
410              
411             Move file with L and return the destination as a L object.
412              
413             =head2 new
414              
415             my $path = Mojo::File->new;
416             my $path = Mojo::File->new('/home/sri/.vimrc');
417             my $path = Mojo::File->new('/home', 'sri', '.vimrc');
418             my $path = Mojo::File->new(File::Temp->new);
419             my $path = Mojo::File->new(File::Temp->newdir);
420              
421             Construct a new L object, defaults to using the current working directory.
422              
423             # "foo/bar/baz.txt" (on UNIX)
424             Mojo::File->new('foo', 'bar', 'baz.txt');
425              
426             =head2 open
427              
428             my $handle = $path->open('+<');
429             my $handle = $path->open('r+');
430             my $handle = $path->open(O_RDWR);
431             my $handle = $path->open('<:encoding(UTF-8)');
432              
433             Open file with L.
434              
435             # Combine "fcntl.h" constants
436             use Fcntl qw(O_CREAT O_EXCL O_RDWR);
437             my $handle = path('/home/sri/test.pl')->open(O_RDWR | O_CREAT | O_EXCL);
438              
439             =head2 realpath
440              
441             my $realpath = $path->realpath;
442              
443             Resolve the path with L and return the result as a L object.
444              
445             =head2 remove
446              
447             $path = $path->remove;
448              
449             Delete file.
450              
451             =head2 remove_tree
452              
453             $path = $path->remove_tree;
454             $path = $path->remove_tree({keep_root => 1});
455              
456             Delete this directory and any files and subdirectories it may contain, any additional arguments are passed through to
457             L.
458              
459             =head2 sibling
460              
461             my $sibling = $path->sibling('.vimrc');
462              
463             Return a new L object relative to the directory part of the path.
464              
465             # "/home/sri/.vimrc" (on UNIX)
466             path('/home/sri/.bashrc')->sibling('.vimrc');
467              
468             # "/home/sri/.ssh/known_hosts" (on UNIX)
469             path('/home/sri/.bashrc')->sibling('.ssh', 'known_hosts');
470              
471             =head2 slurp
472              
473             my $bytes = $path->slurp;
474              
475             Read all data at once from the file.
476              
477             =head2 spurt
478              
479             $path = $path->spurt($bytes);
480             $path = $path->spurt(@chunks_of_bytes);
481              
482             Write all data at once to the file.
483              
484             =head2 stat
485              
486             my $stat = $path->stat;
487              
488             Return a L object for the path.
489              
490             # Get file size
491             say path('/home/sri/.bashrc')->stat->size;
492              
493             # Get file modification time
494             say path('/home/sri/.bashrc')->stat->mtime;
495              
496             =head2 tap
497              
498             $path = $path->tap(sub {...});
499              
500             Alias for L.
501              
502             =head2 to_abs
503              
504             my $absolute = $path->to_abs;
505              
506             Return absolute path as a L object, the path does not need to exist on the file system.
507              
508             =head2 to_array
509              
510             my $parts = $path->to_array;
511              
512             Split the path on directory separators.
513              
514             # "home:sri:.vimrc" (on UNIX)
515             join ':', @{path('/home/sri/.vimrc')->to_array};
516              
517             =head2 to_rel
518              
519             my $relative = $path->to_rel('/some/base/path');
520              
521             Return a relative path from the original path to the destination path as a L object.
522              
523             # "sri/.vimrc" (on UNIX)
524             path('/home/sri/.vimrc')->to_rel('/home');
525              
526             =head2 to_string
527              
528             my $str = $path->to_string;
529              
530             Stringify the path.
531              
532             =head2 touch
533              
534             $path = $path->touch;
535              
536             Create file if it does not exist or change the modification and access time to the current time.
537              
538             # Safely read file
539             say path('.bashrc')->touch->slurp;
540              
541             =head2 with_roles
542              
543             my $new_class = Mojo::File->with_roles('Mojo::File::Role::One');
544             my $new_class = Mojo::File->with_roles('+One', '+Two');
545             $path = $path->with_roles('+One', '+Two');
546              
547             Alias for L.
548              
549             =head1 OPERATORS
550              
551             L overloads the following operators.
552              
553             =head2 array
554              
555             my @parts = @$path;
556              
557             Alias for L.
558              
559             =head2 bool
560              
561             my $bool = !!$path;
562              
563             Always true.
564              
565             =head2 stringify
566              
567             my $str = "$path";
568              
569             Alias for L.
570              
571             =head1 SEE ALSO
572              
573             L, L, L.
574              
575             =cut