File Coverage

blib/lib/Test/Smoke/Syncer/FTP.pm

Criterion	Covered	Total	%
statement	36	40	90.0
branch	4	6	66.6
condition			n/a
subroutine	6	6	100.0
pod	2	2	100.0
total	48	54	88.8

package Test::Smoke::Syncer::FTP;
use warnings;
use strict;

our $VERSION = '0.029';

use base 'Test::Smoke::Syncer::Base';

=head1 Test::Smoke::Syncer::FTP

This handles syncing by getting the source-tree from ActiveState's APC
repository. It uses the C that implements a
mirror function.

=cut

use File::Spec::Functions;

=head2 Test::Smoke::Syncer::FTP->new( %args )

Known args for this class:

    * ftphost (public.activestate.com)
    * ftpusr  (anonymous)
    * ftppwd  ([e-mail])
    * ftpsdir (/pub/apc/perl-????)
    * ftpcdir (/pub/apc/perl-????-diffs)
    * ftype (undef|binary|ascii)

    * ddir
    * v

=cut

=head2 $syncer->sync()

This does the actual syncing:

    * Check {ftpcdir} for the latest changenumber
    * Mirror

=cut

sub sync {
    my $self = shift;

    $self->pre_sync;
    require Test::Smoke::FTPClient;

    my $fc = Test::Smoke::FTPClient->new( $self->{ftphost}, {
        v       => $self->{v},
        passive => $self->{ftppassive},
        fuser   => $self->{ftpusr},
        fpwd    => $self->{ftppwd},
        ftype   => $self->{ftype},
    } );

    $fc->connect;

    $fc->mirror( @{ $self }{qw( ftpsdir ddir )}, 1 ) or return;

    $self->{client} = $fc;

    my $plevel = $self->create_dot_patch;
    $self->post_sync;
    return $plevel;
}

=head2 $syncer->create_dot_patch

This needs to go to the *-diffs directory on APC and find the patch
whith the highest number, that should be our current patchlevel.

=cut

sub create_dot_patch {
    my $self = shift;
    my $ftp = $self->{client}->{client};

    $ftp->cwd( $self->{ftpcdir} );
    my $plevel = (sort { $b <=> $a } map {
        s/\.gz$//; $_
    } grep /\d+\.gz/ => $ftp->ls)[0];

    my $dotpatch = catfile( $self->{ddir}, '.patch' );
    local *DOTPATH;
    if ( open DOTPATCH, "> $dotpatch" ) {
        print DOTPATCH $plevel;
        close DOTPATCH or do {
            require Carp;
            Carp::carp( "Error writing '$dotpatch': $!" );
        };
    } else {
        require Carp;
        Carp::carp( "Error creating '$dotpatch': $!" );
    }
    return $plevel;
}

1;

=head1 COPYRIGHT

(c) 2002-2013, All rights reserved.

  * Abe Timmerman

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

See:

  * ,
  *

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

=cut