File Coverage

lib/App/Followme/UploadFtp.pm
Criterion Covered Total %
statement 20 75 26.6
branch 0 28 0.0
condition n/a
subroutine 7 15 46.6
pod 6 8 75.0
total 33 126 26.1


line stmt bran cond sub pod time code
1             package App::Followme::UploadFtp;
2              
3 1     1   697 use 5.008005;
  1         5  
4 1     1   21 use strict;
  1         2  
  1         26  
5 1     1   6 use warnings;
  1         2  
  1         29  
6              
7 1     1   482 use lib '../..';
  1         684  
  1         6  
8              
9 1     1   139 use base qw(App::Followme::ConfiguredObject);
  1         2  
  1         459  
10 1     1   8 use Net::FTP;
  1         2  
  1         65  
11 1     1   7 use File::Spec::Functions qw(abs2rel splitdir catfile);
  1         2  
  1         770  
12              
13             our $VERSION = "2.02";
14              
15             #----------------------------------------------------------------------
16             # Read the default parameter values
17              
18             sub parameters {
19 0     0 1   my ($pkg) = @_;
20              
21             return (
22 0           ftp_url => '',
23             remote_directory => '',
24             ftp_debug => 0,
25             remote_pkg => 'File::Spec::Unix',
26             );
27             }
28              
29             #----------------------------------------------------------------------
30             # Add a directory to the remote site
31              
32             sub add_directory {
33 0     0 1   my ($self, $dir) = @_;
34              
35 0           my $status;
36 0           $dir = $self->remote_name($dir);
37              
38 0 0         if ($self->{ftp}->ls($dir)) {
    0          
39 0           $status = 1;
40             } elsif ($self->{ftp}->mkdir($dir)) {
41 0           $status = 1;
42             }
43              
44 0           return $status;
45             }
46              
47             #----------------------------------------------------------------------
48             # Add a file to the remote site
49              
50             sub add_file {
51 0     0 1   my ($self, $local_filename, $remote_filename) = @_;
52              
53 0           my $status;
54 0           $remote_filename = $self->remote_name($remote_filename);
55              
56             # Delete file if already there
57 0 0         if ($self->{ftp}->mdtm($remote_filename)) {
58 0           $self->{ftp}->delete($remote_filename);
59             }
60              
61             # Change upload mode if necessary
62 0 0         if (-B $local_filename) {
    0          
63 0 0         if ($self->{ascii}) {
64 0           $self->{ftp}->binary();
65 0           $self->{ascii} = 0;
66             }
67              
68             } elsif (! $self->{ascii}) {
69 0           $self->{ftp}->ascii();
70 0           $self->{ascii} = 1;
71             }
72              
73             # Upload the file
74 0 0         if ($self->{ftp}->put($local_filename, $remote_filename)) {
75 0           $status = 1;
76             }
77              
78 0           return $status;
79             }
80              
81             #----------------------------------------------------------------------
82             # Close the ftp connection
83              
84             sub close {
85 0     0 1   my ($self) = @_;
86              
87 0           $self->{ftp}->quit();
88 0           undef $self->{ftp};
89              
90 0           return;
91             }
92              
93             #----------------------------------------------------------------------
94             # Delete a directory on the remote site, including contents
95              
96             sub delete_directory {
97 0     0 1   my ($self, $dir) = @_;
98              
99 0           my $status;
100 0           $dir = $self->remote_name($dir);
101              
102 0 0         if ($self->{ftp}->ls($dir)) {
103 0 0         if ($self->{ftp}->rmdir($dir)) {
104 0           $status = 1;
105             }
106              
107             } else {
108 0           $status = 1;
109             }
110              
111 0           return $status;
112             }
113              
114             #----------------------------------------------------------------------
115             # Delete a file on the remote site
116              
117             sub delete_file {
118 0     0 1   my ($self, $filename) = @_;
119              
120 0           my $status;
121 0           $filename = $self->remote_name($filename);
122              
123 0 0         if ($self->{ftp}->mdtm($filename)) {
124 0 0         if ($self->{ftp}->delete($filename)) {
125 0           $status = 1;
126             }
127              
128             } else {
129 0           $status = 1;
130             }
131              
132 0           return 1;
133             }
134              
135             #----------------------------------------------------------------------
136             # Open the connection to the remote site
137              
138             sub open {
139 0     0 0   my ($self, $user, $password) = @_;
140              
141             # Open the ftp connection
142              
143             my $ftp = Net::FTP->new($self->{ftp_url}, Debug => $self->{ftp_debug})
144 0 0         or die "Cannot connect to $self->{ftp_url}: $@";
145              
146 0 0         $ftp->login($user, $password) or die "Cannot login ", $ftp->message;
147              
148             $ftp->cwd($self->{remote_directory})
149 0 0         or die "Cannot change remote directory ", $ftp->message;
150              
151 0           $ftp->binary();
152              
153 0           $self->{ftp} = $ftp;
154 0           $self->{ascii} = 0;
155              
156 0           return;
157             }
158              
159             #----------------------------------------------------------------------
160             # Get the name of the file on the remote system
161              
162             sub remote_name {
163 0     0 0   my ($self, $remote_filename) = @_;
164              
165 0           my @path = splitdir($remote_filename);
166 0           $remote_filename = $self->{remote}->catfile(@path);
167 0           return $remote_filename;
168             }
169              
170             1;
171             __END__
172             =encoding utf-8
173              
174             =head1 NAME
175              
176             App::Followme::UploadFtp - Upload files using ftp
177              
178             =head1 SYNOPSIS
179              
180             my $ftp = App::Followme::UploadNone->new(\%configuration);
181             $ftp->open($user, $password);
182             $ftp->add_directory($dir);
183             $ftp->add_file($local_filename, $remote_filename);
184             $ftp->delete_file($filename);
185             $ftp->delete_dir($dir);
186             $ftp->close();
187              
188             =head1 DESCRIPTION
189              
190             L<App::Followme::UploadSite> splits off methods that do the actual uploading
191             into a separate package, so it can support more than one method. This package
192             uploads files using good old ftp.
193              
194             =head1 METHODS
195              
196             The following are the public methods of the interface
197              
198             =over 4
199              
200             =item $flag = $self->add_directory($dir);
201              
202             Create a new directory.
203              
204             =item $flag = $self->add_file($local_filename, $remote_filename);
205              
206             Upload a file.
207              
208             =item $flag = $self->delete_directory($dir);
209              
210             Delete a directory, including its contents
211              
212             =item $flag = $self->delete_file($filename);
213              
214             Delete a file on the remote site. .
215              
216             =item $self->close();
217              
218             Close the ftp connection to the remote site.
219              
220             =back
221              
222             =head1 CONFIGURATION
223              
224             The follow parameters are used from the configuration. In addition, the package
225             will prompt for and save the user name and password.
226              
227             =over 4
228              
229             =item ftp_debug
230              
231             Set to one to trace the ftp commands issued. Useful to diagnose problems
232             with ftp uploads. The default value is zero.
233              
234             =item remote_directory
235              
236             The top directory of the remote site
237              
238             =item ftp_url
239              
240             The url of the remote ftp site.
241              
242             =item remote_pkg
243              
244             The name of the package that manipulates filenames for the remote system. The
245             default value is 'File::Spec::Unix'. Other possible values are
246             'File::Spec::Win32' and 'File::Spec::VMS'. Consult the Perl documentation for
247             more information.
248              
249             =back
250              
251             =head1 LICENSE
252              
253             Copyright (C) Bernie Simon.
254              
255             This library is free software; you can redistribute it and/or modify
256             it under the same terms as Perl itself.
257              
258             =head1 AUTHOR
259              
260             Bernie Simon E<lt>bernie.simon@gmail.comE<gt>
261              
262             =cut