File Coverage

blib/lib/Net/FTP/Rule.pm
Criterion Covered Total %
statement 52 55 94.5
branch 6 12 50.0
condition n/a
subroutine 14 16 87.5
pod 1 1 100.0
total 73 84 86.9


line stmt bran cond sub pod time code
1             package Net::FTP::Rule;
2              
3             # ABSTRACT: Iterative, recursive, FTP file finder
4              
5 1     1   216737 use 5.010;
  1         3  
6              
7 1     1   5 use strict;
  1         2  
  1         14  
8 1     1   4 use warnings;
  1         2  
  1         30  
9 1     1   8 use Carp;
  1         2  
  1         66  
10              
11             our $VERSION = '0.01'; # TRIAL
12              
13 1     1   487 use Net::FTP;
  1         92530  
  1         78  
14 1     1   529 use File::Spec::Functions qw[ splitpath ];
  1         825  
  1         61  
15              
16 1     1   470 use parent 'Path::Iterator::Rule';
  1         222  
  1         5  
17              
18 1     1   13409 use Net::FTP::Rule::Dir;
  1         4  
  1         30  
19              
20 1     1   5 use namespace::clean;
  1         2  
  1         4  
21              
22             #pod =method new
23             #pod
24             #pod $ftp = Net::FTP::Rule->new( [$host], %options );
25             #pod
26             #pod Open up a connection to an FTP host and log in. The arguments
27             #pod are the same as for L, with the addition of two
28             #pod mandatory options,
29             #pod
30             #pod =over
31             #pod
32             #pod =item C
33             #pod
34             #pod The user name
35             #pod
36             #pod =item C
37             #pod
38             #pod The password
39             #pod
40             #pod =back
41             #pod
42             #pod =cut
43              
44              
45             sub new {
46              
47 1     1 1 1984 my $class = shift;
48              
49 1         3 my %attr;
50 1 50       4 if (@_ % 2) {
51 1         3 my $host = shift;
52 1         5 %attr = @_;
53 1         3 $attr{Host} = $host;
54             }
55             else {
56 0         0 %attr = @_;
57             }
58              
59 1         15 my $self = $class->SUPER::new();
60              
61             defined( my $host = delete $attr{Host} )
62 1 50       14 or croak( "missing Host attribute\n" );
63              
64             defined( my $user = delete $attr{user} )
65 1 50       7 or croak( "missing user attribute\n" );
66              
67             defined( my $password = delete $attr{password} )
68 1 50       6 or croak( "missing password attribute\n" );
69              
70 1 50       6 $self->{server} = Net::FTP->new($host, %attr)
71             or croak("unable to connect to server $host\n");
72              
73 1 50       55 $self->{server}->login( $user, $password )
74             or croak("unable to log in to $host\n");
75              
76 1         83 return $self;
77             }
78              
79             sub _defaults {
80             return (
81             _stringify => 0,
82             follow_symlinks => 1,
83             depthfirst => 0,
84             sorted => 1,
85             loop_safe => 0,
86 0     0   0 error_handler => sub { die sprintf( "%s: %s", @_ ) },
87 1     1   764 visitor => undef,
88             );
89             }
90              
91             sub _fast_defaults {
92              
93             return (
94 0     0   0 _stringify => 0,
95             follow_symlinks => 1,
96             depthfirst => -1,
97             sorted => 0,
98             loop_safe => 0,
99             error_handler => undef,
100             visitor => undef,
101             );
102             }
103              
104             sub _objectify {
105              
106 1     1   47 my ( $self, $path ) = @_;
107              
108 1         6 my ( $volume, $directories, $name ) = splitpath($path);
109              
110 1         17 $directories =~ s{(.+)/$}{$1};
111              
112 1         5 my %attr = (
113             parent => $directories,
114             name => $name,
115             path => $path,
116             );
117              
118 1         18 return Net::FTP::Rule::Dir->new( server => $self->{server}, %attr );
119             }
120              
121             sub _children {
122              
123 5     5   109 my ( $self, $path ) = @_;
124              
125 5         24 return map { [ $_->{name}, $_ ] } $path->_children;
  13         104  
126             }
127              
128             sub _iter {
129              
130 1     1   6 my $self = shift;
131 1         2 my $defaults = shift;
132              
133 1         3 $defaults->{loop_safe} = 0;
134              
135 1         7 $self->SUPER::_iter( $defaults, @_ );
136              
137             }
138              
139             1;
140              
141             #
142             # This file is part of Net-FTP-Rule
143             #
144             # This software is Copyright (c) 2017 by Smithsonian Astrophysical Observatory.
145             #
146             # This is free software, licensed under:
147             #
148             # The GNU General Public License, Version 3, June 2007
149             #
150              
151             =pod
152              
153             =head1 NAME
154              
155             Net::FTP::Rule - Iterative, recursive, FTP file finder
156              
157             =head1 VERSION
158              
159             version 0.01
160              
161             =head1 SYNOPSIS
162              
163             use Net::FTP::Rule;
164              
165             # connect to the FTP site
166             my $ftp = Net::FTP::Rule->new( $ftp_site, $user, $password );
167              
168             # define a visitor callback routine. It will recieve a
169             # Net::FTP::Rule::Entry object.
170             sub visitor { my ($entry) = @_ }
171              
172             # use the Path::Iterator::Rule all() method to traverse the
173             # site;
174             $ftp->all( '/', \&visitor );
175              
176             =head1 DESCRIPTION
177              
178             B is a subclass of L which
179             iterates over an FTP site rather than a local filesystem.
180              
181             See the documentation L for how to filter and
182             traverse paths. When B passes a path to a callback or
183             returns one from an iterator, it will be in the form of a
184             L object.
185              
186             B uses L to connect to the FTP site.
187              
188             =head2 Symbolic Links
189              
190             At present, B does not handle symbolic links. It will
191             output an error and skip them.
192              
193             =head1 METHODS
194              
195             =head2 new
196              
197             $ftp = Net::FTP::Rule->new( [$host], %options );
198              
199             Open up a connection to an FTP host and log in. The arguments
200             are the same as for L, with the addition of two
201             mandatory options,
202              
203             =over
204              
205             =item C
206              
207             The user name
208              
209             =item C
210              
211             The password
212              
213             =back
214              
215             =head1 ATTRIBUTES
216              
217             B subclasses L. It is a hash based object
218             and has the following additional attributes:
219              
220             =over
221              
222             =item C
223              
224             The B object representing the connection to the FTP server.
225              
226             =back
227              
228             =head1 BUGS AND LIMITATIONS
229              
230             You can make new bug reports, and view existing ones, through the
231             web interface at L.
232              
233             =head1 AUTHOR
234              
235             Diab Jerius
236              
237             =head1 COPYRIGHT AND LICENSE
238              
239             This software is Copyright (c) 2017 by Smithsonian Astrophysical Observatory.
240              
241             This is free software, licensed under:
242              
243             The GNU General Public License, Version 3, June 2007
244              
245             =cut
246              
247             __END__