line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# -*- perl -*- |
2
|
|
|
|
|
|
|
# vim:ft=perl foldlevel=1 |
3
|
|
|
|
|
|
|
# __ |
4
|
|
|
|
|
|
|
# /\ \ From the mind of |
5
|
|
|
|
|
|
|
# / \ \ |
6
|
|
|
|
|
|
|
# / /\ \ \_____ Lee Eakin ( Leakin at dfw dot Nostrum dot com ) |
7
|
|
|
|
|
|
|
# / \ \ \______\ or ( Leakin at cpan dot org ) |
8
|
|
|
|
|
|
|
# / /\ \ \/____ / or ( Leakin at japh dot net ) |
9
|
|
|
|
|
|
|
# \ \ \ \____\/ / or ( Lee at Eakin dot Org ) |
10
|
|
|
|
|
|
|
# \ \ \/____ / Wrapper module for the rsync program |
11
|
|
|
|
|
|
|
# \ \____\/ / rsync can be found at http://rsync.samba.org/rsync/ |
12
|
|
|
|
|
|
|
# \/______/ |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
package File::Rsync; |
15
|
|
|
|
|
|
|
require 5.008; # it might work with older versions of 5 but not tested |
16
|
|
|
|
|
|
|
|
17
|
2
|
|
|
2
|
|
1448
|
use FileHandle; |
|
2
|
|
|
|
|
15528
|
|
|
2
|
|
|
|
|
8
|
|
18
|
2
|
|
|
2
|
|
1600
|
use IPC::Run3 'run3'; |
|
2
|
|
|
|
|
37240
|
|
|
2
|
|
|
|
|
100
|
|
19
|
2
|
|
|
2
|
|
8
|
use Carp 'carp'; |
|
2
|
|
|
|
|
10
|
|
|
2
|
|
|
|
|
64
|
|
20
|
2
|
|
|
2
|
|
8
|
use Scalar::Util qw(blessed); |
|
2
|
|
|
|
|
0
|
|
|
2
|
|
|
|
|
58
|
|
21
|
2
|
|
|
2
|
|
1024
|
use Data::Dumper; |
|
2
|
|
|
|
|
9352
|
|
|
2
|
|
|
|
|
96
|
|
22
|
|
|
|
|
|
|
|
23
|
2
|
|
|
2
|
|
8
|
use strict; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
36
|
|
24
|
2
|
|
|
2
|
|
6
|
use vars qw($VERSION); |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
4542
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
$VERSION = '0.49'; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head1 NAME |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
File::Rsync - perl module interface to rsync(1) F |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=head1 SYNOPSIS |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
use File::Rsync; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
$obj = File::Rsync->new( |
37
|
|
|
|
|
|
|
archive => 1, |
38
|
|
|
|
|
|
|
compress => 1, |
39
|
|
|
|
|
|
|
rsh => '/usr/local/bin/ssh', |
40
|
|
|
|
|
|
|
'rsync-path' => '/usr/local/bin/rsync' |
41
|
|
|
|
|
|
|
); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
$obj->exec( src => 'localdir', dest => 'rhost:remotedir' ) |
44
|
|
|
|
|
|
|
or warn "rsync failed\n"; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=head1 DESCRIPTION |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
Perl Convenience wrapper for the rsync(1) program. Written for I |
49
|
|
|
|
|
|
|
and updated for I but should perform properly with most recent |
50
|
|
|
|
|
|
|
versions. |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head2 File::Rsync::new |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
$obj = new File::Rsync; |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
or |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
$obj = File::Rsync->new; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
or |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
$obj = File::Rsync->new(@options); |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
Create a I object. |
65
|
|
|
|
|
|
|
Any options passed at creation are stored in the object as defaults for all |
66
|
|
|
|
|
|
|
future I calls on that object. |
67
|
|
|
|
|
|
|
Options may be passed in the style of a hash (key/value pairs) and are the |
68
|
|
|
|
|
|
|
same as the long options in I without the leading double-hyphen. |
69
|
|
|
|
|
|
|
Any leading single or double-hyphens are removed, and you may use underscore |
70
|
|
|
|
|
|
|
in place of hyphens in option names to simplify quoting and avoid possible |
71
|
|
|
|
|
|
|
equation parsing (subtraction). |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
Although options are key/value pairs, as of version 0.46 the order is now |
74
|
|
|
|
|
|
|
preserved. Passing a hash reference is still supported for backwards |
75
|
|
|
|
|
|
|
compatibility, but is deprecated as order cannot be preserved for this case. |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
An additional option of B also exists which can be used to |
78
|
|
|
|
|
|
|
override the using PATH environemt variable to find the rsync command binary, |
79
|
|
|
|
|
|
|
and B which causes the module methods to print some debugging |
80
|
|
|
|
|
|
|
information to STDERR. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
There are also 2 options to wrap the source and/or destination paths in |
83
|
|
|
|
|
|
|
double-quotes: these are B and B, which may be useful |
84
|
|
|
|
|
|
|
in protecting the paths from shell expansion (particularly useful for paths |
85
|
|
|
|
|
|
|
containing spaces). This wraps all source and/or destination paths in |
86
|
|
|
|
|
|
|
double-quotes to limit remote shell expansion. It is similar but not |
87
|
|
|
|
|
|
|
necessarily the same result as the B option in rsync itself. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
The B and B options take a function reference, called once |
90
|
|
|
|
|
|
|
for each line of output from the I program with the output line passed |
91
|
|
|
|
|
|
|
in as the first argument, the second arg is either 'out' or 'err' depending |
92
|
|
|
|
|
|
|
on the source. |
93
|
|
|
|
|
|
|
This makes it possible to use the same function for both and still determine |
94
|
|
|
|
|
|
|
where the output came from. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
If options are passed as a hash reference (deprecated), the B |
97
|
|
|
|
|
|
|
needs an array reference as it's value since there cannot be duplicate keys |
98
|
|
|
|
|
|
|
in a hash. Since order cannot be preserved in a hash, this module currently |
99
|
|
|
|
|
|
|
limits the use of B or B together. |
100
|
|
|
|
|
|
|
They can be mixed together if options are in the form of a list or array ref. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
Use the '+ ' or '- ' prefix trick to put includes in an B array, or |
103
|
|
|
|
|
|
|
to put excludes in an B array (see I for details). |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
Include/exclude options form an ordered list. |
106
|
|
|
|
|
|
|
The order must be retained for proper execution. |
107
|
|
|
|
|
|
|
There are also B |
108
|
|
|
|
|
|
|
The key B is also accepted as an equivalent to B |
109
|
|
|
|
|
|
|
B may be used as equivalents to B. |
110
|
|
|
|
|
|
|
The B |
111
|
|
|
|
|
|
|
If the source is the local system then multiple B |
112
|
|
|
|
|
|
|
In this case an array reference should be used. |
113
|
|
|
|
|
|
|
There is also a method for passing multiple source paths to a remote system. |
114
|
|
|
|
|
|
|
This method may be triggered in this module by passing the remote hostname to |
115
|
|
|
|
|
|
|
the B key and passing an array reference to the B |
116
|
|
|
|
|
|
|
If the source host is being accessed via an Rsync server, the remote hostname |
117
|
|
|
|
|
|
|
should have a single trailing colon on the name. |
118
|
|
|
|
|
|
|
When rsync is called, the B value and the values in the B |
119
|
|
|
|
|
|
|
array will be joined with a colon resulting in the double-colon required for |
120
|
|
|
|
|
|
|
server access. |
121
|
|
|
|
|
|
|
The B key only takes a scalar since I only accepts a single |
122
|
|
|
|
|
|
|
destination path. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
Version 2.6.0 of I provides a new B option along with |
125
|
|
|
|
|
|
|
a few other supporting options (B, B, and |
126
|
|
|
|
|
|
|
B). |
127
|
|
|
|
|
|
|
To support this wonderful new option at the level it deserves, this module |
128
|
|
|
|
|
|
|
now has an additional parameter. |
129
|
|
|
|
|
|
|
As of version 0.46 the value of B may be an array reference. |
130
|
|
|
|
|
|
|
The contents of the array are passed to B the same as the |
131
|
|
|
|
|
|
|
below method using B but implemented inside the module. |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
If B is set to '-' (meaning read from stdin) you can define |
134
|
|
|
|
|
|
|
B to be a reference to a function that prints your file list to the |
135
|
|
|
|
|
|
|
default file handle. |
136
|
|
|
|
|
|
|
The output from the function is attached to stdin of the rsync call during |
137
|
|
|
|
|
|
|
exec. |
138
|
|
|
|
|
|
|
If B is defined it will be called regardless of the value of |
139
|
|
|
|
|
|
|
B, so it can provide any data expected on stdin, but keep in mind |
140
|
|
|
|
|
|
|
that stdin will not be attached to a tty so it is not very useful for sending |
141
|
|
|
|
|
|
|
passwords (see the I and I man pages for ways to handle |
142
|
|
|
|
|
|
|
authentication). |
143
|
|
|
|
|
|
|
The I man page has a more complete description of B. |
144
|
|
|
|
|
|
|
Also see L for ideas to use with B and B. |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
The B option may also be used with the B or |
147
|
|
|
|
|
|
|
B options, but this is generally more clumsy than using the |
148
|
|
|
|
|
|
|
B or B arrays. |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
Version 2.6.3 of I provides new options B, |
151
|
|
|
|
|
|
|
B, B, B, B, and B. |
152
|
|
|
|
|
|
|
Version 2.6.4 of I provides new options B, B |
153
|
|
|
|
|
|
|
B, B, B, B, B, |
154
|
|
|
|
|
|
|
B, B, B, B, |
155
|
|
|
|
|
|
|
B, and B. |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
Version 0.38 of this module also added support for the B option that |
158
|
|
|
|
|
|
|
is not part of I unless the patch has been applied, but people do |
159
|
|
|
|
|
|
|
use it. |
160
|
|
|
|
|
|
|
It also includes a new B option that takes an array reference |
161
|
|
|
|
|
|
|
similar to B, B, and B. |
162
|
|
|
|
|
|
|
Any arguments in the array are passed as literal arguments to rsync, and are |
163
|
|
|
|
|
|
|
passed first. |
164
|
|
|
|
|
|
|
They should have the proper single or double hyphen prefixes and the elements |
165
|
|
|
|
|
|
|
should be split up the way you want them passed to exec. |
166
|
|
|
|
|
|
|
The purpose of this option is to allow the use of arbitrary options added by |
167
|
|
|
|
|
|
|
patches, and/or to allow the use of new options in rsync without needing an |
168
|
|
|
|
|
|
|
imediate update to the module in addtition to I itself. |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=cut |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
sub new { |
173
|
20
|
|
|
20
|
1
|
32918
|
my $class = shift; |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# seed the options hash, booleans, scalars, excludes, source, dest, data, |
176
|
|
|
|
|
|
|
# status, stderr/stdout storage for last exec |
177
|
|
|
|
|
|
|
my $self = { |
178
|
|
|
|
|
|
|
# these are the boolean flags to rsync, all default off, including them |
179
|
|
|
|
|
|
|
# in the args list turns them on |
180
|
|
|
|
|
|
|
flag => { |
181
|
2120
|
|
|
|
|
3213
|
map { $_ => 0 } |
182
|
|
|
|
|
|
|
qw(8-bit-output acls append append-verify archive backup |
183
|
|
|
|
|
|
|
blocking-io checksum compress copy-dirlinks copy-links |
184
|
|
|
|
|
|
|
copy-unsafe-links crtimes cvs-exclude daemon del delay-updates |
185
|
|
|
|
|
|
|
delete delete-after delete-before delete-delay delete-during |
186
|
|
|
|
|
|
|
delete-excluded delete-missing-args devices dirs dry-run |
187
|
|
|
|
|
|
|
executability existing fake-super fileflags force force-change |
188
|
|
|
|
|
|
|
force-delete force-schange force-uchange from0 fuzzy group groups |
189
|
|
|
|
|
|
|
hard-links help hfs-compression ignore-errors ignore-existing |
190
|
|
|
|
|
|
|
ignore-missing-args ignore-non-existing ignore-times inc-recursive |
191
|
|
|
|
|
|
|
inplace ipv4 ipv6 keep-dirlinks links list-only msgs2stderr |
192
|
|
|
|
|
|
|
munge-links new-compress no-blocking-io no-detach no-devices |
193
|
|
|
|
|
|
|
no-dirs no-groups no-iconv no-implied-dirs no-inc-recursive |
194
|
|
|
|
|
|
|
no-links no-motd no-owner no-partial no-perms no-progress |
195
|
|
|
|
|
|
|
no-protect-args no-recursive no-relative no-specials no-super |
196
|
|
|
|
|
|
|
no-times no-whole-file numeric-ids old-compress old-dirs |
197
|
|
|
|
|
|
|
omit-dir-times omit-link-times owner partial perms preallocate |
198
|
|
|
|
|
|
|
progress protect-args protect-decmpfs prune-empty-dirs recursive |
199
|
|
|
|
|
|
|
relative remove-source-files safe-links size-only sparse specials |
200
|
|
|
|
|
|
|
stats super times update version whole-file xattrs) |
201
|
|
|
|
|
|
|
}, |
202
|
|
|
|
|
|
|
# these have simple scalar args we cannot easily check |
203
|
|
|
|
|
|
|
# use 'string' so I don't forget and leave keyword scalar unqouted |
204
|
|
|
|
|
|
|
string => { |
205
|
780
|
|
|
|
|
1114
|
map { $_ => '' } |
206
|
|
|
|
|
|
|
qw(address backup-dir block-size bwlimit checksum-seed chown |
207
|
|
|
|
|
|
|
compress-level config contimeout csum-length debug files-from |
208
|
|
|
|
|
|
|
groupmap iconv info log-file log-file-format log-format max-delete |
209
|
|
|
|
|
|
|
max-size min-size modify-window only-write-batch out-format outbuf |
210
|
|
|
|
|
|
|
partial-dir password-file port protocol read-batch rsh rsync-path |
211
|
|
|
|
|
|
|
skip-compress sockopts suffix temp-dir timeout usermap |
212
|
|
|
|
|
|
|
write-batch) |
213
|
|
|
|
|
|
|
}, |
214
|
|
|
|
|
|
|
# these are not flags but counters, each time they appear it raises the |
215
|
|
|
|
|
|
|
# count, so we keep track and pass them the same number of times |
216
|
|
|
|
|
|
|
counter => { |
217
|
20
|
|
|
|
|
150
|
map { $_ => 0 } |
|
100
|
|
|
|
|
509
|
|
218
|
|
|
|
|
|
|
qw(human-readable itemize-changes one-file-system quiet verbose) |
219
|
|
|
|
|
|
|
}, |
220
|
|
|
|
|
|
|
# these can be specified multiple times and are additive, the doc also |
221
|
|
|
|
|
|
|
# specifies that it is an ordered list so we must preserve that order |
222
|
|
|
|
|
|
|
list => { |
223
|
|
|
|
|
|
|
'chmod' => [], |
224
|
|
|
|
|
|
|
'compare-dest' => [], |
225
|
|
|
|
|
|
|
'copy-dest' => [], |
226
|
|
|
|
|
|
|
'dparam' => [], |
227
|
|
|
|
|
|
|
'exclude' => [], |
228
|
|
|
|
|
|
|
'exclude-from' => [], |
229
|
|
|
|
|
|
|
'filter' => [], |
230
|
|
|
|
|
|
|
'include' => [], |
231
|
|
|
|
|
|
|
'include-from' => [], |
232
|
|
|
|
|
|
|
'link-dest' => [], |
233
|
|
|
|
|
|
|
'literal' => [], |
234
|
|
|
|
|
|
|
'remote-option' => [], |
235
|
|
|
|
|
|
|
}, |
236
|
|
|
|
|
|
|
code => { # input/output user functions |
237
|
|
|
|
|
|
|
'errfun' => undef, |
238
|
|
|
|
|
|
|
'outfun' => undef, |
239
|
|
|
|
|
|
|
# function to prvide --*-from=- data via pipe |
240
|
|
|
|
|
|
|
'infun' => undef, |
241
|
|
|
|
|
|
|
}, |
242
|
|
|
|
|
|
|
_perlopts => { |
243
|
|
|
|
|
|
|
# the path name to the rsync binary (default is to use $PATH) |
244
|
|
|
|
|
|
|
'path-to-rsync' => 'rsync', |
245
|
|
|
|
|
|
|
# hostname of source, used if 'source' is an array reference |
246
|
|
|
|
|
|
|
'srchost' => '', |
247
|
|
|
|
|
|
|
# double-quote source and/or destination paths |
248
|
|
|
|
|
|
|
'quote-src' => 0, |
249
|
|
|
|
|
|
|
'quote-dst' => 0, |
250
|
|
|
|
|
|
|
# whether or not to print debug statements |
251
|
|
|
|
|
|
|
'moddebug' => 0, |
252
|
|
|
|
|
|
|
}, |
253
|
|
|
|
|
|
|
# source host and/or path names |
254
|
|
|
|
|
|
|
'source' => '', |
255
|
|
|
|
|
|
|
# destination host and/or path |
256
|
|
|
|
|
|
|
'dest' => '', |
257
|
|
|
|
|
|
|
# return status from last exec |
258
|
|
|
|
|
|
|
'_status' => 0, |
259
|
|
|
|
|
|
|
'_realstatus' => 0, |
260
|
|
|
|
|
|
|
# last rsync command-line executed |
261
|
|
|
|
|
|
|
'_lastcmd' => undef, |
262
|
|
|
|
|
|
|
# stderr from last exec in array format (messages from remote rsync proc) |
263
|
|
|
|
|
|
|
'_err' => 0, |
264
|
|
|
|
|
|
|
# stdout from last exec in array format (messages from local rsync proc) |
265
|
|
|
|
|
|
|
'_out' => 0, |
266
|
|
|
|
|
|
|
# this flag changes error checking in 'exec' when called by 'list' |
267
|
|
|
|
|
|
|
'_list_mode' => 0, |
268
|
|
|
|
|
|
|
# this array used to preserve arg order |
269
|
|
|
|
|
|
|
'_args' => [], |
270
|
|
|
|
|
|
|
}; |
271
|
20
|
|
|
|
|
170
|
bless $self, $class; # bless it first so defopts can find out the class |
272
|
20
|
50
|
|
|
|
52
|
if (@_) { |
273
|
20
|
100
|
|
|
|
59
|
&defopts($self, @_) or return; |
274
|
|
|
|
|
|
|
} |
275
|
18
|
|
|
|
|
50
|
return $self; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
=head2 File::Rsync::defopts |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
$obj->defopts(@options); |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
or |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
$obj->defopts(\@options); |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
Set default options for future exec calls for the object. |
287
|
|
|
|
|
|
|
See I for a complete list of valid options. |
288
|
|
|
|
|
|
|
This is really the internal method that I calls but you can use it too. |
289
|
|
|
|
|
|
|
The B and B options to rsync are actually counters. |
290
|
|
|
|
|
|
|
When assigning the perl hash-style options you may specify the counter value |
291
|
|
|
|
|
|
|
directly and the module will pass the proper number of options to rsync. |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=cut |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
sub defopts { |
296
|
|
|
|
|
|
|
# this method has now been split into 2 sub methods (parse and save) |
297
|
|
|
|
|
|
|
# _saveopts and _parseopts should only be used via defopts or exec |
298
|
20
|
|
|
20
|
1
|
21
|
my $self = shift; |
299
|
20
|
|
|
|
|
47
|
&_saveopts($self, &_parseopts($self, @_)); |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
sub _parseopts { |
303
|
|
|
|
|
|
|
# this method checks and converts it's args into a reference to a hash |
304
|
|
|
|
|
|
|
# of valid options and returns it to the caller |
305
|
42
|
|
|
42
|
|
37
|
my $self = shift; |
306
|
42
|
|
|
|
|
47
|
my $pkgname = ref $self; |
307
|
42
|
|
|
|
|
19
|
my $href; |
308
|
42
|
|
|
|
|
61
|
my %OPT = (); # this is the hash we will return a ref to |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
# make sure we are passed the proper number of args |
311
|
42
|
100
|
|
|
|
113
|
if (@_ == 1) { |
312
|
4
|
50
|
|
|
|
62
|
if (my $reftype = ref $_[0]) { |
313
|
4
|
50
|
|
|
|
12
|
if ($reftype eq 'HASH') { |
|
|
0
|
|
|
|
|
|
314
|
4
|
50
|
|
|
|
438
|
carp "$pkgname: hash reference is deprecated, use array or list." |
315
|
|
|
|
|
|
|
if $^W; |
316
|
4
|
|
|
|
|
148
|
@_ = %{$_[0]}; |
|
4
|
|
|
|
|
12
|
|
317
|
4
|
|
|
|
|
10
|
$href++; |
318
|
|
|
|
|
|
|
} elsif ($reftype eq 'ARRAY') { |
319
|
0
|
|
|
|
|
0
|
@_ = @{$_[0]}; |
|
0
|
|
|
|
|
0
|
|
320
|
|
|
|
|
|
|
} else { |
321
|
0
|
|
|
|
|
0
|
carp "$pkgname: invalid reference type ($reftype) option."; |
322
|
0
|
|
|
|
|
0
|
return; |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
} else { |
325
|
0
|
|
|
|
|
0
|
carp "$pkgname: invalid option ($_[0])."; |
326
|
0
|
|
|
|
|
0
|
return; |
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
} |
329
|
42
|
50
|
|
|
|
100
|
if (@_ % 2) { |
330
|
0
|
|
|
|
|
0
|
carp |
331
|
|
|
|
|
|
|
"$pkgname: invalid number of options passed (must be key/value pairs)."; |
332
|
0
|
|
|
|
|
0
|
return; |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
# now process the options given, we handle debug first |
336
|
42
|
|
|
|
|
79
|
for (my $i = 0; $i < @_; $i += 2) { |
337
|
92
|
50
|
|
|
|
212
|
if ($_[$i] eq 'moddebug') { |
338
|
0
|
|
|
|
|
0
|
$OPT{moddebug} = $_[ $i + 1 ]; |
339
|
0
|
0
|
|
|
|
0
|
warn "setting debug flag\n" if $OPT{moddebug}; |
340
|
0
|
|
|
|
|
0
|
last; |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
42
|
|
|
|
|
38
|
my @order; |
345
|
42
|
|
|
|
|
145
|
while (my ($inkey, $val) = splice @_, 0, 2) { |
346
|
92
|
|
|
|
|
127
|
(my $key = $inkey) =~ tr/_/-/; |
347
|
92
|
|
|
|
|
116
|
$key =~ s/^--?//; # remove any leading hyphens if found |
348
|
92
|
100
|
|
|
|
136
|
$key = 'source' if $key eq 'src'; |
349
|
92
|
50
|
33
|
|
|
301
|
$key = 'dest' if $key eq 'dst' or $key eq 'destination'; |
350
|
92
|
50
|
|
|
|
128
|
next if $key eq 'moddebug'; # we did this one already |
351
|
|
|
|
|
|
|
warn "processing option: $inkey\n" |
352
|
|
|
|
|
|
|
if $OPT{moddebug} |
353
|
92
|
50
|
33
|
|
|
253
|
or $self->{_perlopts}{moddebug}; |
354
|
92
|
100
|
66
|
|
|
349
|
if ( exists $self->{flag}{$key} |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
355
|
|
|
|
|
|
|
or exists $self->{string}{$key} |
356
|
|
|
|
|
|
|
or exists $self->{counter}{$key} |
357
|
|
|
|
|
|
|
or exists $self->{_perlopts}{$key}) |
358
|
|
|
|
|
|
|
{ |
359
|
30
|
100
|
100
|
|
|
84
|
if ($key eq 'files-from' and ref $val eq 'ARRAY') { |
360
|
2
|
|
|
|
|
6
|
push @order, $key, '-', 'infun', $val; # --files-from=- <\@ |
361
|
2
|
|
|
|
|
4
|
$OPT{$key} = '-'; |
362
|
2
|
|
|
|
|
2
|
$OPT{infun} = $val; |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
} else { |
365
|
28
|
|
|
|
|
44
|
push @order, $key, $val; |
366
|
28
|
|
|
|
|
54
|
$OPT{$key} = $val; |
367
|
|
|
|
|
|
|
} |
368
|
30
|
|
|
|
|
77
|
next; |
369
|
|
|
|
|
|
|
} |
370
|
62
|
100
|
100
|
|
|
198
|
if (exists $self->{list}{$key} or $key eq 'source') { |
371
|
30
|
100
|
|
|
|
72
|
if (my $reftype = ref $val) { |
|
|
50
|
|
|
|
|
|
372
|
2
|
50
|
0
|
|
|
3
|
if ($reftype eq 'ARRAY') { |
|
|
0
|
|
|
|
|
|
373
|
2
|
|
|
|
|
3
|
push @order, $key, $val; |
374
|
2
|
|
|
|
|
3
|
$OPT{$key} = $val; |
375
|
2
|
|
|
|
|
4
|
next; |
376
|
|
|
|
|
|
|
} elsif ($key eq 'source' && blessed $val) { |
377
|
|
|
|
|
|
|
# if it's blessed, assume it returns a string |
378
|
0
|
|
|
|
|
0
|
$val = [$val]; |
379
|
0
|
|
|
|
|
0
|
push @order, $key, $val; |
380
|
0
|
|
|
|
|
0
|
$OPT{$key} = $val; |
381
|
0
|
|
|
|
|
0
|
next; |
382
|
|
|
|
|
|
|
} else { |
383
|
0
|
|
|
|
|
0
|
carp "$pkgname: invalid reference type for $inkey option."; |
384
|
0
|
|
|
|
|
0
|
return; |
385
|
|
|
|
|
|
|
} |
386
|
|
|
|
|
|
|
} elsif ($key eq 'source') { |
387
|
28
|
|
|
|
|
39
|
$val = [$val]; |
388
|
28
|
|
|
|
|
37
|
push @order, $key, $val; |
389
|
28
|
|
|
|
|
41
|
$OPT{$key} = $val; |
390
|
28
|
|
|
|
|
84
|
next; |
391
|
|
|
|
|
|
|
} else { |
392
|
0
|
|
|
|
|
0
|
carp "$pkgname: $inkey value is not a reference."; |
393
|
0
|
|
|
|
|
0
|
return; |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
} |
396
|
32
|
100
|
|
|
|
55
|
if ($key eq 'dest') { |
397
|
28
|
|
|
|
|
35
|
push @order, $key, $val; |
398
|
28
|
|
|
|
|
40
|
$OPT{$key} = $val; |
399
|
28
|
|
|
|
|
60
|
next; |
400
|
|
|
|
|
|
|
} |
401
|
4
|
100
|
|
|
|
12
|
if (exists $self->{code}{$key}) { |
402
|
2
|
50
|
0
|
|
|
12
|
if (ref $val eq 'CODE') { |
|
|
0
|
|
|
|
|
|
403
|
2
|
|
|
|
|
6
|
push @order, $key, $val; |
404
|
2
|
|
|
|
|
4
|
$OPT{$key} = $val; |
405
|
2
|
|
|
|
|
8
|
next; |
406
|
|
|
|
|
|
|
} elsif ($key eq 'infun' and ref $val eq 'ARRAY') { |
407
|
|
|
|
|
|
|
# IPC::Run3 lets us pass an array ref as stdin :) |
408
|
0
|
|
|
|
|
0
|
push @order, $key, $val; |
409
|
0
|
|
|
|
|
0
|
$OPT{$key} = $val; |
410
|
0
|
|
|
|
|
0
|
next; |
411
|
|
|
|
|
|
|
} else { |
412
|
0
|
|
|
|
|
0
|
carp "$pkgname: $inkey option is not a function reference."; |
413
|
0
|
|
|
|
|
0
|
return; |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
|
417
|
2
|
|
|
|
|
412
|
carp "$pkgname: $inkey - unknown option."; |
418
|
2
|
|
|
|
|
10
|
return; |
419
|
|
|
|
|
|
|
} |
420
|
40
|
100
|
|
|
|
84
|
$OPT{_args} = \@order unless $href; |
421
|
40
|
|
|
|
|
170
|
return \%OPT; |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
sub _saveopts { |
425
|
|
|
|
|
|
|
# save the data from the hash passed in the object |
426
|
20
|
|
|
20
|
|
22
|
my $self = shift; |
427
|
20
|
|
|
|
|
24
|
my $pkgname = ref $self; |
428
|
20
|
|
|
|
|
17
|
my $opts = shift; |
429
|
20
|
100
|
|
|
|
85
|
return unless ref $opts eq 'HASH'; |
430
|
18
|
|
|
|
|
84
|
SO: for my $opt (keys %$opts) { |
431
|
60
|
|
|
|
|
53
|
for my $type (qw(flag string counter list code _perlopts)) { |
432
|
220
|
100
|
|
|
|
303
|
if (exists $self->{$type}{$opt}) { |
433
|
34
|
|
|
|
|
34
|
$self->{$type}{$opt} = $opts->{$opt}; |
434
|
34
|
|
|
|
|
45
|
next SO; |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
} |
437
|
26
|
50
|
100
|
|
|
153
|
if ( $opt eq 'source' |
|
|
|
66
|
|
|
|
|
438
|
|
|
|
|
|
|
or $opt eq 'dest' |
439
|
|
|
|
|
|
|
or $opt eq '_args') |
440
|
|
|
|
|
|
|
{ |
441
|
26
|
|
|
|
|
47
|
$self->{$opt} = $opts->{$opt}; |
442
|
|
|
|
|
|
|
} else { |
443
|
0
|
|
|
|
|
0
|
carp "$pkgname: unknown option: $opt."; |
444
|
0
|
|
|
|
|
0
|
return; |
445
|
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
|
} # end SO |
447
|
18
|
|
|
|
|
49
|
return 1; |
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
=head2 File::Rsync::getcmd |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
my $cmd = $obj->getcmd(@options); |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
or |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
my $cmd = $obj->getcmd(\@options); |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
or |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
my ($cmd, $infun, $outfun, $errfun, $debug) = $obj->getcmd(\@options); |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
I returns a reference to an array containing the real rsync command |
463
|
|
|
|
|
|
|
that would be called if the exec function were called. |
464
|
|
|
|
|
|
|
The last example above includes a reference to the optional stdin function, |
465
|
|
|
|
|
|
|
stdout function, stderr function, and the debug setting. |
466
|
|
|
|
|
|
|
This is the form used by the I method to get the extra parameters it |
467
|
|
|
|
|
|
|
needs to do its job. |
468
|
|
|
|
|
|
|
The function is exposed to allow a user-defined exec function to be used, or |
469
|
|
|
|
|
|
|
for debugging purposes. |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
=cut |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
sub getcmd { |
474
|
28
|
|
|
28
|
1
|
116
|
my $self = shift; |
475
|
28
|
|
|
|
|
39
|
my $pkgname = ref $self; |
476
|
28
|
|
|
|
|
25
|
my $merged = $self; |
477
|
28
|
|
|
|
|
39
|
my $list = $self->{_list_mode}; |
478
|
28
|
|
|
|
|
34
|
$self->{_list_mode} = 0; |
479
|
28
|
100
|
|
|
|
60
|
if (@_) { |
480
|
|
|
|
|
|
|
# If args are passed to exec then we have to merge the saved |
481
|
|
|
|
|
|
|
# (default) options with those passed, for any conflicts those passed |
482
|
|
|
|
|
|
|
# directly to exec take precidence |
483
|
22
|
|
|
|
|
38
|
my $execopts = &_parseopts($self, @_); |
484
|
22
|
50
|
|
|
|
54
|
return unless ref $execopts eq 'HASH'; |
485
|
22
|
|
|
|
|
26
|
my %runopts = (); |
486
|
|
|
|
|
|
|
# first copy the default info from $self |
487
|
22
|
|
|
|
|
44
|
for my $type (qw(flag string counter list code _perlopts)) { |
488
|
132
|
|
|
|
|
94
|
for my $opt (keys %{$self->{$type}}) { |
|
132
|
|
|
|
|
524
|
|
489
|
3740
|
|
|
|
|
3884
|
$runopts{$type}{$opt} = $self->{$type}{$opt}; |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
} |
492
|
22
|
|
|
|
|
30
|
for my $opt (qw(source dest)) { |
493
|
44
|
|
|
|
|
62
|
$runopts{$opt} = $self->{$opt}; |
494
|
|
|
|
|
|
|
} |
495
|
22
|
|
|
|
|
30
|
@{$runopts{_args}} = @{$self->{_args}}; |
|
22
|
|
|
|
|
56
|
|
|
22
|
|
|
|
|
30
|
|
496
|
|
|
|
|
|
|
# now allow any args passed directly to exec to override |
497
|
22
|
|
|
|
|
52
|
OPT: for my $opt (keys %$execopts) { |
498
|
66
|
|
|
|
|
68
|
for my $type (qw(flag string counter list code _perlopts)) { |
499
|
396
|
50
|
|
|
|
536
|
if (exists $runopts{$type}{$opt}) { |
500
|
0
|
|
|
|
|
0
|
$runopts{$type}{$opt} = $execopts->{$opt}; |
501
|
0
|
|
|
|
|
0
|
next OPT; |
502
|
|
|
|
|
|
|
} |
503
|
|
|
|
|
|
|
} |
504
|
66
|
100
|
66
|
|
|
206
|
if ($opt eq '_args') { |
|
|
50
|
|
|
|
|
|
505
|
|
|
|
|
|
|
# only preserve order if we already have order |
506
|
20
|
|
|
|
|
20
|
push @{$runopts{$opt}}, @{$execopts->{$opt}} |
|
20
|
|
|
|
|
48
|
|
507
|
22
|
100
|
|
|
|
20
|
if @{$runopts{$opt}}; |
|
22
|
|
|
|
|
44
|
|
508
|
|
|
|
|
|
|
} elsif ($opt eq 'source' or $opt eq 'dest') { |
509
|
44
|
|
|
|
|
68
|
$runopts{$opt} = $execopts->{$opt}; |
510
|
|
|
|
|
|
|
} else { |
511
|
0
|
|
|
|
|
0
|
carp "$pkgname: unknown option: $opt."; |
512
|
0
|
|
|
|
|
0
|
return; |
513
|
|
|
|
|
|
|
} |
514
|
|
|
|
|
|
|
} |
515
|
22
|
|
|
|
|
62
|
$merged = \%runopts; |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
|
518
|
28
|
50
|
66
|
|
|
32
|
if ( |
519
|
28
|
|
|
|
|
78
|
!@{$merged->{_args}} # include and exclude allowed if ordered args |
520
|
2
|
|
|
|
|
8
|
&& ( (@{$merged->{list}{exclude}} != 0) |
521
|
2
|
|
|
|
|
8
|
+ (@{$merged->{list}{include}} != 0) |
522
|
2
|
|
|
|
|
14
|
+ (@{$merged->{list}{filter}} != 0) > 1) |
523
|
|
|
|
|
|
|
) |
524
|
|
|
|
|
|
|
{ |
525
|
0
|
|
|
|
|
0
|
carp "$pkgname: 'exclude' and/or 'include' and/or 'filter' " |
526
|
|
|
|
|
|
|
. "options specified, only one allowed."; |
527
|
0
|
|
|
|
|
0
|
return; |
528
|
|
|
|
|
|
|
} |
529
|
|
|
|
|
|
|
|
530
|
28
|
|
|
|
|
40
|
my $srchost = $merged->{srchost}; |
531
|
28
|
50
|
33
|
|
|
57
|
$srchost .= ':' if $srchost and substr($srchost, 0, 8) ne 'rsync://'; |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
# build the real command |
534
|
28
|
|
|
|
|
50
|
my @cmd = ($merged->{_perlopts}{'path-to-rsync'}); |
535
|
|
|
|
|
|
|
|
536
|
28
|
100
|
|
|
|
16
|
if (@{$merged->{_args}}) { # prefer ordered args if we have them |
|
28
|
|
|
|
|
51
|
|
537
|
26
|
|
|
|
|
23
|
my $gotsrc; |
538
|
26
|
|
|
|
|
30
|
for (my $e = 0; $e < @{$merged->{_args}}; $e += 2) { |
|
128
|
|
|
|
|
203
|
|
539
|
102
|
|
|
|
|
116
|
my $key = $merged->{_args}[$e]; |
540
|
102
|
|
|
|
|
98
|
my $val = $merged->{_args}[ $e + 1 ]; |
541
|
102
|
50
|
|
|
|
390
|
if ($key eq 'literal') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
542
|
0
|
0
|
|
|
|
0
|
push @cmd, ref $val eq 'ARRAY' ? @$val : $val; |
543
|
|
|
|
|
|
|
} elsif (exists $merged->{flag}{$key}) { |
544
|
30
|
50
|
|
|
|
96
|
push @cmd, "--$key" if $val; |
545
|
|
|
|
|
|
|
} elsif (exists $merged->{string}{$key}) { |
546
|
8
|
50
|
|
|
|
32
|
push @cmd, "--$key=$val" if $val; |
547
|
|
|
|
|
|
|
} elsif (exists $merged->{counter}{$key}) { |
548
|
2
|
|
|
|
|
45
|
for (my $i = 0; $i < $val; $i++) { |
549
|
2
|
|
|
|
|
7
|
push @cmd, "--$key"; |
550
|
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
} elsif (exists $merged->{list}{$key}) { |
552
|
2
|
50
|
|
|
|
10
|
push @cmd, ref $val eq 'ARRAY' |
553
|
|
|
|
|
|
|
? map "--$key=$_", @$val |
554
|
|
|
|
|
|
|
: "--$key=$val"; |
555
|
|
|
|
|
|
|
} elsif ($key eq 'source') { |
556
|
26
|
50
|
|
|
|
38
|
if ($merged->{srchost}) { |
557
|
|
|
|
|
|
|
push @cmd, $srchost . join ' ', |
558
|
0
|
0
|
|
|
|
0
|
$merged->{'quote-src'} |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
559
|
|
|
|
|
|
|
? map ("\"$_\"", ref $val eq 'ARRAY' ? @$val : $val) |
560
|
|
|
|
|
|
|
: ref $val eq 'ARRAY' ? @$val |
561
|
|
|
|
|
|
|
: $val; |
562
|
|
|
|
|
|
|
} else { |
563
|
|
|
|
|
|
|
push @cmd, |
564
|
26
|
0
|
|
|
|
72
|
$merged->{'quote-src'} |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
565
|
|
|
|
|
|
|
? map ("\"$_\"", ref $val eq 'ARRAY' ? @$val : $val) |
566
|
|
|
|
|
|
|
: ref $val eq 'ARRAY' ? @$val |
567
|
|
|
|
|
|
|
: $val; |
568
|
|
|
|
|
|
|
} |
569
|
26
|
|
|
|
|
35
|
$gotsrc++; |
570
|
|
|
|
|
|
|
} elsif ($key eq 'dest') { |
571
|
26
|
50
|
|
|
|
64
|
if ($list) { |
|
|
50
|
|
|
|
|
|
572
|
0
|
0
|
|
|
|
0
|
if (not $gotsrc) { |
573
|
0
|
0
|
|
|
|
0
|
if ($merged->{srchost}) { |
574
|
0
|
|
|
|
|
0
|
push @cmd, $srchost; |
575
|
|
|
|
|
|
|
} else { |
576
|
0
|
|
|
|
|
0
|
carp "$pkgname: no 'source' specified."; |
577
|
0
|
|
|
|
|
0
|
return; |
578
|
|
|
|
|
|
|
} |
579
|
|
|
|
|
|
|
} |
580
|
|
|
|
|
|
|
} elsif (not $gotsrc) { |
581
|
0
|
|
|
|
|
0
|
carp |
582
|
|
|
|
|
|
|
"$pkgname: option 'dest' specified without 'source' option."; |
583
|
0
|
|
|
|
|
0
|
return; |
584
|
|
|
|
|
|
|
} else { |
585
|
26
|
50
|
|
|
|
47
|
push @cmd, $merged->{'quote-dst'} ? "\"$val\"" : $val; |
586
|
|
|
|
|
|
|
} |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
} else { |
590
|
|
|
|
|
|
|
# we do a bunch of extra work here to support hash refs, |
591
|
|
|
|
|
|
|
# they don't work well here, no order, we do what we can |
592
|
|
|
|
|
|
|
# put any literal options first |
593
|
2
|
50
|
|
|
|
6
|
push @cmd, @{$merged->{list}{literal}} if @{$merged->{list}{literal}}; |
|
0
|
|
|
|
|
0
|
|
|
2
|
|
|
|
|
14
|
|
594
|
|
|
|
|
|
|
|
595
|
2
|
|
|
|
|
8
|
for my $opt (sort keys %{$merged->{flag}}) { |
|
2
|
|
|
|
|
144
|
|
596
|
212
|
100
|
|
|
|
374
|
push @cmd, "--$opt" if $merged->{flag}{$opt}; |
597
|
|
|
|
|
|
|
} |
598
|
2
|
|
|
|
|
20
|
for my $opt (sort keys %{$merged->{string}}) { |
|
2
|
|
|
|
|
46
|
|
599
|
|
|
|
|
|
|
push @cmd, "--$opt=$merged->{string}{$opt}" |
600
|
78
|
50
|
|
|
|
140
|
if $merged->{string}{$opt}; |
601
|
|
|
|
|
|
|
} |
602
|
2
|
|
|
|
|
8
|
for my $opt (sort keys %{$merged->{counter}}) { |
|
2
|
|
|
|
|
12
|
|
603
|
10
|
|
|
|
|
18
|
for (my $i = 0; $i < $merged->{counter}{$opt}; $i++) { |
604
|
0
|
|
|
|
|
0
|
push @cmd, "--$opt"; |
605
|
|
|
|
|
|
|
} |
606
|
|
|
|
|
|
|
} |
607
|
2
|
|
|
|
|
6
|
for my $opt (sort keys %{$merged->{list}}) { |
|
2
|
|
|
|
|
14
|
|
608
|
24
|
100
|
|
|
|
32
|
next if $opt eq 'literal'; |
609
|
22
|
|
|
|
|
16
|
for my $val (@{$merged->{list}{$opt}}) { |
|
22
|
|
|
|
|
32
|
|
610
|
0
|
|
|
|
|
0
|
push @cmd, "--$opt=$val"; |
611
|
|
|
|
|
|
|
} |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
|
614
|
2
|
50
|
0
|
|
|
10
|
if ($merged->{source}) { |
|
|
0
|
|
|
|
|
|
615
|
2
|
50
|
|
|
|
20
|
if ($merged->{srchost}) { |
616
|
|
|
|
|
|
|
push @cmd, $srchost . join ' ', |
617
|
|
|
|
|
|
|
$merged->{'quote-src'} |
618
|
0
|
|
|
|
|
0
|
? map { "\"$_\"" } @{$merged->{source}} |
|
0
|
|
|
|
|
0
|
|
619
|
0
|
0
|
|
|
|
0
|
: @{$merged->{source}}; |
|
0
|
|
|
|
|
0
|
|
620
|
|
|
|
|
|
|
} else { |
621
|
|
|
|
|
|
|
push @cmd, |
622
|
|
|
|
|
|
|
$merged->{'quote-src'} |
623
|
0
|
|
|
|
|
0
|
? map { "\"$_\"" } @{$merged->{source}} |
|
0
|
|
|
|
|
0
|
|
624
|
2
|
50
|
|
|
|
8
|
: @{$merged->{source}}; |
|
2
|
|
|
|
|
10
|
|
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
} elsif ($merged->{srchost} and $list) { |
627
|
0
|
|
|
|
|
0
|
push @cmd, $srchost; |
628
|
|
|
|
|
|
|
} else { |
629
|
0
|
0
|
|
|
|
0
|
if ($list) { |
|
|
0
|
|
|
|
|
|
630
|
0
|
|
|
|
|
0
|
carp "$pkgname: no 'source' specified."; |
631
|
0
|
|
|
|
|
0
|
return; |
632
|
|
|
|
|
|
|
} elsif ($merged->{dest}) { |
633
|
0
|
|
|
|
|
0
|
carp "$pkgname: option 'dest' specified without 'source' option."; |
634
|
0
|
|
|
|
|
0
|
return; |
635
|
|
|
|
|
|
|
} else { |
636
|
0
|
|
|
|
|
0
|
carp "$pkgname: no source or destination specified."; |
637
|
0
|
|
|
|
|
0
|
return; |
638
|
|
|
|
|
|
|
} |
639
|
|
|
|
|
|
|
} |
640
|
2
|
50
|
|
|
|
8
|
unless ($list) { |
641
|
2
|
50
|
|
|
|
6
|
if ($merged->{dest}) { |
642
|
|
|
|
|
|
|
push @cmd, $merged->{'quote-dst'} |
643
|
|
|
|
|
|
|
? "\"$merged->{dest}\"" |
644
|
2
|
50
|
|
|
|
8
|
: $merged->{dest}; |
645
|
|
|
|
|
|
|
} else { |
646
|
0
|
|
|
|
|
0
|
carp "$pkgname: option 'source' specified without 'dest' option."; |
647
|
0
|
|
|
|
|
0
|
return; |
648
|
|
|
|
|
|
|
} |
649
|
|
|
|
|
|
|
} |
650
|
|
|
|
|
|
|
} |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
return ( |
653
|
|
|
|
|
|
|
wantarray |
654
|
|
|
|
|
|
|
? (\@cmd, $merged->{code}{infun}, |
655
|
|
|
|
|
|
|
$merged->{code}{outfun}, $merged->{code}{errfun}, |
656
|
|
|
|
|
|
|
$merged->{_perlopts}{moddebug} |
657
|
|
|
|
|
|
|
) |
658
|
28
|
100
|
|
|
|
310
|
: \@cmd |
659
|
|
|
|
|
|
|
); |
660
|
|
|
|
|
|
|
} |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
=head2 File::Rsync::exec |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
$obj->exec(@options) or warn "rsync failed\n"; |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
or |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
$obj->exec(\@options) or warn "rsync failed\n"; |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
This is the method that does the real work. |
671
|
|
|
|
|
|
|
Any options passed to this routine are appended to any pre-set options and |
672
|
|
|
|
|
|
|
are not saved. |
673
|
|
|
|
|
|
|
They effect the current execution of I only. |
674
|
|
|
|
|
|
|
In the case of conflicts, the options passed directly to I take |
675
|
|
|
|
|
|
|
precedence. |
676
|
|
|
|
|
|
|
It returns B<1> if the return status was zero (or true), if the I |
677
|
|
|
|
|
|
|
return status was non-zero it returns B<0> and stores the return status. |
678
|
|
|
|
|
|
|
You can examine the return status from I and any output to stdout and |
679
|
|
|
|
|
|
|
stderr with the methods listed below. |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
=cut |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
sub exec { |
684
|
12
|
|
|
12
|
1
|
1818
|
my $self = shift; |
685
|
|
|
|
|
|
|
|
686
|
12
|
|
|
|
|
30
|
my ($cmd, $infun, $outfun, $errfun, $debug) = $self->getcmd(@_); |
687
|
12
|
50
|
|
|
|
30
|
return unless $cmd; |
688
|
12
|
50
|
|
|
|
20
|
warn "exec: @$cmd\n" if $debug; |
689
|
12
|
|
|
|
|
12
|
my $input; |
690
|
12
|
100
|
|
|
|
16
|
if (ref $infun eq 'CODE') { |
691
|
2
|
|
|
|
|
5950
|
my $pid = open my $fh, '-|'; |
692
|
2
|
100
|
|
|
|
104
|
if ($pid) { # parent grabs output |
693
|
1
|
|
|
|
|
289784
|
my @in = <$fh>; |
694
|
1
|
|
|
|
|
47
|
close $fh; |
695
|
1
|
|
|
|
|
7
|
chomp @in; |
696
|
1
|
|
|
|
|
35
|
$input = \@in; |
697
|
|
|
|
|
|
|
} else { # child runs infun |
698
|
1
|
|
|
|
|
16
|
&{$infun}; |
|
1
|
|
|
|
|
41
|
|
699
|
1
|
|
|
|
|
696
|
exit; |
700
|
|
|
|
|
|
|
} |
701
|
|
|
|
|
|
|
} else { |
702
|
10
|
|
|
|
|
12
|
$input = $infun; |
703
|
|
|
|
|
|
|
} |
704
|
11
|
|
|
|
|
71
|
run3($cmd, $input, \my $stdout, \my $stderr); |
705
|
11
|
|
|
|
|
425807
|
$self->{_lastcmd} = $cmd; |
706
|
11
|
|
|
|
|
67
|
$self->{_realstatus} = $?; |
707
|
11
|
50
|
|
|
|
68
|
$self->{_status} = $? & 127 ? $? & 127 : $? >> 8; |
708
|
11
|
50
|
|
|
|
53
|
$self->{_out} = $stdout ? [ split /^/m, $stdout ] : ''; |
709
|
11
|
100
|
|
|
|
66
|
$self->{_err} = $stderr ? [ split /^/m, $stderr ] : ''; |
710
|
11
|
0
|
33
|
|
|
50
|
if ($outfun and $self->{_out}) { |
711
|
0
|
|
|
|
|
0
|
for (@{$self->{_out}}) { $outfun->($_, 'out') } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
712
|
|
|
|
|
|
|
} |
713
|
11
|
0
|
33
|
|
|
39
|
if ($errfun and $self->{_err}) { |
714
|
0
|
|
|
|
|
0
|
for (@{$self->{_err}}) { $errfun->($_, 'err') } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
715
|
|
|
|
|
|
|
} |
716
|
11
|
100
|
|
|
|
127
|
return ($self->{_status} ? 0 : 1); |
717
|
|
|
|
|
|
|
} |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
=head2 File::Rsync::list |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
$out = $obj->list(@options); |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
or |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
$out = $obj->list(\@options); |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
or |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
@out = $obj->list(\@options); |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
This is a wrapper for I called without a destination to get a listing. |
732
|
|
|
|
|
|
|
It returns the output of stdout like the I function below. |
733
|
|
|
|
|
|
|
When no destination is given rsync returns the equivalent of 'ls -l' or |
734
|
|
|
|
|
|
|
'ls -lr' modified by any include/exclude/filter parameters you specify. |
735
|
|
|
|
|
|
|
This is useful for manual comparison without actual changes to the |
736
|
|
|
|
|
|
|
destination or for comparing against another listing taken at a different |
737
|
|
|
|
|
|
|
point in time. |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
(As of rsync version 2.6.4-pre1 this can also be accomplished with the |
740
|
|
|
|
|
|
|
'list-only' option regardless of whether a destination is given.) |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
=cut |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
sub list { |
745
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
746
|
0
|
|
|
|
|
0
|
$self->{_list_mode}++; |
747
|
0
|
|
|
|
|
0
|
$self->exec(@_); |
748
|
0
|
0
|
|
|
|
0
|
if ($self->{_out}) { |
749
|
0
|
0
|
|
|
|
0
|
return (wantarray ? @{$self->{_out}} : $self->{_out}); |
|
0
|
|
|
|
|
0
|
|
750
|
|
|
|
|
|
|
} else { |
751
|
0
|
|
|
|
|
0
|
return; |
752
|
|
|
|
|
|
|
} |
753
|
|
|
|
|
|
|
} |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
=head2 File::Rsync::status |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
$rval = $obj->status; |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
Returns the status from last I call right shifted 8 bits. |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
=cut |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
sub status { |
764
|
6
|
|
|
6
|
1
|
52
|
my $self = shift; |
765
|
6
|
|
|
|
|
16
|
return $self->{_status}; |
766
|
|
|
|
|
|
|
} |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
=head2 File::Rsync::realstatus |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
$rval = $obj->realstatus; |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
Returns the real status from last I call (not right shifted). |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
=cut |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
sub realstatus { |
777
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
778
|
0
|
|
|
|
|
0
|
return $self->{_realstatus}; |
779
|
|
|
|
|
|
|
} |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
=head2 File::Rsync::err |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
$aref = $obj->err; |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
In scalar context this method will return a reference to an array containing |
786
|
|
|
|
|
|
|
all output to stderr from the last I call, or zero (false) if there |
787
|
|
|
|
|
|
|
was no output. |
788
|
|
|
|
|
|
|
In an array context it will return an array of all output to stderr or an |
789
|
|
|
|
|
|
|
empty list. |
790
|
|
|
|
|
|
|
The scalar context can be used to efficiently test for the existance of output. |
791
|
|
|
|
|
|
|
I sends all messages from the remote I process and any error |
792
|
|
|
|
|
|
|
messages to stderr. |
793
|
|
|
|
|
|
|
This method's purpose is to make it easier for you to parse that output for |
794
|
|
|
|
|
|
|
appropriate information. |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
=cut |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
sub err { |
799
|
12
|
|
|
12
|
1
|
76
|
my $self = shift; |
800
|
12
|
100
|
|
|
|
32
|
if ($self->{_err}) { |
801
|
8
|
50
|
|
|
|
132
|
return (wantarray ? @{$self->{_err}} : $self->{_err}); |
|
0
|
|
|
|
|
0
|
|
802
|
|
|
|
|
|
|
} else { |
803
|
4
|
|
|
|
|
40
|
return; |
804
|
|
|
|
|
|
|
} |
805
|
|
|
|
|
|
|
} |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
=head2 File::Rsync::out |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
$aref = $obj->out; |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
Similar to the I method, in a scalar context it returns a reference to an |
812
|
|
|
|
|
|
|
array containing all output to stdout from the last I call, or zero |
813
|
|
|
|
|
|
|
(false) if there was no output. |
814
|
|
|
|
|
|
|
In an array context it returns an array of all output to stdout or an empty |
815
|
|
|
|
|
|
|
list. |
816
|
|
|
|
|
|
|
I sends all informational messages (B option) from the local |
817
|
|
|
|
|
|
|
I process to stdout. |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
=cut |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
sub out { |
822
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
823
|
0
|
0
|
|
|
|
|
if ($self->{_out}) { |
824
|
0
|
0
|
|
|
|
|
return (wantarray ? @{$self->{_out}} : $self->{_out}); |
|
0
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
} else { |
826
|
0
|
|
|
|
|
|
return; |
827
|
|
|
|
|
|
|
} |
828
|
|
|
|
|
|
|
} |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
=head2 File::Rsync::lastcmd |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
$aref = $obj->lastcmd; |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
Returns the actual system command used by the last I call, or '' before |
835
|
|
|
|
|
|
|
any calls to I for the object. |
836
|
|
|
|
|
|
|
This can be useful in the case of an error condition to give a more |
837
|
|
|
|
|
|
|
informative message or for debugging purposes. |
838
|
|
|
|
|
|
|
In an array context it return an array of args as passed to the system, in |
839
|
|
|
|
|
|
|
a scalar context it returns a space-seperated string. |
840
|
|
|
|
|
|
|
See I for access to the command before execution. |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
=cut |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
sub lastcmd { |
845
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
846
|
0
|
0
|
|
|
|
|
if ($self->{_lastcmd}) { |
847
|
0
|
|
|
|
|
|
return wantarray ? @{$self->{_lastcmd}} : join ' ', |
848
|
0
|
0
|
|
|
|
|
@{$self->{_lastcmd}}; |
|
0
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
} else { |
850
|
0
|
|
|
|
|
|
return; |
851
|
|
|
|
|
|
|
} |
852
|
|
|
|
|
|
|
} |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
=head1 Author |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
Lee Eakin Eleakin@dfw.nostrum.comE |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
=head1 Credits |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
The following people have contributed ideas, bug fixes, code or helped out |
861
|
|
|
|
|
|
|
by reporting or tracking down bugs in order to improve this module since |
862
|
|
|
|
|
|
|
it's initial release. |
863
|
|
|
|
|
|
|
See the Changelog for details: |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
Greg Ward |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
Boris Goldowsky |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
James Mello |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
Andreas Koenig |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
Joe Smith |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
Jonathan Pelletier |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
Heiko Jansen |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
Tong Zhu |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
Paul Egan |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
Ronald J Kimball |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
James CE Johnson |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
Bill Uhl |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
Peter teStrake |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
Harald Flaucher |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
Simon Myers |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
Gavin Carr |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
Petya Kohts |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
Neil Hooey |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
Erez Schatz |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
Max Maischein |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
=head1 Inspiration and Assistance |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
Gerard Hickey C |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
Russ Allbery C |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
Graham Barr C |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
Andrew Tridgell and Paul Mackerras rsync(1) |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
John Steele Esteele@nostrum.comE |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
Philip Kizer Epckizer@nostrum.comE |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
Larry Wall perl(1) |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
I borrowed many clues on wrapping an external program from the PGP modules, |
922
|
|
|
|
|
|
|
and I would not have had such a useful tool to wrap except for the great work |
923
|
|
|
|
|
|
|
of the B authors. Thanks also to Graham Barr, the author of the libnet |
924
|
|
|
|
|
|
|
modules and many others, for looking over this code. Of course I must mention |
925
|
|
|
|
|
|
|
the other half of my brain, John Steele, and his good friend Philip Kizer for |
926
|
|
|
|
|
|
|
finding B and bringing it to my attention. And I would not have been |
927
|
|
|
|
|
|
|
able to enjoy writing useful tools if not for the creator of the B |
928
|
|
|
|
|
|
|
language. |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
=head1 Copyrights |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
Copyright (c) 1999-2015 Lee Eakin. All rights reserved. |
933
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify |
935
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
=cut |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
1; |