File Coverage

blib/lib/Metabrik/Network/Ftp.pm
Criterion Covered Total %
statement 9 82 10.9
branch 0 36 0.0
condition 0 8 0.0
subroutine 3 15 20.0
pod 1 12 8.3
total 13 153 8.5


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # network::ftp Brik
5             #
6             package Metabrik::Network::Ftp;
7 1     1   890 use strict;
  1         2  
  1         29  
8 1     1   5 use warnings;
  1         2  
  1         28  
9              
10 1     1   5 use base qw(Metabrik);
  1         2  
  1         1000  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             hostname => [ qw(hostname) ],
20             port => [ qw(port) ],
21             username => [ qw(username) ],
22             password => [ qw(password) ],
23             recurse => [ qw(0|1) ],
24             _ftp => [ qw(INTERNAL) ],
25             },
26             attributes_default => {
27             port => 21,
28             username => 'anonymous',
29             password => 'nop@metabrik.org',
30             recurse => 0,
31             },
32             commands => {
33             open => [ ],
34             cwd => [ qw(directory|OPTIONAL) ],
35             pwd => [ ],
36             ls => [ qw(directory|OPTIONAL) ],
37             dir => [ qw(directory|OPTIONAL) ],
38             binary => [ ],
39             ascii => [ ],
40             rmdir => [ qw(directory) ],
41             mkdir => [ qw(directory) ],
42             get => [ qw(remote_file local_file) ],
43             close => [ ],
44             },
45             require_modules => {
46             'Net::FTP' => [ ],
47             },
48             };
49             }
50              
51             sub open {
52 0     0 0   my $self = shift;
53              
54 0           my $hostname = $self->hostname;
55 0 0         $self->brik_help_run_undef_arg('open', $hostname) or return;
56              
57 0           my $port = $self->port;
58 0           my $username = $self->username;
59 0           my $password = $self->password;
60              
61 0 0         my $ftp = Net::FTP->new(
    0          
62             $hostname,
63             Port => $port,
64             Debug => $self->log->level > 2 ? 1 : 0,
65             ) or return $self->log->error("open: Net::FTP failed with [$@]");
66              
67 0 0         $ftp->login($username, $password)
68             or return $self->log->error("open: Net::FTP login failed with [".$ftp->message."]");
69              
70 0           return $self->_ftp($ftp);
71             }
72              
73             sub cwd {
74 0     0 0   my $self = shift;
75 0           my ($directory) = @_;
76              
77 0   0       $directory ||= '';
78 0           my $ftp = $self->_ftp;
79 0 0         $self->brik_help_run_undef_arg('open', $ftp) or return;
80              
81 0           my $r = $ftp->cwd($directory);
82              
83 0           return $r;
84             }
85              
86             sub pwd {
87 0     0 0   my $self = shift;
88              
89 0           my $ftp = $self->_ftp;
90 0 0         $self->brik_help_run_undef_arg('open', $ftp) or return;
91              
92 0           my $r = $ftp->pwd;
93              
94 0           return $r;
95             }
96              
97             sub ls {
98 0     0 0   my $self = shift;
99 0           my ($directory) = @_;
100              
101 0           my $ftp = $self->_ftp;
102 0 0         $self->brik_help_run_undef_arg('open', $ftp) or return;
103              
104 0   0       $directory ||= $ftp->pwd;
105              
106 0           my $list = $ftp->ls($directory);
107              
108 0           return $list;
109             }
110              
111             sub dir {
112 0     0 0   my $self = shift;
113 0           my ($directory) = @_;
114              
115 0           my $ftp = $self->_ftp;
116 0 0         $self->brik_help_run_undef_arg('open', $ftp) or return;
117              
118 0   0       $directory ||= $ftp->pwd;
119              
120 0           my $list = $ftp->dir($directory);
121              
122 0           return $list;
123             }
124              
125             sub rmdir {
126 0     0 0   my $self = shift;
127 0           my ($directory) = @_;
128              
129 0           my $ftp = $self->_ftp;
130 0 0         $self->brik_help_run_undef_arg('open', $ftp) or return;
131 0 0         $self->brik_help_run_undef_arg('rmdir', $directory) or return;
132              
133 0           my $r = $ftp->rmdir($directory, $self->recurse);
134              
135 0           return $r;
136             }
137              
138             sub mkdir {
139 0     0 0   my $self = shift;
140 0           my ($directory) = @_;
141              
142 0           my $ftp = $self->_ftp;
143 0 0         $self->brik_help_run_undef_arg('open', $ftp) or return;
144 0 0         $self->brik_help_run_undef_arg('mkdir', $directory) or return;
145              
146 0           my $r = $ftp->mkdir($directory, $self->recurse);
147              
148 0           return $r;
149             }
150              
151             sub binary {
152 0     0 0   my $self = shift;
153              
154 0           my $ftp = $self->_ftp;
155 0 0         $self->brik_help_run_undef_arg('open', $ftp) or return;
156              
157 0           my $r = $ftp->binary;
158              
159 0           return $r;
160             }
161              
162             sub ascii {
163 0     0 0   my $self = shift;
164              
165 0           my $ftp = $self->_ftp;
166 0 0         $self->brik_help_run_undef_arg('open', $ftp) or return;
167              
168 0           my $r = $ftp->ascii;
169              
170 0           return $r;
171             }
172              
173             sub get {
174 0     0 0   my $self = shift;
175 0           my ($remote, $local) = @_;
176              
177 0           my $ftp = $self->_ftp;
178 0 0         $self->brik_help_run_undef_arg('open', $ftp) or return;
179 0 0         $self->brik_help_run_undef_arg('get', $remote) or return;
180 0 0         $self->brik_help_run_undef_arg('get', $local) or return;
181              
182 0           my $r = $ftp->get($remote, $local);
183              
184 0           return $r;
185             }
186              
187             sub close {
188 0     0 0   my $self = shift;
189              
190 0 0         if (defined($self->_ftp)) {
191 0           $self->_ftp->quit;
192 0           $self->_ftp(undef);
193             }
194              
195 0           return 1;
196             }
197              
198             1;
199              
200             __END__