File Coverage

blib/lib/Sys/Bprsync.pm
Criterion Covered Total %
statement 11 13 84.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 16 18 88.8


line stmt bran cond sub pod time code
1             package Sys::Bprsync;
2             {
3             $Sys::Bprsync::VERSION = '0.25';
4             }
5             BEGIN {
6 1     1   3086 $Sys::Bprsync::AUTHORITY = 'cpan:TEX';
7             }
8             # ABSTRACT: Bullet-proof rsync wrapper
9              
10 1     1   28 use 5.010_000;
  1         3  
  1         44  
11 1     1   5 use mro 'c3';
  1         2  
  1         7  
12 1     1   27 use feature ':5.10';
  1         2  
  1         104  
13              
14 1     1   564 use Moose;
  0            
  0            
15             use namespace::autoclean;
16              
17             # use IO::Handle;
18             # use autodie;
19             # use MooseX::Params::Validate;
20              
21             use Try::Tiny;
22              
23             use Sys::Bprsync::Job;
24             use Job::Manager;
25             use Sys::CmdMod;
26              
27             has 'logfile' => (
28             'is' => 'rw',
29             'isa' => 'Str',
30             'required' => 1,
31             );
32              
33             has 'jobs' => (
34             'is' => 'rw',
35             'isa' => 'Job::Manager',
36             'lazy' => 1,
37             'builder' => '_init_jobs',
38             );
39              
40             has 'execpre' => (
41             'is' => 'ro',
42             'isa' => 'ArrayRef[Str]',
43             'required' => 0,
44             'default' => sub { [] },
45             );
46              
47             has 'execpost' => (
48             'is' => 'ro',
49             'isa' => 'ArrayRef[Str]',
50             'required' => 0,
51             'default' => sub { [] },
52             );
53              
54             has 'rsync_codes' => (
55             'is' => 'ro',
56             'isa' => 'HashRef',
57             'lazy' => 1,
58             'builder' => '_init_rsync_codes',
59             );
60              
61             has 'cmdmod' => (
62             'is' => 'rw',
63             'isa' => 'Sys::CmdMod',
64             'lazy' => 1,
65             'builder' => '_init_cmdmod',
66             );
67              
68             has 'config_prefix' => (
69             'is' => 'rw',
70             'isa' => 'Str',
71             'lazy' => 1,
72             'builder' => '_init_config_prefix',
73             );
74              
75             has 'concurrency' => (
76             'is' => 'ro',
77             'isa' => 'Int',
78             'default' => 1,
79             );
80              
81             has 'sys' => (
82             'is' => 'rw',
83             'isa' => 'Sys::Run',
84             'lazy' => 1,
85             'builder' => '_init_sys',
86             );
87              
88             with qw(Config::Yak::RequiredConfig Log::Tree::RequiredLogger);
89              
90             sub _init_sys {
91             my $self = shift;
92              
93             my $Sys = Sys::Run::->new( {
94             'logger' => $self->logger(),
95             'ssh_hostkey_check' => 0,
96             } );
97              
98             return $Sys;
99             }
100              
101             sub _init_cmdmod {
102             my $self = shift;
103              
104             my $Cmd = Sys::CmdMod::->new({
105             'config' => $self->config(),
106             'logger' => $self->logger(),
107             });
108              
109             return $Cmd;
110             }
111              
112             sub get_cmd_prefix {
113             my $self = shift;
114              
115             my $prefix = q{};
116              
117             return $self->cmdmod()->cmd($prefix);
118             }
119              
120             sub _init_rsync_codes {
121             my $self = shift;
122              
123             # explaination of rsync return codes - taken from dirvish
124             # see http://rsync.samba.org/ftp/unpacked/rsync/errcode.h
125             my %RSYNC_CODES = (
126             0 => [ 'success', 'No errors' ],
127             1 => [ 'fatal', 'syntax or usage error' ],
128             2 => [ 'fatal', 'protocol incompatibility' ],
129             3 => [ 'fatal', 'errors selecting input/output files, dirs' ],
130             4 => [ 'fatal', 'requested action not supported' ],
131             5 => [ 'fatal', 'error starting client-server protocol' ],
132              
133             10 => [ 'error', 'error in socket IO' ],
134             11 => [ 'error', 'error in file IO' ],
135             12 => [ 'check', 'error in rsync protocol data stream' ],
136             13 => [ 'check', 'errors with program diagnostics' ],
137             14 => [ 'error', 'error in IPC code' ],
138             15 => [ 'error', 'sibling crashed' ],
139             16 => [ 'error', 'sibling terminated abnormally' ],
140              
141             19 => [ 'error', 'status returned when sent SIGUSR1' ],
142             20 => [ 'error', 'status returned when sent SIGUSR1, SIGINT' ],
143             21 => [ 'error', 'some error returned by waitpid()' ],
144             22 => [ 'error', 'error allocating core memory buffers' ],
145             23 => [ 'warning', 'partial transfer' ],
146              
147             24 => [ 'warning', 'file vanished on sender' ],
148             25 => [ 'warning', 'skipped some deletes due to --max-delete' ],
149              
150             30 => [ 'error', 'timeout in data send/receive' ],
151             35 => [ 'error', 'timeout waiting for daemon connection' ],
152              
153             124 => [ 'fatal', 'remote shell failed' ],
154             125 => [ 'error', 'remote shell killed' ],
155             126 => [ 'fatal', 'command could not be run' ],
156             127 => [ 'fatal', 'command not found' ],
157             255 => [ 'fatal', 'unexplained error/missing ssh keys' ],
158             );
159             return \%RSYNC_CODES;
160             }
161              
162             sub _init_config_prefix {
163             return 'Sys::Bprsync';
164             }
165              
166             sub BUILD {
167             my $self = shift;
168              
169             # populate execpre and execpost from config if not given explicitly
170              
171             if ( !$self->execpre() ) {
172             my @vals = $self->config()->get_array( $self->config_prefix() . '::ExecPre' );
173             $self->execpre( [@vals] ) if @vals;
174             }
175              
176             if ( !$self->execpost() ) {
177             my @vals = $self->config()->get_array( $self->config_prefix() . '::ExecPost' );
178             $self->execpre( [@vals] ) if @vals;
179             }
180              
181             return 1;
182             }
183              
184             sub vaults {
185             my $self = shift;
186              
187             return [$self->config()->get_array( $self->config_prefix() . '::Jobs' )];
188             }
189              
190             sub _init_jobs {
191             my $self = shift;
192              
193             my $JQ = Job::Manager::->new(
194             {
195             'logger' => $self->logger(),
196             'concurrency' => $self->concurrency(),
197             }
198             );
199             my $verbose = $self->config()->get( $self->config_prefix() . '::Verbose' ) ? 1 : 0;
200             my $dry = $self->config()->get( $self->config_prefix() . '::Dry' ) ? 1 : 0;
201              
202             foreach my $job_name ( @{$self->vaults()} ) {
203             try {
204             my $Job = Sys::Bprsync::Job::->new(
205             {
206             'parent' => $self,
207             'name' => $job_name,
208             'verbose' => $verbose,
209             'dry' => $dry,
210             'logger' => $self->logger(),
211             'config' => $self->config(),
212             }
213             );
214             $JQ->add($Job);
215             }
216             catch {
217             $self->logger()->log( message => 'caught error: '.$_, level => 'error', );
218             };
219             }
220              
221             return $JQ;
222             }
223              
224             sub _exec_pre {
225             my $self = shift;
226              
227             my $ok = 1;
228             foreach my $cmd ( @{ $self->execpre() } ) {
229             if ( !$self->sys()->run_cmd($cmd) ) {
230             $ok = 0;
231             }
232             }
233             return $ok;
234             }
235              
236             sub _exec_post {
237             my $self = shift;
238              
239             foreach my $cmd ( @{ $self->execpost() } ) {
240             $self->sys()->run_cmd($cmd);
241             }
242             return 1;
243             }
244              
245             sub run {
246             my $self = shift;
247             $self->_exec_pre()
248             or return;
249             $self->jobs()->run();
250             $self->_exec_post();
251              
252             return 1;
253             }
254              
255             no Moose;
256             __PACKAGE__->meta->make_immutable;
257              
258             1;
259              
260             __END__
261              
262             =pod
263              
264             =encoding UTF-8
265              
266             =head1 NAME
267              
268             Sys::Bprsync - Bullet-proof rsync wrapper
269              
270             =head1 NAME
271              
272             Sys::BPrsync - Bullet-proof rsync wrapper
273              
274             =head1 METHODS
275              
276             =head2 BUILD
277              
278             Initialize pre and post exec queues.
279              
280             =head2 get_cmd_prefix
281              
282             Return the command prefix.
283              
284             =head2 run
285              
286             Run the sync.
287              
288             =head2 vaults
289              
290             Return a list of all vaults.
291              
292             =head1 AUTHOR
293              
294             Dominik Schulz <dominik.schulz@gauner.org>
295              
296             =head1 COPYRIGHT AND LICENSE
297              
298             This software is copyright (c) 2012 by Dominik Schulz.
299              
300             This is free software; you can redistribute it and/or modify it under
301             the same terms as the Perl 5 programming language system itself.
302              
303             =cut