File Coverage

blib/lib/File/Copy/Undoable.pm
Criterion Covered Total %
statement 50 52 96.1
branch 19 30 63.3
condition 8 14 57.1
subroutine 9 9 100.0
pod 1 1 100.0
total 87 106 82.0


line stmt bran cond sub pod time code
1             package File::Copy::Undoable;
2              
3             our $DATE = '2016-06-10'; # DATE
4             our $VERSION = '0.11'; # VERSION
5              
6 3     3   16186 use 5.010001;
  3         6  
7 3     3   10 use strict;
  3         7  
  3         47  
8 3     3   7 use warnings;
  3         3  
  3         62  
9 3     3   1998 use Log::Any::IfLOG '$log';
  3         27  
  3         12  
10              
11 3     3   1362 use IPC::System::Options 'system', -log=>1;
  3         8408  
  3         18  
12 3     3   1217 use File::MoreUtil qw(file_exists);
  3         995  
  3         131  
13 3     3   1234 use File::Trash::Undoable;
  3         20792  
  3         86  
14             #use PerlX::Maybe;
15 3     3   14 use Proc::ChildError qw(explain_child_error);
  3         3  
  3         1214  
16              
17             our %SPEC;
18              
19             $SPEC{cp} = {
20             v => 1.1,
21             summary => 'Copy file/directory using rsync, with undo support',
22             description => <<'_',
23              
24             On do, will copy `source` to `target` (which must not exist beforehand). On
25             undo, will trash `target`.
26              
27             Fixed state: `source` exists and `target` exists. Content or sizes are not
28             checked; only existence.
29              
30             Fixable state: `source` exists and `target` doesn't exist.
31              
32             Unfixable state: `source` does not exist.
33              
34             _
35             args => {
36             source => {
37             schema => 'str*',
38             req => 1,
39             pos => 0,
40             },
41             target => {
42             schema => 'str*',
43             summary => 'Target location',
44             description => <<'_',
45              
46             Note that to avoid ambiguity, you must specify full location instead of just
47             directory name. For example: cp(source=>'/dir', target=>'/a') will copy /dir to
48             /a and cp(source=>'/dir', target=>'/a/dir') will copy /dir to /a/dir.
49              
50             _
51             req => 1,
52             pos => 1,
53             },
54             target_owner => {
55             schema => 'str*',
56             summary => 'Set ownership of target',
57             description => <<'_',
58              
59             If set, will do a `chmod -Rh` on the target after rsync to set ownership. This
60             usually requires super-user privileges. An example of this is copying files on
61             behalf of user from a source that is inaccessible by the user (e.g. a system
62             backup location). Or, setting up user's home directory when creating a user.
63              
64             Will do nothing if not running as super-user.
65              
66             _
67             },
68             target_group => {
69             schema => 'str*',
70             summary => 'Set group of target',
71             description => <<'_',
72              
73             See `target_owner`.
74              
75             _
76             },
77             rsync_opts => {
78             schema => [array => {of=>'str*', default=>['-a']}],
79             summary => 'Rsync options',
80             description => <<'_',
81              
82             By default, `-a` is used. You can add, for example, `--delete` or other rsync
83             options.
84              
85             _
86             },
87             },
88             features => {
89             tx => {v=>2},
90             idempotent => 1,
91             },
92             deps => {
93             prog => 'rsync',
94             },
95             };
96             sub cp {
97 55     55 1 10925397 my %args = @_;
98              
99             # TMP, schema
100 55   50     337 my $tx_action = $args{-tx_action} // '';
101 55         122 my $dry_run = $args{-dry_run};
102 55         99 my $source = $args{source};
103 55 50       169 defined($source) or return [400, "Please specify source"];
104 55         116 my $target = $args{target};
105 55 50       140 defined($target) or return [400, "Please specify target"];
106 55   100     211 my $rsync_opts = $args{rsync_opts} // ['-a'];
107 55 50       228 $rsync_opts = [$rsync_opts] unless ref($rsync_opts) eq 'ARRAY';
108              
109 55 100       233 if ($tx_action eq 'check_state') {
    50          
110 32 100       148 return [412, "Source $source does not exist"]
111             unless file_exists($source);
112 30         557 my $te = file_exists($target);
113 30 50 33     630 unless ($args{-tx_recovery} || $args{-tx_rollback}) {
114             # in rollback/recovery, we might need to continue interrupted
115             # transfer, so we allow target to exist
116 30 100       177 return [304, "Target $target already exists"] if $te;
117             }
118 26 0       87 $log->info("(DRY) ".
    50          
119             ($te ? "Syncing" : "Copying")." $source -> $target ...")
120             if $dry_run;
121 26 50       810 return [200, "$source needs to be ".($te ? "synced":"copied").
122             " to $target", undef, {undo_actions=>[
123             ["File::Trash::Undoable::trash" => {path=>$target}],
124             ]}];
125              
126             } elsif ($tx_action eq 'fix_state') {
127 23         172 my @cmd = ("rsync", @$rsync_opts, "$source/", "$target/");
128 23         281 $log->info("Rsync-ing $source -> $target ...");
129 23         173 system @cmd;
130 23 100       1028783 return [500, "Can't rsync: ".explain_child_error($?)] if $?;
131 22 100 66     305 if (defined($args{target_owner}) || defined($args{target_group})) {
132 11 50       98 if ($> == 0) {
133 11         249 $log->info("Chown-ing $target ...");
134             @cmd = (
135             "chown", "-Rh",
136             join("", $args{target_owner}//"", ":",
137 11   50     258 $args{target_group}//""),
      50        
138             $target);
139 11         113 system @cmd;
140 11 50       36629 return [500, "Can't chown: ".explain_child_error($?)] if $?;
141             } else {
142 0         0 $log->debug("Not running as root, not doing chown");
143             }
144             }
145 22         2166 return [200, "OK"];
146             }
147 0           [400, "Invalid -tx_action"];
148             }
149              
150             1;
151             # ABSTRACT: Copy file/directory using rsync, with undo support
152              
153             __END__
154              
155             =pod
156              
157             =encoding UTF-8
158              
159             =head1 NAME
160              
161             File::Copy::Undoable - Copy file/directory using rsync, with undo support
162              
163             =head1 VERSION
164              
165             This document describes version 0.11 of File::Copy::Undoable (from Perl distribution File-Copy-Undoable), released on 2016-06-10.
166              
167             =head1 FUNCTIONS
168              
169              
170             =head2 cp(%args) -> [status, msg, result, meta]
171              
172             Copy file/directory using rsync, with undo support.
173              
174             On do, will copy C<source> to C<target> (which must not exist beforehand). On
175             undo, will trash C<target>.
176              
177             Fixed state: C<source> exists and C<target> exists. Content or sizes are not
178             checked; only existence.
179              
180             Fixable state: C<source> exists and C<target> doesn't exist.
181              
182             Unfixable state: C<source> does not exist.
183              
184             This function is not exported.
185              
186             This function is idempotent (repeated invocations with same arguments has the same effect as single invocation). This function supports transactions.
187              
188              
189             Arguments ('*' denotes required arguments):
190              
191             =over 4
192              
193             =item * B<rsync_opts> => I<array[str]> (default: ["-a"])
194              
195             Rsync options.
196              
197             By default, C<-a> is used. You can add, for example, C<--delete> or other rsync
198             options.
199              
200             =item * B<source>* => I<str>
201              
202             =item * B<target>* => I<str>
203              
204             Target location.
205              
206             Note that to avoid ambiguity, you must specify full location instead of just
207             directory name. For example: cp(source=>'/dir', target=>'/a') will copy /dir to
208             /a and cp(source=>'/dir', target=>'/a/dir') will copy /dir to /a/dir.
209              
210             =item * B<target_group> => I<str>
211              
212             Set group of target.
213              
214             See C<target_owner>.
215              
216             =item * B<target_owner> => I<str>
217              
218             Set ownership of target.
219              
220             If set, will do a C<chmod -Rh> on the target after rsync to set ownership. This
221             usually requires super-user privileges. An example of this is copying files on
222             behalf of user from a source that is inaccessible by the user (e.g. a system
223             backup location). Or, setting up user's home directory when creating a user.
224              
225             Will do nothing if not running as super-user.
226              
227             =back
228              
229             Special arguments:
230              
231             =over 4
232              
233             =item * B<-tx_action> => I<str>
234              
235             For more information on transaction, see L<Rinci::Transaction>.
236              
237             =item * B<-tx_action_id> => I<str>
238              
239             For more information on transaction, see L<Rinci::Transaction>.
240              
241             =item * B<-tx_recovery> => I<str>
242              
243             For more information on transaction, see L<Rinci::Transaction>.
244              
245             =item * B<-tx_rollback> => I<str>
246              
247             For more information on transaction, see L<Rinci::Transaction>.
248              
249             =item * B<-tx_v> => I<str>
250              
251             For more information on transaction, see L<Rinci::Transaction>.
252              
253             =back
254              
255             Returns an enveloped result (an array).
256              
257             First element (status) is an integer containing HTTP status code
258             (200 means OK, 4xx caller error, 5xx function error). Second element
259             (msg) is a string containing error message, or 'OK' if status is
260             200. Third element (result) is optional, the actual result. Fourth
261             element (meta) is called result metadata and is optional, a hash
262             that contains extra information.
263              
264             Return value: (any)
265              
266             =head1 FAQ
267              
268             =head2 Why do you use rsync? Why not, say, File::Copy::Recursive?
269              
270             With C<rsync>, we can continue interrupted transfer. We need this ability for
271             recovery. Also, C<rsync> can handle hardlinks and preservation of ownership,
272             something which L<File::Copy::Recursive> currently does not do. And, being
273             implemented in C, it might be faster when processing large files/trees.
274              
275             =head1 HOMEPAGE
276              
277             Please visit the project's homepage at L<https://metacpan.org/release/File-Copy-Undoable>.
278              
279             =head1 SOURCE
280              
281             Source repository is at L<https://github.com/perlancar/perl-File-Copy-Undoable>.
282              
283             =head1 BUGS
284              
285             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=File-Copy-Undoable>
286              
287             When submitting a bug or request, please include a test-file or a
288             patch to an existing test-file that illustrates the bug or desired
289             feature.
290              
291             =head1 SEE ALSO
292              
293             L<Setup>
294              
295             L<Rinci::Transaction>
296              
297             =head1 AUTHOR
298              
299             perlancar <perlancar@cpan.org>
300              
301             =head1 COPYRIGHT AND LICENSE
302              
303             This software is copyright (c) 2016 by perlancar@cpan.org.
304              
305             This is free software; you can redistribute it and/or modify it under
306             the same terms as the Perl 5 programming language system itself.
307              
308             =cut