File Coverage

blib/lib/Net/FTP/Path/Iter/Entry.pm
Criterion Covered Total %
statement 54 59 91.5
branch 16 26 61.5
condition 1 3 33.3
subroutine 14 14 100.0
pod 1 1 100.0
total 86 103 83.5


line stmt bran cond sub pod time code
1             package Net::FTP::Path::Iter::Entry;
2              
3 5     5   241507 use 5.010;
  5         18  
4              
5             # ABSTRACT: Class representing a Filesystem Entry
6              
7 5     5   32 use strict;
  5         10  
  5         140  
8 5     5   69 use warnings;
  5         8  
  5         472  
9              
10             our $VERSION = '0.07';
11              
12 5     5   198 use Carp;
  5         13  
  5         455  
13 5     5   30 use Fcntl qw[ :mode ];
  5         8  
  5         1419  
14              
15 5     5   3334 use File::Listing qw[ parse_dir ];
  5         44612  
  5         382  
16              
17 5     5   654 use namespace::clean;
  5         16841  
  5         38  
18              
19             use overload
20             '-X' => '_statit',
21 14     14   836 'bool' => sub { 1 },
22 14     14   396 '""' => sub { $_[0]->{path} },
23 5         114 fallback => !!1,
24 5     5   3812 ;
  5         11  
25              
26 5         56 use Class::Tiny qw[
27             name type size mtime mode parent server path
28 5     5   3609 ], { _has_attrs => 0 };
  5         16801  
29              
30              
31              
32              
33              
34              
35              
36              
37              
38              
39             sub BUILD {
40              
41 14     14 1 1790 my $self = shift;
42 14 100       420 $self->_retrieve_attrs
43             unless $self->_has_attrs;
44             }
45              
46             sub _statit {
47              
48 33     33   260 my $self = shift;
49 33         72 my $op = shift;
50              
51 33 50       857 $self->_retrieve_attrs
52             unless $self->_has_attrs;
53              
54             ## no critic ( ControlStructures::ProhibitCascadingIfElse )
55 33 100       317 if ( $op eq 'd' ) { return $self->is_dir }
  14 50       58  
    50          
    50          
    100          
    50          
    50          
56              
57 0         0 elsif ( $op eq 'f' ) { return $self->is_file }
58              
59 0         0 elsif ( $op eq 's' ) { return $self->size }
60              
61 0         0 elsif ( $op eq 'z' ) { return $self->size != 0 }
62              
63 5         126 elsif ( $op eq 'r' ) { return S_IROTH & $self->mode }
64              
65 0         0 elsif ( $op eq 'R' ) { return S_IROTH & $self->mode }
66              
67 14         42 elsif ( $op eq 'l' ) { return 0 }
68              
69 0         0 else { croak( "unsupported file test: -$op" ) }
70              
71             }
72              
73             sub _get_entries {
74              
75 5     5   39 my ( $self, $path ) = @_;
76              
77 5         87 my $server = $self->server;
78              
79 5         47 my $pwd = $server->pwd;
80              
81             # on some ftp servers, if $path is a symbolic link, dir($path)
82             # willl return a listing of $path's own entry, not of its
83             # contents. as a work around, explicitly cwd($path),
84             # get the listing, then restore the working directory
85              
86 5         620 my @entries;
87             my $err;
88 5   33     12 eval {
89 5 50       36 $server->cwd( $path )
90             or croak( 'unable to chdir to ', $path );
91              
92 5 50       932 my $listing = $server->dir( q{.} )
93             or croak( "error listing $path" );
94              
95 5         56033 for my $entry ( parse_dir( $listing ) ) {
96              
97 13         5118 my %attr;
98 13         159 @attr{qw[ name type size mtime mode]} = @$entry;
99 13         41 $attr{parent} = $path;
100 13         42 $attr{_has_attrs} = 1;
101              
102 13         73 push @entries, \%attr;
103              
104             }
105 5         38 1;
106             } // ( $err = $@ );
107              
108 5 50       122 $server->cwd( $pwd )
109             or croak( "unable to return to directory: $pwd" );
110              
111 5 50       1707 croak( $err ) if defined $err;
112              
113 5         66 return \@entries;
114             }
115              
116             #
117             # This file is part of Net-FTP-Path-Iter
118             #
119             # This software is Copyright (c) 2017 by Smithsonian Astrophysical Observatory.
120             #
121             # This is free software, licensed under:
122             #
123             # The GNU General Public License, Version 3, June 2007
124             #
125              
126             1;
127              
128             __END__