view release on metacpan or  search on metacpan

t/syncer_ftpclient.t  view on Meta::CPAN

#! /usr/bin/perl -w
use strict;
use Data::Dumper;

# $Id$
##### syncer_ftpclient.t
#
# Here we try to test the actual syncing process from ftp
# This is done by overriding all the used Net::FTP handlers
# and provide a fake FTP mechanism through them
# For this there is the 't/ftppub' directory with:
#     't/ftppub/perl-current' contains a source-tree
# Now that we have controlable FTP (if you have Net::FTP), 
#
#####

use vars qw( $FTP_FAIL );
$FTP_FAIL = 0;
use File::Spec::Functions;
use File::Basename;
use Cwd;
my $extra_lib;
BEGIN {
    $extra_lib = File::Spec->rel2abs( dirname( $0 ), cwd() );
    print "Using '$extra_lib' as extra \@INC\n";
}
use lib $extra_lib;
use TestLib;

use Test::More;

BEGIN {
    eval { require Net::FTP; };
    $@ and plan( skip_all => "No 'Net::FTP' found!\n" . 
                             "!!!You will not be able to smoke from " .
                             "FTP-archive without it!!!" );
    plan tests => 10;
}

# Can we get away with redefining the Net::FTP stuff?

BEGIN { $^W = 0; } # no warnings 'redefine';
sub Net::FTP::new {
    bless {
        root => File::Spec->catdir( $extra_lib, 'ftppub' ),
        cwd  => File::Spec->catdir( $extra_lib, 'ftppub' ),
    }, 'Net::FTP';
}
sub Net::FTP::login { return 1 }
sub Net::FTP::binary { return 1 }
sub Net::FTP::quit {return 1 }
sub Net::FTP::cwd { 
    my $self = shift;
    my $dir = shift;
    if ( $dir eq '/' ) {
        $self->{cwd} = $self->{root};
    } elsif ( $dir =~ s|^/|| ) {
        $self->{cwd} = File::Spec->catdir( $self->{root}, split m|[/]|, $dir );
    } else {
        $self->{cwd} = File::Spec->catdir( $self->{cwd}, split m|/|, $dir );
    }
#    print "# [NF][cwd $dir] $self->{cwd}\n";
}
sub Net::FTP::pwd {
    my $self = shift;
    File::Spec->abs2rel( $self->{cwd}, $self->{root} );
}
sub Net::FTP::ls { 
    my $self = shift;
    local *DLDIR;
    opendir DLDIR, $self->{cwd} or return ( );
    return map {
        my $fname = $_;
        $^O eq 'VMS' and $fname =~ s/\.(?:DIR)?$//i;
        $fname;
    } grep ! /.svn\b/  => readdir DLDIR;
}
sub Net::FTP::dir {
    my $self = shift;
    my @list = $self->ls;
    my @entries = map {
        my @info = stat File::Spec->catfile( $self->{cwd}, $_ );
        my $fmode = $info[2];
        my @smode = qw( --- --x -w- -wx r-- r-x rw- rwx );
        my( $i, $lslmode ) = ( 0, "" );
        for ( $i = 0; $i < 3; $i++ ) {
            $lslmode = $smode[ $fmode & 07 ] . $lslmode;
            $fmode = $fmode >> 3;
        }
        $lslmode = (-d _ ? "d" : "-" ) . $lslmode;
        my @date = localtime $info[9];
        my $fmnth = sprintf "%03d%02d", @date[5,4];
        my $lmnth = sprintf "%03d%02d", (localtime)[5,4];

        $date[4] = [qw( Jan Feb Mar Apr May Jun
                        Jul Aug Sep Oct Nov Dec )]->[$date[4]];
        $date[5] += 1900;
        my $lsldate;
        if ( $lmnth - $fmnth > 6 ) {
            $lsldate = sprintf "%s %2d %5d", @date[4,3,5];
        } else {
            $lsldate = sprintf "%s %2d %02d:%02d", @date[4,3,2,1];
        }
#        printf "%s  1 %-8s %-8s %10d %12s %s\n", $lslmode, 'ftp', 'ftp',
#                                                 $info[7], $lsldate, $_;
        sprintf "%s  1 %-8s %-8s %10d %12s %s", $lslmode, 'ftp', 'ftp',
                                                 $info[7], $lsldate, $_;
    } @list; 
}
sub Net::FTP::size {
    my $self = shift;
    my $file = File::Spec->catfile( $self->{cwd}, shift );
    return -s $file;
}
sub Net::FTP::mdtm {
    my $self = shift;
    ( stat File::Spec->catfile( $self->{cwd}, shift ))[9];
}
sub Net::FTP::get {
    my $self = shift;