| 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 | 1 |  |  | 1 |  | 8420 | use FileHandle; | 
|  | 1 |  |  |  |  | 13107 |  | 
|  | 1 |  |  |  |  | 7 |  | 
| 18 | 1 |  |  | 1 |  | 1402 | use IPC::Run3 'run3'; | 
|  | 1 |  |  |  |  | 51017 |  | 
|  | 1 |  |  |  |  | 58 |  | 
| 19 | 1 |  |  | 1 |  | 7 | use Carp 'carp'; | 
|  | 1 |  |  |  |  | 6 |  | 
|  | 1 |  |  |  |  | 39 |  | 
| 20 | 1 |  |  | 1 |  | 7 | use Scalar::Util qw(blessed); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 38 |  | 
| 21 | 1 |  |  | 1 |  | 4373 | use Data::Dumper; | 
|  | 1 |  |  |  |  | 9285 |  | 
|  | 1 |  |  |  |  | 118 |  | 
| 22 |  |  |  |  |  |  |  | 
| 23 | 1 |  |  | 1 |  | 8 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 32 |  | 
| 24 | 1 |  |  | 1 |  | 6 | use vars qw($VERSION); | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 4420 |  | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | $VERSION = '0.47'; | 
| 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 and B keys. | 
| 108 |  |  |  |  |  |  | The key B is also accepted as an equivalent to B, and B or | 
| 109 |  |  |  |  |  |  | B may be used as equivalents to B. | 
| 110 |  |  |  |  |  |  | The B option may take a scalar or an array reference. | 
| 111 |  |  |  |  |  |  | If the source is the local system then multiple B paths are allowed. | 
| 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 key. | 
| 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 | 11 |  |  | 11 | 1 | 166063 | 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 | 1166 |  |  |  |  | 4409 | 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 | 429 |  |  |  |  | 1420 | 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 | 11 |  |  |  |  | 128 | map { $_ => 0 } | 
|  | 55 |  |  |  |  | 654 |  | 
| 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 | 11 |  |  |  |  | 234 | bless $self, $class;    # bless it first so defopts can find out the class | 
| 272 | 11 | 50 |  |  |  | 59 | if (@_) { | 
| 273 | 11 | 100 |  |  |  | 83 | &defopts($self, @_) or return; | 
| 274 |  |  |  |  |  |  | } | 
| 275 | 10 |  |  |  |  | 60 | 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 | 11 |  |  | 11 | 1 | 28 | my $self = shift; | 
| 299 | 11 |  |  |  |  | 49 | &_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 | 22 |  |  | 22 |  | 49 | my $self    = shift; | 
| 306 | 22 |  |  |  |  | 71 | my $pkgname = ref $self; | 
| 307 | 22 |  |  |  |  | 35 | my $href; | 
| 308 | 22 |  |  |  |  | 59 | 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 | 22 | 100 |  |  |  | 77 | if (@_ == 1) { | 
| 312 | 2 | 50 |  |  |  | 16 | if (my $reftype = ref $_[0]) { | 
| 313 | 2 | 50 |  |  |  | 12 | if ($reftype eq 'HASH') { | 
|  |  | 0 |  |  |  |  |  | 
| 314 | 2 | 50 |  |  |  | 557 | carp "$pkgname: hash reference is deprecated, use array or list." | 
| 315 |  |  |  |  |  |  | if $^W; | 
| 316 | 2 |  |  |  |  | 182 | @_ = %{$_[0]}; | 
|  | 2 |  |  |  |  | 19 |  | 
| 317 | 2 |  |  |  |  | 11 | $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 | 22 | 50 |  |  |  | 116 | 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 | 22 |  |  |  |  | 97 | for (my $i = 0; $i < @_; $i += 2) { | 
| 337 | 53 | 50 |  |  |  | 284 | 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 | 22 |  |  |  |  | 39 | my @order; | 
| 345 | 22 |  |  |  |  | 125 | while (my ($inkey, $val) = splice @_, 0, 2) { | 
| 346 | 53 |  |  |  |  | 151 | (my $key = $inkey) =~ tr/_/-/; | 
| 347 | 53 |  |  |  |  | 126 | $key =~ s/^--?//;    # remove any leading hyphens if found | 
| 348 | 53 | 100 |  |  |  | 156 | $key = 'source' if $key eq 'src'; | 
| 349 | 53 | 50 | 33 |  |  | 376 | $key = 'dest' if $key eq 'dst' or $key eq 'destination'; | 
| 350 | 53 | 50 |  |  |  | 145 | next if $key eq 'moddebug';    # we did this one already | 
| 351 |  |  |  |  |  |  | warn "processing option: $inkey\n" | 
| 352 |  |  |  |  |  |  | if $OPT{moddebug} | 
| 353 | 53 | 50 | 33 |  |  | 329 | or $self->{_perlopts}{moddebug}; | 
| 354 | 53 | 100 | 66 |  |  | 556 | 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 | 19 | 100 | 100 |  |  | 109 | if ($key eq 'files-from' and ref $val eq 'ARRAY') { | 
| 360 | 1 |  |  |  |  | 12 | push @order, $key, '-', 'infun', $val;    # --files-from=- <\@ | 
| 361 | 1 |  |  |  |  | 5 | $OPT{$key} = '-'; | 
| 362 | 1 |  |  |  |  | 5 | $OPT{infun} = $val; | 
| 363 |  |  |  |  |  |  |  | 
| 364 |  |  |  |  |  |  | } else { | 
| 365 | 18 |  |  |  |  | 58 | push @order, $key, $val; | 
| 366 | 18 |  |  |  |  | 67 | $OPT{$key} = $val; | 
| 367 |  |  |  |  |  |  | } | 
| 368 | 19 |  |  |  |  | 110 | next; | 
| 369 |  |  |  |  |  |  | } | 
| 370 | 34 | 100 | 100 |  |  | 238 | if (exists $self->{list}{$key} or $key eq 'source') { | 
| 371 | 17 | 100 |  |  |  | 97 | if (my $reftype = ref $val) { | 
|  |  | 50 |  |  |  |  |  | 
| 372 | 2 | 50 | 0 |  |  | 9 | if ($reftype eq 'ARRAY') { | 
|  |  | 0 |  |  |  |  |  | 
| 373 | 2 |  |  |  |  | 8 | push @order, $key, $val; | 
| 374 | 2 |  |  |  |  | 7 | $OPT{$key} = $val; | 
| 375 | 2 |  |  |  |  | 12 | 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 | 15 |  |  |  |  | 45 | $val = [$val]; | 
| 388 | 15 |  |  |  |  | 45 | push @order, $key, $val; | 
| 389 | 15 |  |  |  |  | 42 | $OPT{$key} = $val; | 
| 390 | 15 |  |  |  |  | 106 | next; | 
| 391 |  |  |  |  |  |  | } else { | 
| 392 | 0 |  |  |  |  | 0 | carp "$pkgname: $inkey value is not a reference."; | 
| 393 | 0 |  |  |  |  | 0 | return; | 
| 394 |  |  |  |  |  |  | } | 
| 395 |  |  |  |  |  |  | } | 
| 396 | 17 | 100 |  |  |  | 54 | if ($key eq 'dest') { | 
| 397 | 15 |  |  |  |  | 41 | push @order, $key, $val; | 
| 398 | 15 |  |  |  |  | 34 | $OPT{$key} = $val; | 
| 399 | 15 |  |  |  |  | 74 | next; | 
| 400 |  |  |  |  |  |  | } | 
| 401 | 2 | 100 |  |  |  | 25 | if (exists $self->{code}{$key}) { | 
| 402 | 1 | 50 | 0 |  |  | 14 | if (ref $val eq 'CODE') { | 
|  |  | 0 |  |  |  |  |  | 
| 403 | 1 |  |  |  |  | 72 | push @order, $key, $val; | 
| 404 | 1 |  |  |  |  | 5 | $OPT{$key} = $val; | 
| 405 | 1 |  |  |  |  | 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 | 1 |  |  |  |  | 349 | carp "$pkgname: $inkey - unknown option."; | 
| 418 | 1 |  |  |  |  | 8 | return; | 
| 419 |  |  |  |  |  |  | } | 
| 420 | 21 | 100 |  |  |  | 80 | $OPT{_args} = \@order unless $href; | 
| 421 | 21 |  |  |  |  | 124 | return \%OPT; | 
| 422 |  |  |  |  |  |  | } | 
| 423 |  |  |  |  |  |  |  | 
| 424 |  |  |  |  |  |  | sub _saveopts { | 
| 425 |  |  |  |  |  |  | # save the data from the hash passed in the object | 
| 426 | 11 |  |  | 11 |  | 27 | my $self    = shift; | 
| 427 | 11 |  |  |  |  | 25 | my $pkgname = ref $self; | 
| 428 | 11 |  |  |  |  | 21 | my $opts    = shift; | 
| 429 | 11 | 100 |  |  |  | 103 | return unless ref $opts eq 'HASH'; | 
| 430 | 10 |  |  |  |  | 74 | SO: for my $opt (keys %$opts) { | 
| 431 | 38 |  |  |  |  | 94 | for my $type (qw(flag string counter list code _perlopts)) { | 
| 432 | 138 | 100 |  |  |  | 517 | if (exists $self->{$type}{$opt}) { | 
| 433 | 22 |  |  |  |  | 96 | $self->{$type}{$opt} = $opts->{$opt}; | 
| 434 | 22 |  |  |  |  | 93 | next SO; | 
| 435 |  |  |  |  |  |  | } | 
| 436 |  |  |  |  |  |  | } | 
| 437 | 16 | 50 | 100 |  |  | 206 | if (  $opt eq 'source' | 
|  |  |  | 66 |  |  |  |  | 
| 438 |  |  |  |  |  |  | or $opt eq 'dest' | 
| 439 |  |  |  |  |  |  | or $opt eq '_args') | 
| 440 |  |  |  |  |  |  | { | 
| 441 | 16 |  |  |  |  | 66 | $self->{$opt} = $opts->{$opt}; | 
| 442 |  |  |  |  |  |  | } else { | 
| 443 | 0 |  |  |  |  | 0 | carp "$pkgname: unknown option: $opt."; | 
| 444 | 0 |  |  |  |  | 0 | return; | 
| 445 |  |  |  |  |  |  | } | 
| 446 |  |  |  |  |  |  | }    # end SO | 
| 447 | 10 |  |  |  |  | 61 | 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 | 15 |  |  | 15 | 1 | 122 | my $self    = shift; | 
| 475 | 15 |  |  |  |  | 35 | my $pkgname = ref $self; | 
| 476 | 15 |  |  |  |  | 28 | my $merged  = $self; | 
| 477 | 15 |  |  |  |  | 38 | my $list    = $self->{_list_mode}; | 
| 478 | 15 |  |  |  |  | 34 | $self->{_list_mode} = 0; | 
| 479 | 15 | 100 |  |  |  | 51 | 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 | 11 |  |  |  |  | 32 | my $execopts = &_parseopts($self, @_); | 
| 484 | 11 | 50 |  |  |  | 44 | return unless ref $execopts eq 'HASH'; | 
| 485 | 11 |  |  |  |  | 29 | my %runopts = (); | 
| 486 |  |  |  |  |  |  | # first copy the default info from $self | 
| 487 | 11 |  |  |  |  | 53 | for my $type (qw(flag string counter list code _perlopts)) { | 
| 488 | 66 |  |  |  |  | 93 | for my $opt (keys %{$self->{$type}}) { | 
|  | 66 |  |  |  |  | 792 |  | 
| 489 | 1870 |  |  |  |  | 5004 | $runopts{$type}{$opt} = $self->{$type}{$opt}; | 
| 490 |  |  |  |  |  |  | } | 
| 491 |  |  |  |  |  |  | } | 
| 492 | 11 |  |  |  |  | 23 | for my $opt (qw(source dest)) { | 
| 493 | 22 |  |  |  |  | 80 | $runopts{$opt} = $self->{$opt}; | 
| 494 |  |  |  |  |  |  | } | 
| 495 | 11 |  |  |  |  | 22 | @{$runopts{_args}} = @{$self->{_args}}; | 
|  | 11 |  |  |  |  | 50 |  | 
|  | 11 |  |  |  |  | 31 |  | 
| 496 |  |  |  |  |  |  | # now allow any args passed directly to exec to override | 
| 497 | 11 |  |  |  |  | 42 | OPT: for my $opt (keys %$execopts) { | 
| 498 | 33 |  |  |  |  | 66 | for my $type (qw(flag string counter list code _perlopts)) { | 
| 499 | 198 | 50 |  |  |  | 541 | if (exists $runopts{$type}{$opt}) { | 
| 500 | 0 |  |  |  |  | 0 | $runopts{$type}{$opt} = $execopts->{$opt}; | 
| 501 | 0 |  |  |  |  | 0 | next OPT; | 
| 502 |  |  |  |  |  |  | } | 
| 503 |  |  |  |  |  |  | } | 
| 504 | 33 | 100 | 66 |  |  | 198 | if ($opt eq '_args') { | 
|  |  | 50 |  |  |  |  |  | 
| 505 |  |  |  |  |  |  | # only preserve order if we already have order | 
| 506 | 10 |  |  |  |  | 19 | push @{$runopts{$opt}}, @{$execopts->{$opt}} | 
|  | 10 |  |  |  |  | 44 |  | 
| 507 | 11 | 100 |  |  |  | 19 | if @{$runopts{$opt}}; | 
|  | 11 |  |  |  |  | 44 |  | 
| 508 |  |  |  |  |  |  | } elsif ($opt eq 'source' or $opt eq 'dest') { | 
| 509 | 22 |  |  |  |  | 61 | $runopts{$opt} = $execopts->{$opt}; | 
| 510 |  |  |  |  |  |  | } else { | 
| 511 | 0 |  |  |  |  | 0 | carp "$pkgname: unknown option: $opt."; | 
| 512 | 0 |  |  |  |  | 0 | return; | 
| 513 |  |  |  |  |  |  | } | 
| 514 |  |  |  |  |  |  | } | 
| 515 | 11 |  |  |  |  | 97 | $merged = \%runopts; | 
| 516 |  |  |  |  |  |  | } | 
| 517 |  |  |  |  |  |  |  | 
| 518 | 15 | 50 | 66 |  |  | 26 | if ( | 
| 519 | 15 |  |  |  |  | 102 | !@{$merged->{_args}}    # include and exclude allowed if ordered args | 
| 520 | 1 |  |  |  |  | 5 | && ( (@{$merged->{list}{exclude}} != 0) | 
| 521 | 1 |  |  |  |  | 5 | + (@{$merged->{list}{include}} != 0) | 
| 522 | 1 |  |  |  |  | 12 | + (@{$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 | 15 |  |  |  |  | 35 | my $srchost = $merged->{srchost}; | 
| 531 | 15 | 50 | 33 |  |  | 46 | $srchost .= ':' if $srchost and substr($srchost, 0, 8) ne 'rsync://'; | 
| 532 |  |  |  |  |  |  |  | 
| 533 |  |  |  |  |  |  | # build the real command | 
| 534 | 15 |  |  |  |  | 51 | my @cmd = ($merged->{_perlopts}{'path-to-rsync'}); | 
| 535 |  |  |  |  |  |  |  | 
| 536 | 15 | 100 |  |  |  | 24 | if (@{$merged->{_args}}) {    # prefer ordered args if we have them | 
|  | 15 |  |  |  |  | 47 |  | 
| 537 | 14 |  |  |  |  | 20 | my $gotsrc; | 
| 538 | 14 |  |  |  |  | 28 | for (my $e = 0; $e < @{$merged->{_args}}; $e += 2) { | 
|  | 72 |  |  |  |  | 267 |  | 
| 539 | 58 |  |  |  |  | 132 | my $key = $merged->{_args}[$e]; | 
| 540 | 58 |  |  |  |  | 124 | my $val = $merged->{_args}[ $e + 1 ]; | 
| 541 | 58 | 50 |  |  |  | 449 | 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 | 18 | 50 |  |  |  | 121 | push @cmd, "--$key" if $val; | 
| 545 |  |  |  |  |  |  | } elsif (exists $merged->{string}{$key}) { | 
| 546 | 4 | 50 |  |  |  | 30 | push @cmd, "--$key=$val" if $val; | 
| 547 |  |  |  |  |  |  | } elsif (exists $merged->{counter}{$key}) { | 
| 548 | 2 |  |  |  |  | 15 | for (my $i = 0; $i < $val; $i++) { | 
| 549 | 2 |  |  |  |  | 182 | push @cmd, "--$key"; | 
| 550 |  |  |  |  |  |  | } | 
| 551 |  |  |  |  |  |  | } elsif (exists $merged->{list}{$key}) { | 
| 552 | 2 | 50 |  |  |  | 27 | push @cmd, ref $val eq 'ARRAY' | 
| 553 |  |  |  |  |  |  | ? map "--$key=$_", @$val | 
| 554 |  |  |  |  |  |  | : "--$key=$val"; | 
| 555 |  |  |  |  |  |  | } elsif ($key eq 'source') { | 
| 556 | 14 | 50 |  |  |  | 37 | 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 | 14 | 0 |  |  |  | 81 | $merged->{'quote-src'} | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 565 |  |  |  |  |  |  | ? map ("\"$_\"", ref $val eq 'ARRAY' ? @$val : $val) | 
| 566 |  |  |  |  |  |  | : ref $val eq 'ARRAY' ? @$val | 
| 567 |  |  |  |  |  |  | :                       $val; | 
| 568 |  |  |  |  |  |  | } | 
| 569 | 14 |  |  |  |  | 40 | $gotsrc++; | 
| 570 |  |  |  |  |  |  | } elsif ($key eq 'dest') { | 
| 571 | 14 | 50 |  |  |  | 52 | 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 | 14 | 50 |  |  |  | 55 | 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 | 1 | 50 |  |  |  | 4 | push @cmd, @{$merged->{list}{literal}} if @{$merged->{list}{literal}}; | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 1 |  |  |  |  | 10 |  | 
| 594 |  |  |  |  |  |  |  | 
| 595 | 1 |  |  |  |  | 3 | for my $opt (sort keys %{$merged->{flag}}) { | 
|  | 1 |  |  |  |  | 212 |  | 
| 596 | 106 | 100 |  |  |  | 297 | push @cmd, "--$opt" if $merged->{flag}{$opt}; | 
| 597 |  |  |  |  |  |  | } | 
| 598 | 1 |  |  |  |  | 7 | for my $opt (sort keys %{$merged->{string}}) { | 
|  | 1 |  |  |  |  | 16 |  | 
| 599 |  |  |  |  |  |  | push @cmd, "--$opt=$merged->{string}{$opt}" | 
| 600 | 39 | 50 |  |  |  | 72 | if $merged->{string}{$opt}; | 
| 601 |  |  |  |  |  |  | } | 
| 602 | 1 |  |  |  |  | 4 | for my $opt (sort keys %{$merged->{counter}}) { | 
|  | 1 |  |  |  |  | 4 |  | 
| 603 | 5 |  |  |  |  | 15 | for (my $i = 0; $i < $merged->{counter}{$opt}; $i++) { | 
| 604 | 0 |  |  |  |  | 0 | push @cmd, "--$opt"; | 
| 605 |  |  |  |  |  |  | } | 
| 606 |  |  |  |  |  |  | } | 
| 607 | 1 |  |  |  |  | 2 | for my $opt (sort keys %{$merged->{list}}) { | 
|  | 1 |  |  |  |  | 7 |  | 
| 608 | 12 | 100 |  |  |  | 23 | next if $opt eq 'literal'; | 
| 609 | 11 |  |  |  |  | 10 | for my $val (@{$merged->{$opt}}) { | 
|  | 11 |  |  |  |  | 24 |  | 
| 610 | 0 |  |  |  |  | 0 | push @cmd, "--$opt=$val"; | 
| 611 |  |  |  |  |  |  | } | 
| 612 |  |  |  |  |  |  | } | 
| 613 |  |  |  |  |  |  |  | 
| 614 | 1 | 50 | 0 |  |  | 4 | if ($merged->{source}) { | 
|  |  | 0 |  |  |  |  |  | 
| 615 | 1 | 50 |  |  |  | 4 | 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 | 1 | 50 |  |  |  | 13 | : @{$merged->{source}}; | 
|  | 1 |  |  |  |  | 3 |  | 
| 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 | 1 | 50 |  |  |  | 8 | unless ($list) { | 
| 641 | 1 | 50 |  |  |  | 3 | if ($merged->{dest}) { | 
| 642 |  |  |  |  |  |  | push @cmd, $merged->{'quote-dst'} | 
| 643 |  |  |  |  |  |  | ? "\"$merged->{dest}\"" | 
| 644 | 1 | 50 |  |  |  | 4 | : $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 | 15 | 100 |  |  |  | 314 | : \@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 | 6 |  |  | 6 | 1 | 1382 | my $self = shift; | 
| 685 |  |  |  |  |  |  |  | 
| 686 | 6 |  |  |  |  | 20 | my ($cmd, $infun, $outfun, $errfun, $debug) = $self->getcmd(@_); | 
| 687 | 6 | 50 |  |  |  | 26 | return unless $cmd; | 
| 688 | 6 | 50 |  |  |  | 16 | warn "exec: @$cmd\n" if $debug; | 
| 689 | 6 |  |  |  |  | 52 | run3($cmd, $infun, \my $stdout, \my $stderr); | 
| 690 | 6 |  |  |  |  | 333731 | $self->{_lastcmd}    = $cmd; | 
| 691 | 6 |  |  |  |  | 296 | $self->{_realstatus} = $?; | 
| 692 | 6 | 50 |  |  |  | 73 | $self->{_status}     = $? & 127 ? $? & 127 : $? >> 8; | 
| 693 | 6 | 50 |  |  |  | 67 | $self->{_out}        = $stdout ? [ split /^/m, $stdout ] : ''; | 
| 694 | 6 | 100 |  |  |  | 60 | $self->{_err}        = $stderr ? [ split /^/m, $stderr ] : ''; | 
| 695 | 6 | 0 | 33 |  |  | 59 | if ($outfun and $self->{_out}) { | 
| 696 | 0 |  |  |  |  | 0 | for (@{$self->{_out}}) { $outfun->($_, 'out') } | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 697 |  |  |  |  |  |  | } | 
| 698 | 6 | 0 | 33 |  |  | 38 | if ($errfun and $self->{_err}) { | 
| 699 | 0 |  |  |  |  | 0 | for (@{$self->{_err}}) { $errfun->($_, 'err') } | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 700 |  |  |  |  |  |  | } | 
| 701 | 6 | 100 |  |  |  | 360 | return ($self->{_status} ? 0 : 1); | 
| 702 |  |  |  |  |  |  | } | 
| 703 |  |  |  |  |  |  |  | 
| 704 |  |  |  |  |  |  | =head2 File::Rsync::list | 
| 705 |  |  |  |  |  |  |  | 
| 706 |  |  |  |  |  |  | $out = $obj->list(@options); | 
| 707 |  |  |  |  |  |  |  | 
| 708 |  |  |  |  |  |  | or | 
| 709 |  |  |  |  |  |  |  | 
| 710 |  |  |  |  |  |  | $out = $obj->list(\@options); | 
| 711 |  |  |  |  |  |  |  | 
| 712 |  |  |  |  |  |  | or | 
| 713 |  |  |  |  |  |  |  | 
| 714 |  |  |  |  |  |  | @out = $obj->list(\@options); | 
| 715 |  |  |  |  |  |  |  | 
| 716 |  |  |  |  |  |  | This is a wrapper for I called without a destination to get a listing. | 
| 717 |  |  |  |  |  |  | It returns the output of stdout like the I function below. | 
| 718 |  |  |  |  |  |  | When no destination is given rsync returns the equivalent of 'ls -l' or | 
| 719 |  |  |  |  |  |  | 'ls -lr' modified by any include/exclude/filter parameters you specify. | 
| 720 |  |  |  |  |  |  | This is useful for manual comparison without actual changes to the | 
| 721 |  |  |  |  |  |  | destination or for comparing against another listing taken at a different | 
| 722 |  |  |  |  |  |  | point in time. | 
| 723 |  |  |  |  |  |  |  | 
| 724 |  |  |  |  |  |  | (As of rsync version 2.6.4-pre1 this can also be accomplished with the | 
| 725 |  |  |  |  |  |  | 'list-only' option regardless of whether a destination is given.) | 
| 726 |  |  |  |  |  |  |  | 
| 727 |  |  |  |  |  |  | =cut | 
| 728 |  |  |  |  |  |  |  | 
| 729 |  |  |  |  |  |  | sub list { | 
| 730 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 731 | 0 |  |  |  |  | 0 | $self->{_list_mode}++; | 
| 732 | 0 |  |  |  |  | 0 | $self->exec(@_); | 
| 733 | 0 | 0 |  |  |  | 0 | if ($self->{_out}) { | 
| 734 | 0 | 0 |  |  |  | 0 | return (wantarray ? @{$self->{_out}} : $self->{_out}); | 
|  | 0 |  |  |  |  | 0 |  | 
| 735 |  |  |  |  |  |  | } else { | 
| 736 | 0 |  |  |  |  | 0 | return; | 
| 737 |  |  |  |  |  |  | } | 
| 738 |  |  |  |  |  |  | } | 
| 739 |  |  |  |  |  |  |  | 
| 740 |  |  |  |  |  |  | =head2 File::Rsync::status | 
| 741 |  |  |  |  |  |  |  | 
| 742 |  |  |  |  |  |  | $rval = $obj->status; | 
| 743 |  |  |  |  |  |  |  | 
| 744 |  |  |  |  |  |  | Returns the status from last I call right shifted 8 bits. | 
| 745 |  |  |  |  |  |  |  | 
| 746 |  |  |  |  |  |  | =cut | 
| 747 |  |  |  |  |  |  |  | 
| 748 |  |  |  |  |  |  | sub status { | 
| 749 | 3 |  |  | 3 | 1 | 58 | my $self = shift; | 
| 750 | 3 |  |  |  |  | 21 | return $self->{_status}; | 
| 751 |  |  |  |  |  |  | } | 
| 752 |  |  |  |  |  |  |  | 
| 753 |  |  |  |  |  |  | =head2 File::Rsync::realstatus | 
| 754 |  |  |  |  |  |  |  | 
| 755 |  |  |  |  |  |  | $rval = $obj->realstatus; | 
| 756 |  |  |  |  |  |  |  | 
| 757 |  |  |  |  |  |  | Returns the real status from last I call (not right shifted). | 
| 758 |  |  |  |  |  |  |  | 
| 759 |  |  |  |  |  |  | =cut | 
| 760 |  |  |  |  |  |  |  | 
| 761 |  |  |  |  |  |  | sub realstatus { | 
| 762 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 763 | 0 |  |  |  |  | 0 | return $self->{_realstatus}; | 
| 764 |  |  |  |  |  |  | } | 
| 765 |  |  |  |  |  |  |  | 
| 766 |  |  |  |  |  |  | =head2 File::Rsync::err | 
| 767 |  |  |  |  |  |  |  | 
| 768 |  |  |  |  |  |  | $aref = $obj->err; | 
| 769 |  |  |  |  |  |  |  | 
| 770 |  |  |  |  |  |  | In scalar context this method will return a reference to an array containing | 
| 771 |  |  |  |  |  |  | all output to stderr from the last I call, or zero (false) if there | 
| 772 |  |  |  |  |  |  | was no output. | 
| 773 |  |  |  |  |  |  | In an array context it will return an array of all output to stderr or an | 
| 774 |  |  |  |  |  |  | empty list. | 
| 775 |  |  |  |  |  |  | The scalar context can be used to efficiently test for the existance of output. | 
| 776 |  |  |  |  |  |  | I sends all messages from the remote I process and any error | 
| 777 |  |  |  |  |  |  | messages to stderr. | 
| 778 |  |  |  |  |  |  | This method's purpose is to make it easier for you to parse that output for | 
| 779 |  |  |  |  |  |  | appropriate information. | 
| 780 |  |  |  |  |  |  |  | 
| 781 |  |  |  |  |  |  | =cut | 
| 782 |  |  |  |  |  |  |  | 
| 783 |  |  |  |  |  |  | sub err { | 
| 784 | 6 |  |  | 6 | 1 | 270 | my $self = shift; | 
| 785 | 6 | 100 |  |  |  | 256 | if ($self->{_err}) { | 
| 786 | 4 | 50 |  |  |  | 1254 | return (wantarray ? @{$self->{_err}} : $self->{_err}); | 
|  | 0 |  |  |  |  | 0 |  | 
| 787 |  |  |  |  |  |  | } else { | 
| 788 | 2 |  |  |  |  | 55 | return; | 
| 789 |  |  |  |  |  |  | } | 
| 790 |  |  |  |  |  |  | } | 
| 791 |  |  |  |  |  |  |  | 
| 792 |  |  |  |  |  |  | =head2 File::Rsync::out | 
| 793 |  |  |  |  |  |  |  | 
| 794 |  |  |  |  |  |  | $aref = $obj->out; | 
| 795 |  |  |  |  |  |  |  | 
| 796 |  |  |  |  |  |  | Similar to the I method, in a scalar context it returns a reference to an | 
| 797 |  |  |  |  |  |  | array containing all output to stdout from the last I call, or zero | 
| 798 |  |  |  |  |  |  | (false) if there was no output. | 
| 799 |  |  |  |  |  |  | In an array context it returns an array of all output to stdout or an empty | 
| 800 |  |  |  |  |  |  | list. | 
| 801 |  |  |  |  |  |  | I sends all informational messages (B option) from the local | 
| 802 |  |  |  |  |  |  | I process to stdout. | 
| 803 |  |  |  |  |  |  |  | 
| 804 |  |  |  |  |  |  | =cut | 
| 805 |  |  |  |  |  |  |  | 
| 806 |  |  |  |  |  |  | sub out { | 
| 807 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 808 | 0 | 0 |  |  |  |  | if ($self->{_out}) { | 
| 809 | 0 | 0 |  |  |  |  | return (wantarray ? @{$self->{_out}} : $self->{_out}); | 
|  | 0 |  |  |  |  |  |  | 
| 810 |  |  |  |  |  |  | } else { | 
| 811 | 0 |  |  |  |  |  | return; | 
| 812 |  |  |  |  |  |  | } | 
| 813 |  |  |  |  |  |  | } | 
| 814 |  |  |  |  |  |  |  | 
| 815 |  |  |  |  |  |  | =head2 File::Rsync::lastcmd | 
| 816 |  |  |  |  |  |  |  | 
| 817 |  |  |  |  |  |  | $aref = $obj->lastcmd; | 
| 818 |  |  |  |  |  |  |  | 
| 819 |  |  |  |  |  |  | Returns the actual system command used by the last I call, or '' before | 
| 820 |  |  |  |  |  |  | any calls to I for the object. | 
| 821 |  |  |  |  |  |  | This can be useful in the case of an error condition to give a more | 
| 822 |  |  |  |  |  |  | informative message or for debugging purposes. | 
| 823 |  |  |  |  |  |  | In an array context it return an array of args as passed to the system, in | 
| 824 |  |  |  |  |  |  | a scalar context it returns a space-seperated string. | 
| 825 |  |  |  |  |  |  | See I for access to the command before execution. | 
| 826 |  |  |  |  |  |  |  | 
| 827 |  |  |  |  |  |  | =cut | 
| 828 |  |  |  |  |  |  |  | 
| 829 |  |  |  |  |  |  | sub lastcmd { | 
| 830 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 831 | 0 | 0 |  |  |  |  | if ($self->{_lastcmd}) { | 
| 832 | 0 |  |  |  |  |  | return wantarray ? @{$self->{_lastcmd}} : join ' ', | 
| 833 | 0 | 0 |  |  |  |  | @{$self->{_lastcmd}}; | 
|  | 0 |  |  |  |  |  |  | 
| 834 |  |  |  |  |  |  | } else { | 
| 835 | 0 |  |  |  |  |  | return; | 
| 836 |  |  |  |  |  |  | } | 
| 837 |  |  |  |  |  |  | } | 
| 838 |  |  |  |  |  |  |  | 
| 839 |  |  |  |  |  |  | =head1 Author | 
| 840 |  |  |  |  |  |  |  | 
| 841 |  |  |  |  |  |  | Lee Eakin Eleakin@dfw.nostrum.comE | 
| 842 |  |  |  |  |  |  |  | 
| 843 |  |  |  |  |  |  | =head1 Credits | 
| 844 |  |  |  |  |  |  |  | 
| 845 |  |  |  |  |  |  | The following people have contributed ideas, bug fixes, code or helped out | 
| 846 |  |  |  |  |  |  | by reporting or tracking down bugs in order to improve this module since | 
| 847 |  |  |  |  |  |  | it's initial release. | 
| 848 |  |  |  |  |  |  | See the Changelog for details: | 
| 849 |  |  |  |  |  |  |  | 
| 850 |  |  |  |  |  |  | Greg Ward | 
| 851 |  |  |  |  |  |  |  | 
| 852 |  |  |  |  |  |  | Boris Goldowsky | 
| 853 |  |  |  |  |  |  |  | 
| 854 |  |  |  |  |  |  | James Mello | 
| 855 |  |  |  |  |  |  |  | 
| 856 |  |  |  |  |  |  | Andreas Koenig | 
| 857 |  |  |  |  |  |  |  | 
| 858 |  |  |  |  |  |  | Joe Smith | 
| 859 |  |  |  |  |  |  |  | 
| 860 |  |  |  |  |  |  | Jonathan Pelletier | 
| 861 |  |  |  |  |  |  |  | 
| 862 |  |  |  |  |  |  | Heiko Jansen | 
| 863 |  |  |  |  |  |  |  | 
| 864 |  |  |  |  |  |  | Tong Zhu | 
| 865 |  |  |  |  |  |  |  | 
| 866 |  |  |  |  |  |  | Paul Egan | 
| 867 |  |  |  |  |  |  |  | 
| 868 |  |  |  |  |  |  | Ronald J Kimball | 
| 869 |  |  |  |  |  |  |  | 
| 870 |  |  |  |  |  |  | James CE Johnson | 
| 871 |  |  |  |  |  |  |  | 
| 872 |  |  |  |  |  |  | Bill Uhl | 
| 873 |  |  |  |  |  |  |  | 
| 874 |  |  |  |  |  |  | Peter teStrake | 
| 875 |  |  |  |  |  |  |  | 
| 876 |  |  |  |  |  |  | Harald Flaucher | 
| 877 |  |  |  |  |  |  |  | 
| 878 |  |  |  |  |  |  | Simon Myers | 
| 879 |  |  |  |  |  |  |  | 
| 880 |  |  |  |  |  |  | Gavin Carr | 
| 881 |  |  |  |  |  |  |  | 
| 882 |  |  |  |  |  |  | Petya Kohts | 
| 883 |  |  |  |  |  |  |  | 
| 884 |  |  |  |  |  |  | Neil Hooey | 
| 885 |  |  |  |  |  |  |  | 
| 886 |  |  |  |  |  |  | Erez Schatz | 
| 887 |  |  |  |  |  |  |  | 
| 888 |  |  |  |  |  |  | Max Maischein | 
| 889 |  |  |  |  |  |  |  | 
| 890 |  |  |  |  |  |  | =head1 Inspiration and Assistance | 
| 891 |  |  |  |  |  |  |  | 
| 892 |  |  |  |  |  |  | Gerard Hickey                             C | 
| 893 |  |  |  |  |  |  |  | 
| 894 |  |  |  |  |  |  | Russ Allbery                              C | 
| 895 |  |  |  |  |  |  |  | 
| 896 |  |  |  |  |  |  | Graham Barr                               C | 
| 897 |  |  |  |  |  |  |  | 
| 898 |  |  |  |  |  |  | Andrew Tridgell and Paul Mackerras        rsync(1) | 
| 899 |  |  |  |  |  |  |  | 
| 900 |  |  |  |  |  |  | John Steele   Esteele@nostrum.comE | 
| 901 |  |  |  |  |  |  |  | 
| 902 |  |  |  |  |  |  | Philip Kizer  Epckizer@nostrum.comE | 
| 903 |  |  |  |  |  |  |  | 
| 904 |  |  |  |  |  |  | Larry Wall                                perl(1) | 
| 905 |  |  |  |  |  |  |  | 
| 906 |  |  |  |  |  |  | I borrowed many clues on wrapping an external program from the PGP modules, | 
| 907 |  |  |  |  |  |  | and I would not have had such a useful tool to wrap except for the great work | 
| 908 |  |  |  |  |  |  | of the B authors.  Thanks also to Graham Barr, the author of the libnet | 
| 909 |  |  |  |  |  |  | modules and many others, for looking over this code.  Of course I must mention | 
| 910 |  |  |  |  |  |  | the other half of my brain, John Steele, and his good friend Philip Kizer for | 
| 911 |  |  |  |  |  |  | finding B and bringing it to my attention.  And I would not have been | 
| 912 |  |  |  |  |  |  | able to enjoy writing useful tools if not for the creator of the B | 
| 913 |  |  |  |  |  |  | language. | 
| 914 |  |  |  |  |  |  |  | 
| 915 |  |  |  |  |  |  | =head1 Copyrights | 
| 916 |  |  |  |  |  |  |  | 
| 917 |  |  |  |  |  |  | Copyright (c) 1999-2015 Lee Eakin.  All rights reserved. | 
| 918 |  |  |  |  |  |  |  | 
| 919 |  |  |  |  |  |  | This program is free software; you can redistribute it and/or modify | 
| 920 |  |  |  |  |  |  | it under the same terms as Perl itself. | 
| 921 |  |  |  |  |  |  |  | 
| 922 |  |  |  |  |  |  | =cut | 
| 923 |  |  |  |  |  |  |  | 
| 924 |  |  |  |  |  |  | 1; |