Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

mikeB's scratchpad

by mikeB (Friar)
on Jun 02, 2004 at 01:56 UTC ( [id://358988]=scratchpad: print w/replies, xml ) Need Help??

package IO::Ftp; require 5.005_62; use strict; use warnings; require Exporter; our @ISA = qw(Exporter); use vars qw/@ISA $VERSION/; $VERSION = 0.01; our %EXPORT_TAGS = ( 'all' => [ qw( new delete rename_to mdtm size filename ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw(); use File::Basename; use URI; use Symbol; use Net::FTP; use Carp; sub new { my ($src, $mode, $uri_string, %args) = @_; my $class = ref $src || 'IO::Ftp'; if (ref $src and not $src->isa('IO::Ftp')) { carp "Can't make an IO::FTP from a ", ref $src; return; } my $uri = URI->new('ftp:' . $uri_string); my $ftp; if (ref $src and not $uri->host) { if ($src->connected) { warn "Can't reuse host with open connection"; return; } $ftp = ${*$src}{'io_ftp_ftp'}; } else { $ftp = Net::FTP->new( $uri->host, Port => ($uri->port || 80), Debug => $args{DEBUG}, Timeout => $args{Timeout}, BlockSize => $args{BlockSize}, Passive => $args{Passive}, ); } unless ($ftp) { carp "Can't connect to host ", $uri->host; return; } my $self = __open($ftp, $mode, $uri, %args); return unless $self; ${*$self}{'io_ftp_ftp'} = $ftp; return bless $self, $class; } sub __open { my ($ftp, $mode, $uri, %args) = @_; my $id = $uri->user || 'anonymous'; my $pwd = $uri->password || 'anon@anon.org'; $ftp->login($id, $pwd); fileparse_set_fstype($args{OS}) if $args{OS}; my ($file, $path) = fileparse($uri->path); warn "File: $file, Path: $path" if $args{DEBUG}; foreach ('/', split '/', $path) { unless ($ftp->cwd($_)) { warn "Can't cwd to $_"; return; } } if ($args{type}) { unless ($args{type} =~ /^[ai]$/i) { carp "Invalid type: $args{type}"; return; } unless ($ftp->type($args{type}) ) { carp "Can't set type $args{type}: ", $ftp->message; } } if ($mode eq '<<') { $file = __find_file($ftp, $file); return unless $file; } # cache these in case user wants initial values. Can't get them o +nce the data connection is open. my $size = $ftp->size($file); my $mdtm = $ftp->mdtm($file); my $dataconn; if ($mode eq '<' or $mode eq '<<') { $dataconn = $ftp->retr($file); } elsif ($mode eq '>') { $dataconn = $ftp->stor($file); } elsif ($mode eq '>>') { $dataconn = $ftp->appe($file); } else { carp "Invalid mode $mode"; return; } unless ($dataconn) { carp "Can't open $file: ", $ftp->message ; return; } # we want to be a subclass of the dataconn, but its class is dynam +ic. push @ISA, ref $dataconn; ${*$dataconn}{'io_ftp_file'} = $file; ${*$dataconn}{'io_ftp_size'} = $size; ${*$dataconn}{'io_ftp_mdtm'} = $mdtm; return $dataconn; } sub __find_file { my ($ftp,$pattern) = @_; my @files = $ftp->ls($pattern); return $files[0]; } sub filename { my $self = shift; return ${*$self}{'io_ftp_file'}; } ### allow shortcuts to Net::FTP's rename and delete, but only if data +connection not open. OTW we'll hang. sub rename_to { my ($self, $new_name) = @_; return if $self->connected; my $ret = ${*$self}{'io_ftp_ftp'}->rename(${*$self}{'io_ftp_file'} +, $new_name); ${*$self}{'io_ftp_file'} = $new_name; return $ret; } sub delete { my ($self) = @_; return if $self->connected; return ${*$self}{'io_ftp_ftp'}->delete(${*$self}{'io_ftp_file'}); } ### return cached stats if connected, or real ones if connection close +d. sub mdtm { my ($self) = @_; return ${*$self}{'io_ftp_mdtm'} if $self->connected; return ${*$self}{'io_ftp_ftp'}->mdtm(${*$self}{'io_ftp_file'}); } sub size { my ($self) = @_; return ${*$self}{'io_ftp_size'} if $self->connected; return ${*$self}{'io_ftp_ftp'}->size(${*$self}{'io_ftp_file'}); } 1;
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others wandering the Monastery: (5)
As of 2024-03-28 22:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found