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


line stmt bran cond sub pod time code
1             package Test::Smoke::Syncer::FTP;
2 11     11   80 use warnings;
  11         23  
  11         405  
3 11     11   69 use strict;
  11         28  
  11         457  
4              
5             our $VERSION = '0.029';
6              
7 11     11   65 use base 'Test::Smoke::Syncer::Base';
  11         34  
  11         1305  
8              
9             =head1 Test::Smoke::Syncer::FTP
10              
11             This handles syncing by getting the source-tree from ActiveState's APC
12             repository. It uses the C that implements a
13             mirror function.
14              
15             =cut
16              
17 11     11   91 use File::Spec::Functions;
  11         31  
  11         5447  
18              
19             =head2 Test::Smoke::Syncer::FTP->new( %args )
20              
21             Known args for this class:
22              
23             * ftphost (public.activestate.com)
24             * ftpusr (anonymous)
25             * ftppwd (smokers@perl.org)
26             * ftpsdir (/pub/apc/perl-????)
27             * ftpcdir (/pub/apc/perl-????-diffs)
28             * ftype (undef|binary|ascii)
29              
30             * ddir
31             * v
32              
33             =cut
34              
35             =head2 $syncer->sync()
36              
37             This does the actual syncing:
38              
39             * Check {ftpcdir} for the latest changenumber
40             * Mirror
41              
42             =cut
43              
44             sub sync {
45 3     3 1 6621 my $self = shift;
46              
47 3         26 $self->pre_sync;
48 3         536 require Test::Smoke::FTPClient;
49              
50             my $fc = Test::Smoke::FTPClient->new( $self->{ftphost}, {
51             v => $self->{v},
52             passive => $self->{ftppassive},
53             fuser => $self->{ftpusr},
54             fpwd => $self->{ftppwd},
55             ftype => $self->{ftype},
56 3         61 } );
57              
58 3         19 $fc->connect;
59              
60 3 100       4 $fc->mirror( @{ $self }{qw( ftpsdir ddir )}, 1 ) or return;
  3         9  
61              
62 2         76 $self->{client} = $fc;
63              
64 2         21 my $plevel = $self->create_dot_patch;
65 2         71 $self->post_sync;
66 2         16 return $plevel;
67             }
68              
69             =head2 $syncer->create_dot_patch
70              
71             This needs to go to the *-diffs directory on APC and find the patch
72             whith the highest number, that should be our current patchlevel.
73              
74             =cut
75              
76             sub create_dot_patch {
77 2     2 1 5 my $self = shift;
78 2         5 my $ftp = $self->{client}->{client};
79              
80 2         8 $ftp->cwd( $self->{ftpcdir} );
81 12         30 my $plevel = (sort { $b <=> $a } map {
82 2         61 s/\.gz$//; $_
  10         247  
  10         39  
83             } grep /\d+\.gz/ => $ftp->ls)[0];
84              
85 2         16 my $dotpatch = catfile( $self->{ddir}, '.patch' );
86 2         10 local *DOTPATH;
87 2 50       147 if ( open DOTPATCH, "> $dotpatch" ) {
88 2         26 print DOTPATCH $plevel;
89 2 50       75 close DOTPATCH or do {
90 0         0 require Carp;
91 0         0 Carp::carp( "Error writing '$dotpatch': $!" );
92             };
93             } else {
94 0         0 require Carp;
95 0         0 Carp::carp( "Error creating '$dotpatch': $!" );
96             }
97 2         12 return $plevel;
98             }
99              
100             1;
101              
102             =head1 COPYRIGHT
103              
104             (c) 2002-2013, All rights reserved.
105              
106             * Abe Timmerman
107              
108             This library is free software; you can redistribute it and/or modify
109             it under the same terms as Perl itself.
110              
111             See:
112              
113             * ,
114             *
115              
116             This program is distributed in the hope that it will be useful,
117             but WITHOUT ANY WARRANTY; without even the implied warranty of
118             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
119              
120             =cut