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 14package File::Rsync; 15require 5.008; # it might work with older versions of 5 but not tested 16 17use FileHandle; 18use IPC::Run3 'run3'; 19use Carp 'carp'; 20use Scalar::Util qw(blessed); 21use Data::Dumper; 22 23use strict; 24use vars qw($VERSION); 25 26$VERSION = '0.49'; 27 28=head1 NAME 29 30File::Rsync - perl module interface to rsync(1) F<http://rsync.samba.org/rsync/> 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 48Perl Convenience wrapper for the rsync(1) program. Written for I<rsync-2.3.2> 49and updated for I<rsync-3.1.1> but should perform properly with most recent 50versions. 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 64Create a I<File::Rsync> object. 65Any options passed at creation are stored in the object as defaults for all 66future I<exec> calls on that object. 67Options may be passed in the style of a hash (key/value pairs) and are the 68same as the long options in I<rsync(1)> without the leading double-hyphen. 69Any leading single or double-hyphens are removed, and you may use underscore 70in place of hyphens in option names to simplify quoting and avoid possible 71equation parsing (subtraction). 72 73Although options are key/value pairs, as of version 0.46 the order is now 74preserved. Passing a hash reference is still supported for backwards 75compatibility, but is deprecated as order cannot be preserved for this case. 76 77An additional option of B<path-to-rsync> also exists which can be used to 78override the using PATH environemt variable to find the rsync command binary, 79and B<moddebug> which causes the module methods to print some debugging 80information to STDERR. 81 82There are also 2 options to wrap the source and/or destination paths in 83double-quotes: these are B<quote-src> and B<quote-dst>, which may be useful 84in protecting the paths from shell expansion (particularly useful for paths 85containing spaces). This wraps all source and/or destination paths in 86double-quotes to limit remote shell expansion. It is similar but not 87necessarily the same result as the B<protect-args> option in rsync itself. 88 89The B<outfun> and B<errfun> options take a function reference, called once 90for each line of output from the I<rsync> program with the output line passed 91in as the first argument, the second arg is either 'out' or 'err' depending 92on the source. 93This makes it possible to use the same function for both and still determine 94where the output came from. 95 96If options are passed as a hash reference (deprecated), the B<exclude> 97needs an array reference as it's value since there cannot be duplicate keys 98in a hash. Since order cannot be preserved in a hash, this module currently 99limits the use of B<exclude> or B<include> together. 100They can be mixed together if options are in the form of a list or array ref. 101 102Use the '+ ' or '- ' prefix trick to put includes in an B<exclude> array, or 103to put excludes in an B<include> array (see I<rsync(1)> for details). 104 105Include/exclude options form an ordered list. 106The order must be retained for proper execution. 107There are also B<source> and B<dest> keys. 108The key B<src> is also accepted as an equivalent to B<source>, and B<dst> or 109B<destination> may be used as equivalents to B<dest>. 110The B<source> option may take a scalar or an array reference. 111If the source is the local system then multiple B<source> paths are allowed. 112In this case an array reference should be used. 113There is also a method for passing multiple source paths to a remote system. 114This method may be triggered in this module by passing the remote hostname to 115the B<srchost> key and passing an array reference to the B<source> key. 116If the source host is being accessed via an Rsync server, the remote hostname 117should have a single trailing colon on the name. 118When rsync is called, the B<srchost> value and the values in the B<source> 119array will be joined with a colon resulting in the double-colon required for 120server access. 121The B<dest> key only takes a scalar since I<rsync> only accepts a single 122destination path. 123 124Version 2.6.0 of I<rsync(1)> provides a new B<files-from> option along with 125a few other supporting options (B<from0>, B<no-relative>, and 126B<no-implied-dirs>). 127To support this wonderful new option at the level it deserves, this module 128now has an additional parameter. 129As of version 0.46 the value of B<files-from> may be an array reference. 130The contents of the array are passed to B<files-from> the same as the 131below method using B<infun> but implemented inside the module. 132 133If B<files-from> is set to '-' (meaning read from stdin) you can define 134B<infun> to be a reference to a function that prints your file list to the 135default file handle. 136The output from the function is attached to stdin of the rsync call during 137exec. 138If B<infun> is defined it will be called regardless of the value of 139B<files-from>, so it can provide any data expected on stdin, but keep in mind 140that stdin will not be attached to a tty so it is not very useful for sending 141passwords (see the I<rsync(1)> and I<ssh(1)> man pages for ways to handle 142authentication). 143The I<rsync(1)> man page has a more complete description of B<files-from>. 144Also see L<File::Find> for ideas to use with B<files-from> and B<infun>. 145 146The B<infun> option may also be used with the B<include-from> or 147B<exclude-from> options, but this is generally more clumsy than using the 148B<include> or B<exclude> arrays. 149 150Version 2.6.3 of I<rsync(1)> provides new options B<partial-dir>, 151B<checksum-seed>, B<keep-dirlinks>, B<inplace>, B<ipv4>, and B<ipv6>. 152Version 2.6.4 of I<rsync(1)> provides new options B<del>, B<delete-before> 153B<delete-during>, B<delay-updates>, B<dirs>, B<filter>, B<fuzzy>, 154B<itemize-changes>, B<list-only>, B<omit-dir-times>, B<remove-sent-files>, 155B<max-size>, and B<protocol>. 156 157Version 0.38 of this module also added support for the B<acls> option that 158is not part of I<rsync(1)> unless the patch has been applied, but people do 159use it. 160It also includes a new B<literal> option that takes an array reference 161similar to B<include>, B<exclude>, and B<filter>. 162Any arguments in the array are passed as literal arguments to rsync, and are 163passed first. 164They should have the proper single or double hyphen prefixes and the elements 165should be split up the way you want them passed to exec. 166The purpose of this option is to allow the use of arbitrary options added by 167patches, and/or to allow the use of new options in rsync without needing an 168imediate update to the module in addtition to I<rsync(1)> itself. 169 170=cut 171 172sub new { 173 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 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 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 map { $_ => 0 } 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 bless $self, $class; # bless it first so defopts can find out the class 272 if (@_) { 273 &defopts($self, @_) or return; 274 } 275 return $self; 276} 277 278=head2 File::Rsync::defopts 279 280 $obj->defopts(@options); 281 282 or 283 284 $obj->defopts(\@options); 285 286Set default options for future exec calls for the object. 287See I<rsync(1)> for a complete list of valid options. 288This is really the internal method that I<new> calls but you can use it too. 289The B<verbose> and B<quiet> options to rsync are actually counters. 290When assigning the perl hash-style options you may specify the counter value 291directly and the module will pass the proper number of options to rsync. 292 293=cut 294 295sub 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 my $self = shift; 299 &_saveopts($self, &_parseopts($self, @_)); 300} 301 302sub _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 my $self = shift; 306 my $pkgname = ref $self; 307 my $href; 308 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 if (@_ == 1) { 312 if (my $reftype = ref $_[0]) { 313 if ($reftype eq 'HASH') { 314 carp "$pkgname: hash reference is deprecated, use array or list." 315 if $^W; 316 @_ = %{$_[0]}; 317 $href++; 318 } elsif ($reftype eq 'ARRAY') { 319 @_ = @{$_[0]}; 320 } else { 321 carp "$pkgname: invalid reference type ($reftype) option."; 322 return; 323 } 324 } else { 325 carp "$pkgname: invalid option ($_[0])."; 326 return; 327 } 328 } 329 if (@_ % 2) { 330 carp 331 "$pkgname: invalid number of options passed (must be key/value pairs)."; 332 return; 333 } 334 335 # now process the options given, we handle debug first 336 for (my $i = 0; $i < @_; $i += 2) { 337 if ($_[$i] eq 'moddebug') { 338 $OPT{moddebug} = $_[ $i + 1 ]; 339 warn "setting debug flag\n" if $OPT{moddebug}; 340 last; 341 } 342 } 343 344 my @order; 345 while (my ($inkey, $val) = splice @_, 0, 2) { 346 (my $key = $inkey) =~ tr/_/-/; 347 $key =~ s/^--?//; # remove any leading hyphens if found 348 $key = 'source' if $key eq 'src'; 349 $key = 'dest' if $key eq 'dst' or $key eq 'destination'; 350 next if $key eq 'moddebug'; # we did this one already 351 warn "processing option: $inkey\n" 352 if $OPT{moddebug} 353 or $self->{_perlopts}{moddebug}; 354 if ( exists $self->{flag}{$key} 355 or exists $self->{string}{$key} 356 or exists $self->{counter}{$key} 357 or exists $self->{_perlopts}{$key}) 358 { 359 if ($key eq 'files-from' and ref $val eq 'ARRAY') { 360 push @order, $key, '-', 'infun', $val; # --files-from=- <\@ 361 $OPT{$key} = '-'; 362 $OPT{infun} = $val; 363 364 } else { 365 push @order, $key, $val; 366 $OPT{$key} = $val; 367 } 368 next; 369 } 370 if (exists $self->{list}{$key} or $key eq 'source') { 371 if (my $reftype = ref $val) { 372 if ($reftype eq 'ARRAY') { 373 push @order, $key, $val; 374 $OPT{$key} = $val; 375 next; 376 } elsif ($key eq 'source' && blessed $val) { 377 # if it's blessed, assume it returns a string 378 $val = [$val]; 379 push @order, $key, $val; 380 $OPT{$key} = $val; 381 next; 382 } else { 383 carp "$pkgname: invalid reference type for $inkey option."; 384 return; 385 } 386 } elsif ($key eq 'source') { 387 $val = [$val]; 388 push @order, $key, $val; 389 $OPT{$key} = $val; 390 next; 391 } else { 392 carp "$pkgname: $inkey value is not a reference."; 393 return; 394 } 395 } 396 if ($key eq 'dest') { 397 push @order, $key, $val; 398 $OPT{$key} = $val; 399 next; 400 } 401 if (exists $self->{code}{$key}) { 402 if (ref $val eq 'CODE') { 403 push @order, $key, $val; 404 $OPT{$key} = $val; 405 next; 406 } elsif ($key eq 'infun' and ref $val eq 'ARRAY') { 407 # IPC::Run3 lets us pass an array ref as stdin :) 408 push @order, $key, $val; 409 $OPT{$key} = $val; 410 next; 411 } else { 412 carp "$pkgname: $inkey option is not a function reference."; 413 return; 414 } 415 } 416 417 carp "$pkgname: $inkey - unknown option."; 418 return; 419 } 420 $OPT{_args} = \@order unless $href; 421 return \%OPT; 422} 423 424sub _saveopts { 425 # save the data from the hash passed in the object 426 my $self = shift; 427 my $pkgname = ref $self; 428 my $opts = shift; 429 return unless ref $opts eq 'HASH'; 430SO: for my $opt (keys %$opts) { 431 for my $type (qw(flag string counter list code _perlopts)) { 432 if (exists $self->{$type}{$opt}) { 433 $self->{$type}{$opt} = $opts->{$opt}; 434 next SO; 435 } 436 } 437 if ( $opt eq 'source' 438 or $opt eq 'dest' 439 or $opt eq '_args') 440 { 441 $self->{$opt} = $opts->{$opt}; 442 } else { 443 carp "$pkgname: unknown option: $opt."; 444 return; 445 } 446 } # end SO 447 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 462I<getcmd> returns a reference to an array containing the real rsync command 463that would be called if the exec function were called. 464The last example above includes a reference to the optional stdin function, 465stdout function, stderr function, and the debug setting. 466This is the form used by the I<exec> method to get the extra parameters it 467needs to do its job. 468The function is exposed to allow a user-defined exec function to be used, or 469for debugging purposes. 470 471=cut 472 473sub getcmd { 474 my $self = shift; 475 my $pkgname = ref $self; 476 my $merged = $self; 477 my $list = $self->{_list_mode}; 478 $self->{_list_mode} = 0; 479 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 my $execopts = &_parseopts($self, @_); 484 return unless ref $execopts eq 'HASH'; 485 my %runopts = (); 486 # first copy the default info from $self 487 for my $type (qw(flag string counter list code _perlopts)) { 488 for my $opt (keys %{$self->{$type}}) { 489 $runopts{$type}{$opt} = $self->{$type}{$opt}; 490 } 491 } 492 for my $opt (qw(source dest)) { 493 $runopts{$opt} = $self->{$opt}; 494 } 495 @{$runopts{_args}} = @{$self->{_args}}; 496 # now allow any args passed directly to exec to override 497 OPT: for my $opt (keys %$execopts) { 498 for my $type (qw(flag string counter list code _perlopts)) { 499 if (exists $runopts{$type}{$opt}) { 500 $runopts{$type}{$opt} = $execopts->{$opt}; 501 next OPT; 502 } 503 } 504 if ($opt eq '_args') { 505 # only preserve order if we already have order 506 push @{$runopts{$opt}}, @{$execopts->{$opt}} 507 if @{$runopts{$opt}}; 508 } elsif ($opt eq 'source' or $opt eq 'dest') { 509 $runopts{$opt} = $execopts->{$opt}; 510 } else { 511 carp "$pkgname: unknown option: $opt."; 512 return; 513 } 514 } 515 $merged = \%runopts; 516 } 517 518 if ( 519 !@{$merged->{_args}} # include and exclude allowed if ordered args 520 && ( (@{$merged->{list}{exclude}} != 0) 521 + (@{$merged->{list}{include}} != 0) 522 + (@{$merged->{list}{filter}} != 0) > 1) 523 ) 524 { 525 carp "$pkgname: 'exclude' and/or 'include' and/or 'filter' " 526 . "options specified, only one allowed."; 527 return; 528 } 529 530 my $srchost = $merged->{srchost}; 531 $srchost .= ':' if $srchost and substr($srchost, 0, 8) ne 'rsync://'; 532 533 # build the real command 534 my @cmd = ($merged->{_perlopts}{'path-to-rsync'}); 535 536 if (@{$merged->{_args}}) { # prefer ordered args if we have them 537 my $gotsrc; 538 for (my $e = 0; $e < @{$merged->{_args}}; $e += 2) { 539 my $key = $merged->{_args}[$e]; 540 my $val = $merged->{_args}[ $e + 1 ]; 541 if ($key eq 'literal') { 542 push @cmd, ref $val eq 'ARRAY' ? @$val : $val; 543 } elsif (exists $merged->{flag}{$key}) { 544 push @cmd, "--$key" if $val; 545 } elsif (exists $merged->{string}{$key}) { 546 push @cmd, "--$key=$val" if $val; 547 } elsif (exists $merged->{counter}{$key}) { 548 for (my $i = 0; $i < $val; $i++) { 549 push @cmd, "--$key"; 550 } 551 } elsif (exists $merged->{list}{$key}) { 552 push @cmd, ref $val eq 'ARRAY' 553 ? map "--$key=$_", @$val 554 : "--$key=$val"; 555 } elsif ($key eq 'source') { 556 if ($merged->{srchost}) { 557 push @cmd, $srchost . join ' ', 558 $merged->{'quote-src'} 559 ? map ("\"$_\"", ref $val eq 'ARRAY' ? @$val : $val) 560 : ref $val eq 'ARRAY' ? @$val 561 : $val; 562 } else { 563 push @cmd, 564 $merged->{'quote-src'} 565 ? map ("\"$_\"", ref $val eq 'ARRAY' ? @$val : $val) 566 : ref $val eq 'ARRAY' ? @$val 567 : $val; 568 } 569 $gotsrc++; 570 } elsif ($key eq 'dest') { 571 if ($list) { 572 if (not $gotsrc) { 573 if ($merged->{srchost}) { 574 push @cmd, $srchost; 575 } else { 576 carp "$pkgname: no 'source' specified."; 577 return; 578 } 579 } 580 } elsif (not $gotsrc) { 581 carp 582 "$pkgname: option 'dest' specified without 'source' option."; 583 return; 584 } else { 585 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 push @cmd, @{$merged->{list}{literal}} if @{$merged->{list}{literal}}; 594 595 for my $opt (sort keys %{$merged->{flag}}) { 596 push @cmd, "--$opt" if $merged->{flag}{$opt}; 597 } 598 for my $opt (sort keys %{$merged->{string}}) { 599 push @cmd, "--$opt=$merged->{string}{$opt}" 600 if $merged->{string}{$opt}; 601 } 602 for my $opt (sort keys %{$merged->{counter}}) { 603 for (my $i = 0; $i < $merged->{counter}{$opt}; $i++) { 604 push @cmd, "--$opt"; 605 } 606 } 607 for my $opt (sort keys %{$merged->{list}}) { 608 next if $opt eq 'literal'; 609 for my $val (@{$merged->{list}{$opt}}) { 610 push @cmd, "--$opt=$val"; 611 } 612 } 613 614 if ($merged->{source}) { 615 if ($merged->{srchost}) { 616 push @cmd, $srchost . join ' ', 617 $merged->{'quote-src'} 618 ? map { "\"$_\"" } @{$merged->{source}} 619 : @{$merged->{source}}; 620 } else { 621 push @cmd, 622 $merged->{'quote-src'} 623 ? map { "\"$_\"" } @{$merged->{source}} 624 : @{$merged->{source}}; 625 } 626 } elsif ($merged->{srchost} and $list) { 627 push @cmd, $srchost; 628 } else { 629 if ($list) { 630 carp "$pkgname: no 'source' specified."; 631 return; 632 } elsif ($merged->{dest}) { 633 carp "$pkgname: option 'dest' specified without 'source' option."; 634 return; 635 } else { 636 carp "$pkgname: no source or destination specified."; 637 return; 638 } 639 } 640 unless ($list) { 641 if ($merged->{dest}) { 642 push @cmd, $merged->{'quote-dst'} 643 ? "\"$merged->{dest}\"" 644 : $merged->{dest}; 645 } else { 646 carp "$pkgname: option 'source' specified without 'dest' option."; 647 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 : \@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 670This is the method that does the real work. 671Any options passed to this routine are appended to any pre-set options and 672are not saved. 673They effect the current execution of I<rsync> only. 674In the case of conflicts, the options passed directly to I<exec> take 675precedence. 676It returns B<1> if the return status was zero (or true), if the I<rsync> 677return status was non-zero it returns B<0> and stores the return status. 678You can examine the return status from I<rsync> and any output to stdout and 679stderr with the methods listed below. 680 681=cut 682 683sub exec { 684 my $self = shift; 685 686 my ($cmd, $infun, $outfun, $errfun, $debug) = $self->getcmd(@_); 687 return unless $cmd; 688 warn "exec: @$cmd\n" if $debug; 689 my $input; 690 if (ref $infun eq 'CODE') { 691 my $pid = open my $fh, '-|'; 692 if ($pid) { # parent grabs output 693 my @in = <$fh>; 694 close $fh; 695 chomp @in; 696 $input = \@in; 697 } else { # child runs infun 698 &{$infun}; 699 exit; 700 } 701 } else { 702 $input = $infun; 703 } 704 run3($cmd, $input, \my $stdout, \my $stderr); 705 $self->{_lastcmd} = $cmd; 706 $self->{_realstatus} = $?; 707 $self->{_status} = $? & 127 ? $? & 127 : $? >> 8; 708 $self->{_out} = $stdout ? [ split /^/m, $stdout ] : ''; 709 $self->{_err} = $stderr ? [ split /^/m, $stderr ] : ''; 710 if ($outfun and $self->{_out}) { 711 for (@{$self->{_out}}) { $outfun->($_, 'out') } 712 } 713 if ($errfun and $self->{_err}) { 714 for (@{$self->{_err}}) { $errfun->($_, 'err') } 715 } 716 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 731This is a wrapper for I<exec> called without a destination to get a listing. 732It returns the output of stdout like the I<out> function below. 733When no destination is given rsync returns the equivalent of 'ls -l' or 734'ls -lr' modified by any include/exclude/filter parameters you specify. 735This is useful for manual comparison without actual changes to the 736destination or for comparing against another listing taken at a different 737point 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 744sub list { 745 my $self = shift; 746 $self->{_list_mode}++; 747 $self->exec(@_); 748 if ($self->{_out}) { 749 return (wantarray ? @{$self->{_out}} : $self->{_out}); 750 } else { 751 return; 752 } 753} 754 755=head2 File::Rsync::status 756 757 $rval = $obj->status; 758 759Returns the status from last I<exec> call right shifted 8 bits. 760 761=cut 762 763sub status { 764 my $self = shift; 765 return $self->{_status}; 766} 767 768=head2 File::Rsync::realstatus 769 770 $rval = $obj->realstatus; 771 772Returns the real status from last I<exec> call (not right shifted). 773 774=cut 775 776sub realstatus { 777 my $self = shift; 778 return $self->{_realstatus}; 779} 780 781=head2 File::Rsync::err 782 783 $aref = $obj->err; 784 785In scalar context this method will return a reference to an array containing 786all output to stderr from the last I<exec> call, or zero (false) if there 787was no output. 788In an array context it will return an array of all output to stderr or an 789empty list. 790The scalar context can be used to efficiently test for the existance of output. 791I<rsync> sends all messages from the remote I<rsync> process and any error 792messages to stderr. 793This method's purpose is to make it easier for you to parse that output for 794appropriate information. 795 796=cut 797 798sub err { 799 my $self = shift; 800 if ($self->{_err}) { 801 return (wantarray ? @{$self->{_err}} : $self->{_err}); 802 } else { 803 return; 804 } 805} 806 807=head2 File::Rsync::out 808 809 $aref = $obj->out; 810 811Similar to the I<err> method, in a scalar context it returns a reference to an 812array containing all output to stdout from the last I<exec> call, or zero 813(false) if there was no output. 814In an array context it returns an array of all output to stdout or an empty 815list. 816I<rsync> sends all informational messages (B<verbose> option) from the local 817I<rsync> process to stdout. 818 819=cut 820 821sub out { 822 my $self = shift; 823 if ($self->{_out}) { 824 return (wantarray ? @{$self->{_out}} : $self->{_out}); 825 } else { 826 return; 827 } 828} 829 830=head2 File::Rsync::lastcmd 831 832 $aref = $obj->lastcmd; 833 834Returns the actual system command used by the last I<exec> call, or '' before 835any calls to I<exec> for the object. 836This can be useful in the case of an error condition to give a more 837informative message or for debugging purposes. 838In an array context it return an array of args as passed to the system, in 839a scalar context it returns a space-seperated string. 840See I<getcmd> for access to the command before execution. 841 842=cut 843 844sub lastcmd { 845 my $self = shift; 846 if ($self->{_lastcmd}) { 847 return wantarray ? @{$self->{_lastcmd}} : join ' ', 848 @{$self->{_lastcmd}}; 849 } else { 850 return; 851 } 852} 853 854=head1 Author 855 856Lee Eakin E<lt>leakin@dfw.nostrum.comE<gt> 857 858=head1 Credits 859 860The following people have contributed ideas, bug fixes, code or helped out 861by reporting or tracking down bugs in order to improve this module since 862it's initial release. 863See the Changelog for details: 864 865Greg Ward 866 867Boris Goldowsky 868 869James Mello 870 871Andreas Koenig 872 873Joe Smith 874 875Jonathan Pelletier 876 877Heiko Jansen 878 879Tong Zhu 880 881Paul Egan 882 883Ronald J Kimball 884 885James CE Johnson 886 887Bill Uhl 888 889Peter teStrake 890 891Harald Flaucher 892 893Simon Myers 894 895Gavin Carr 896 897Petya Kohts 898 899Neil Hooey 900 901Erez Schatz 902 903Max Maischein 904 905=head1 Inspiration and Assistance 906 907Gerard Hickey C<PGP::Pipe> 908 909Russ Allbery C<PGP::Sign> 910 911Graham Barr C<Net::*> 912 913Andrew Tridgell and Paul Mackerras rsync(1) 914 915John Steele E<lt>steele@nostrum.comE<gt> 916 917Philip Kizer E<lt>pckizer@nostrum.comE<gt> 918 919Larry Wall perl(1) 920 921I borrowed many clues on wrapping an external program from the PGP modules, 922and I would not have had such a useful tool to wrap except for the great work 923of the B<rsync> authors. Thanks also to Graham Barr, the author of the libnet 924modules and many others, for looking over this code. Of course I must mention 925the other half of my brain, John Steele, and his good friend Philip Kizer for 926finding B<rsync> and bringing it to my attention. And I would not have been 927able to enjoy writing useful tools if not for the creator of the B<perl> 928language. 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 9391; 940