| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package App::Followme::UploadFtp; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 1 |  |  | 1 |  | 671 | use 5.008005; | 
|  | 1 |  |  |  |  | 4 |  | 
| 4 | 1 |  |  | 1 |  | 7 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 21 |  | 
| 5 | 1 |  |  | 1 |  | 5 | use warnings; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 29 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 | 1 |  |  | 1 |  | 465 | use lib '../..'; | 
|  | 1 |  |  |  |  | 684 |  | 
|  | 1 |  |  |  |  | 5 |  | 
| 8 |  |  |  |  |  |  |  | 
| 9 | 1 |  |  | 1 |  | 137 | use base qw(App::Followme::ConfiguredObject); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 445 |  | 
| 10 | 1 |  |  | 1 |  | 7 | use Net::FTP; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 47 |  | 
| 11 | 1 |  |  | 1 |  | 6 | use File::Spec::Functions qw(abs2rel splitdir catfile); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 1024 |  | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | our $VERSION = "2.01"; | 
| 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 |