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