Perl x Open Food Facts Hackathon: Paris, France - May 24-25 Learn more

CONTRA / Test-Smoke-1.84 / lib / Test / Smoke / Syncer / Rsync.pm 

            

              
1
2
3
4
5
6
7
—
8
9
10
11
12
13
14
15
16
17
18
19
20
—
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
—
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
—
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120

              
package Test::Smoke::Syncer::Rsync;
use warnings;
use strict;
our $VERSION = '0.029';
use base 'Test::Smoke::Syncer::Base';
=head1 Test::Smoke::Syncer::Rsync
This handles syncing with the B<rsync> program.
It should only be visible from the "parent-package" so no direct
user-calls on this.
=cut
use Cwd;
use Test::Smoke::LogMixin;
use Test::Smoke::Util::Execute;
use Text::ParseWords;
=head2 Test::Smoke::Syncer::Rsync->new( %args )
This crates the new object. Keys for C<%args>:
  * ddir:   destination directory ( ./perl-current )
  * source: the rsync source ( ftp.linux.activestate.com::perl-current )
  * opts:   the options for rsync ( -az --delete )
  * rsync:  the full path to the rsync program ( rsync )
  * v:      verbose
=head2 $rsync->pre_sync()
Create the destination directory is it doesn't exist.
=cut
sub pre_sync {
    my $self = shift;
    if (! -d $self->{ddir}) {
        require File::Path;
        open my $fh, '>', \my $output;
        my $stdout = select $fh;
        File::Path::mkpath($self->{ddir}, $self->verbose);
        select $stdout;
        $self->log_info($output);
    }
    $self->SUPER::pre_sync;
}
=head2 $object->sync( )
Do the actual sync using a call to the B<rsync> program.
B<rsync> can also be used as a smart version of copy. If you
use a local directory to rsync from, make sure the destination path
ends with a I<path separator>! (This does not seem to work for source
paths mounted via NFS.)
=cut
sub sync {
    my $self = shift;
    $self->pre_sync;
    my $rsync = Test::Smoke::Util::Execute->new(
        command => $self->{rsync},
        verbose => $self->verbose,
    );
    my $cwd = cwd();
    if (! chdir $self->{ddir}) {
        require Carp;
        Carp::croak( "[rsync] Cannot chdir($self->{ddir}): $!" );
    };
    my $rsyncout = $rsync->run(
        shellwords($self->{opts}),
        ($self->verbose ? "-v" : ""),
        $self->{source},
        File::Spec->curdir,
        ($self->verbose ? "" : ">" . File::Spec->devnull)
    );
    $self->log_debug($rsyncout);
    if (my $err = $rsync->exitcode ) {
        require Carp;
        Carp::carp( "Problem during rsync ($err)" );
    }
    if ($self->is_git_dir()) {
        $self->make_dot_patch();
    }
    chdir $cwd;
    my $plevel = $self->check_dot_patch;
    $self->post_sync;
    return $plevel;
}
1;
=head1 COPYRIGHT
(c) 2002-2013, All rights reserved.
  * Abe Timmerman <abeltje@cpan.org>
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
See:
  * <http://www.perl.com/perl/misc/Artistic.html>,
  * <http://www.gnu.org/copyleft/gpl.html>
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