File Coverage

blib/lib/File/Trash/Undoable.pm
Criterion Covered Total %
statement 69 96 71.8
branch 27 54 50.0
condition 5 13 38.4
subroutine 8 11 72.7
pod 5 5 100.0
total 114 179 63.6


line stmt bran cond sub pod time code
1             package File::Trash::Undoable;
2              
3             our $DATE = '2016-12-27'; # DATE
4             our $VERSION = '0.20'; # VERSION
5              
6 1     1   1296 use 5.010001;
  1         2  
7 1     1   3 use strict;
  1         0  
  1         16  
8 1     1   2 use warnings;
  1         1  
  1         19  
9 1     1   3 use Log::Any::IfLOG '$log';
  1         1  
  1         6  
10              
11 1     1   380 use File::MoreUtil qw(l_abs_path);
  1         322  
  1         48  
12 1     1   427 use File::Trash::FreeDesktop;
  1         1953  
  1         785  
13              
14             our %SPEC;
15              
16             $SPEC{':package'} = {
17             v => 1.1,
18             summary => 'Trash files, with undo/redo capability',
19             };
20              
21             my $trash = File::Trash::FreeDesktop->new;
22              
23             $SPEC{trash} = {
24             v => 1.1,
25             name => 'trash',
26             summary => 'Trash a file',
27             args => {
28             path => {
29             schema => 'str*',
30             req => 1,
31             },
32             suffix => {
33             schema => 'str',
34             },
35             },
36             description => <<'_',
37              
38             Fixed state: path does not exist.
39              
40             Fixable state: path exists.
41              
42             _
43             features => {
44             tx => {v=>2},
45             idempotent => 1,
46             },
47             };
48             sub trash {
49 66     66 1 4947584 my %args = @_;
50              
51             # TMP, SCHEMA
52 66   50     416 my $tx_action = $args{-tx_action} // "";
53 66         143 my $dry_run = $args{-dry_run};
54 66         134 my $path = $args{path};
55 66 50       249 defined($path) or return [400, "Please specify path"];
56 66         131 my $suffix = $args{suffix};
57              
58 66         1142 my @st = lstat($path);
59 66   66     561 my $exists = (-l _) || (-e _);
60              
61 66         95 my (@do, @undo);
62              
63 66 100       209 if (defined $suffix) {
64 46 100       220 if ($tx_action eq 'check_state') {
    50          
65 24 100       78 if ($exists) {
66 22         99 unshift @undo, [untrash => {path=>$path, suffix=>$suffix}];
67             }
68 24 100       75 if (@undo) {
69 22 50       80 $log->info("(DRY) Trashing $path ...") if $dry_run;
70 22         653 return [200, "File/dir $path should be trashed",
71             undef, {undo_actions=>\@undo}];
72             } else {
73 2         49 return [304, "File/dir $path already does not exist"];
74             }
75             } elsif ($tx_action eq 'fix_state') {
76 22         384 $log->info("Trashing $path ...");
77 22         111 my $tfile;
78 22         35 eval { $tfile = $trash->trash({suffix=>$suffix}, $path) };
  22         192  
79 22 50       53624 return $@ ? [500, "trash() failed: $@"] : [200, "OK", $tfile];
80             }
81 0         0 return [400, "Invalid -tx_action"];
82             } else {
83             my $taid = $args{-tx_action_id}
84 20 100       83 or return [412, "Please specify -tx_action_id"];
85 17         43 $suffix = substr($taid, 0, 8);
86 17 100       50 if ($exists) {
87 14         68 push @do , [trash => {path=>$path, suffix=>$suffix}];
88 14         349 unshift @undo, [untrash => {path=>$path, suffix=>$suffix}];
89             }
90 17 100       53 if (@undo) {
91 14 50       43 $log->info("(DRY) Trashing $path (suffix $suffix) ...") if $dry_run;
92 14         400 return [200, "", undef, {do_actions=>\@do, undo_actions=>\@undo}];
93             } else {
94 3         67 return [304, "File/dir $path already does not exist"];
95             }
96             }
97             }
98              
99             $SPEC{untrash} = {
100             v => 1.1,
101             summary => 'Untrash a file',
102             description => <<'_',
103              
104             Fixed state: path exists.
105              
106             Fixable state: Path does not exist (and exists in trash, and if suffix is
107             specified, has the same suffix).
108              
109             _
110             args => {
111             path => {
112             schema => 'str*',
113             req => 1,
114             },
115             suffix => {
116             schema => 'str',
117             },
118             },
119             features => {
120             tx => {v=>2},
121             idempotent => 1,
122             },
123             };
124             sub untrash {
125 32     32 1 2861727 my %args = @_;
126              
127             # TMP, SCHEMA
128 32   50     172 my $tx_action = $args{-tx_action} // "";
129 32         64 my $dry_run = $args{-dry_run};
130 32         58 my $path0 = $args{path};
131 32 50       89 defined($path0) or return [400, "Please specify path"];
132 32         41 my $suffix = $args{suffix};
133              
134 32         146 my $apath = l_abs_path($path0);
135 32         1161 my @st = lstat($apath);
136 32   33     204 my $exists = (-l _) || (-e _);
137              
138 32 100       112 if ($tx_action eq 'check_state') {
    50          
139              
140 16         24 my @undo;
141 16 50       108 return [304, "Path $path0 already exists"] if $exists;
142              
143 16         135 my @res = $trash->list_contents({
144             search_path=>$apath, suffix=>$suffix});
145 16 50       52198 return [412, "File/dir $path0 does not exist in trash"] unless @res;
146 16         94 unshift @undo, [trash => {path => $apath, suffix=>$suffix}];
147 16 50       57 $log->info("(DRY) Untrashing $path0 ...") if $dry_run;
148 16         679 return [200, "File/dir $path0 should be untrashed",
149             undef, {undo_actions=>\@undo}];
150              
151             } elsif ($tx_action eq 'fix_state') {
152 16         197 $log->info("Untrashing $path0 ...");
153 16         56 eval { $trash->recover({suffix=>$suffix}, $apath) };
  16         113  
154 16 50       41893 return $@ ? [500, "untrash() failed: $@"] : [200, "OK"];
155             }
156 0           [400, "Invalid -tx_action"];
157             }
158              
159             $SPEC{trash_files} = {
160             v => 1.1,
161             summary => 'Trash files (with undo support)',
162             args => {
163             files => {
164             summary => 'Files/dirs to delete',
165             description => <<'_',
166              
167             Files must exist.
168              
169             _
170             schema => ['array*' => {of=>'str*'}],
171             req => 1,
172             pos => 0,
173             greedy => 1,
174             },
175             },
176             features => {
177             tx => {v=>2},
178             idempotent => 1,
179             },
180             };
181             sub trash_files {
182 0     0 1   my %args = @_;
183              
184             # TMP, SCHEMA
185 0           my $dry_run = $args{-dry_run};
186 0           my $ff = $args{files};
187 0 0         $ff or return [400, "Please specify files"];
188 0 0         ref($ff) eq 'ARRAY' or return [400, "Files must be array"];
189 0 0         @$ff > 0 or return [400, "Please specify at least 1 file"];
190              
191 0           my (@do, @undo);
192 0           for (@$ff) {
193 0 0         my @st = lstat($_) or return [400, "Can't stat $_: $!"];
194 0 0 0       (-l _) || (-e _) or return [400, "File does not exist: $_"];
195 0           my $orig = $_;
196 0           $_ = l_abs_path($_);
197 0 0         $_ or return [400, "Can't convert to absolute path: $orig"];
198 0 0         $log->infof("(DRY) Trashing %s ...", $orig) if $dry_run;
199 0           push @do , [trash => {path=>$_}];
200 0           unshift @undo, [untrash => {path=>$_, mtime=>$st[9]}];
201             }
202              
203 0           return [200, "", undef, {do_actions=>\@do, undo_actions=>\@undo}];
204             }
205              
206             $SPEC{list_trash_contents} = {
207             v => 1.1,
208             summary => 'List contents of trash directory',
209             };
210             sub list_trash_contents {
211 0     0 1   my %args = @_;
212 0           [200, "OK", [$trash->list_contents]];
213             }
214              
215             $SPEC{empty_trash} = {
216             v => 1.1,
217             summary => 'Empty trash',
218             };
219             sub empty_trash {
220 0     0 1   my %args = @_;
221 0           my $cmd = $args{-cmdline};
222              
223 0           $trash->empty;
224 0 0         if ($cmd) {
225 0           $cmd->run_clear_history;
226             } else {
227 0           [200, "OK"];
228             }
229             }
230              
231             1;
232             # ABSTRACT: Trash files, with undo/redo capability
233              
234             __END__
235              
236             =pod
237              
238             =encoding UTF-8
239              
240             =head1 NAME
241              
242             File::Trash::Undoable - Trash files, with undo/redo capability
243              
244             =head1 VERSION
245              
246             This document describes version 0.20 of File::Trash::Undoable (from Perl distribution File-Trash-Undoable), released on 2016-12-27.
247              
248             =head1 SYNOPSIS
249              
250             # use the trash-u script
251              
252             =head1 DESCRIPTION
253              
254             This module provides routines to trash files, with undo/redo support. Actual
255             trashing/untrashing is provided by L<File::Trash::FreeDesktop>.
256              
257             Screenshots:
258              
259             =head1 FUNCTIONS
260              
261              
262             =head2 empty_trash() -> [status, msg, result, meta]
263              
264             Empty trash.
265              
266             This function is not exported.
267              
268             No arguments.
269              
270             Returns an enveloped result (an array).
271              
272             First element (status) is an integer containing HTTP status code
273             (200 means OK, 4xx caller error, 5xx function error). Second element
274             (msg) is a string containing error message, or 'OK' if status is
275             200. Third element (result) is optional, the actual result. Fourth
276             element (meta) is called result metadata and is optional, a hash
277             that contains extra information.
278              
279             Return value: (any)
280              
281              
282             =head2 list_trash_contents() -> [status, msg, result, meta]
283              
284             List contents of trash directory.
285              
286             This function is not exported.
287              
288             No arguments.
289              
290             Returns an enveloped result (an array).
291              
292             First element (status) is an integer containing HTTP status code
293             (200 means OK, 4xx caller error, 5xx function error). Second element
294             (msg) is a string containing error message, or 'OK' if status is
295             200. Third element (result) is optional, the actual result. Fourth
296             element (meta) is called result metadata and is optional, a hash
297             that contains extra information.
298              
299             Return value: (any)
300              
301              
302             =head2 trash(%args) -> [status, msg, result, meta]
303              
304             Trash a file.
305              
306             Fixed state: path does not exist.
307              
308             Fixable state: path exists.
309              
310             This function is not exported.
311              
312             This function is idempotent (repeated invocations with same arguments has the same effect as single invocation). This function supports transactions.
313              
314              
315             Arguments ('*' denotes required arguments):
316              
317             =over 4
318              
319             =item * B<path>* => I<str>
320              
321             =item * B<suffix> => I<str>
322              
323             =back
324              
325             Special arguments:
326              
327             =over 4
328              
329             =item * B<-tx_action> => I<str>
330              
331             For more information on transaction, see L<Rinci::Transaction>.
332              
333             =item * B<-tx_action_id> => I<str>
334              
335             For more information on transaction, see L<Rinci::Transaction>.
336              
337             =item * B<-tx_recovery> => I<str>
338              
339             For more information on transaction, see L<Rinci::Transaction>.
340              
341             =item * B<-tx_rollback> => I<str>
342              
343             For more information on transaction, see L<Rinci::Transaction>.
344              
345             =item * B<-tx_v> => I<str>
346              
347             For more information on transaction, see L<Rinci::Transaction>.
348              
349             =back
350              
351             Returns an enveloped result (an array).
352              
353             First element (status) is an integer containing HTTP status code
354             (200 means OK, 4xx caller error, 5xx function error). Second element
355             (msg) is a string containing error message, or 'OK' if status is
356             200. Third element (result) is optional, the actual result. Fourth
357             element (meta) is called result metadata and is optional, a hash
358             that contains extra information.
359              
360             Return value: (any)
361              
362              
363             =head2 trash_files(%args) -> [status, msg, result, meta]
364              
365             Trash files (with undo support).
366              
367             This function is not exported.
368              
369             This function is idempotent (repeated invocations with same arguments has the same effect as single invocation). This function supports transactions.
370              
371              
372             Arguments ('*' denotes required arguments):
373              
374             =over 4
375              
376             =item * B<files>* => I<array[str]>
377              
378             Files/dirs to delete.
379              
380             Files must exist.
381              
382             =back
383              
384             Special arguments:
385              
386             =over 4
387              
388             =item * B<-tx_action> => I<str>
389              
390             For more information on transaction, see L<Rinci::Transaction>.
391              
392             =item * B<-tx_action_id> => I<str>
393              
394             For more information on transaction, see L<Rinci::Transaction>.
395              
396             =item * B<-tx_recovery> => I<str>
397              
398             For more information on transaction, see L<Rinci::Transaction>.
399              
400             =item * B<-tx_rollback> => I<str>
401              
402             For more information on transaction, see L<Rinci::Transaction>.
403              
404             =item * B<-tx_v> => I<str>
405              
406             For more information on transaction, see L<Rinci::Transaction>.
407              
408             =back
409              
410             Returns an enveloped result (an array).
411              
412             First element (status) is an integer containing HTTP status code
413             (200 means OK, 4xx caller error, 5xx function error). Second element
414             (msg) is a string containing error message, or 'OK' if status is
415             200. Third element (result) is optional, the actual result. Fourth
416             element (meta) is called result metadata and is optional, a hash
417             that contains extra information.
418              
419             Return value: (any)
420              
421              
422             =head2 untrash(%args) -> [status, msg, result, meta]
423              
424             Untrash a file.
425              
426             Fixed state: path exists.
427              
428             Fixable state: Path does not exist (and exists in trash, and if suffix is
429             specified, has the same suffix).
430              
431             This function is not exported.
432              
433             This function is idempotent (repeated invocations with same arguments has the same effect as single invocation). This function supports transactions.
434              
435              
436             Arguments ('*' denotes required arguments):
437              
438             =over 4
439              
440             =item * B<path>* => I<str>
441              
442             =item * B<suffix> => I<str>
443              
444             =back
445              
446             Special arguments:
447              
448             =over 4
449              
450             =item * B<-tx_action> => I<str>
451              
452             For more information on transaction, see L<Rinci::Transaction>.
453              
454             =item * B<-tx_action_id> => I<str>
455              
456             For more information on transaction, see L<Rinci::Transaction>.
457              
458             =item * B<-tx_recovery> => I<str>
459              
460             For more information on transaction, see L<Rinci::Transaction>.
461              
462             =item * B<-tx_rollback> => I<str>
463              
464             For more information on transaction, see L<Rinci::Transaction>.
465              
466             =item * B<-tx_v> => I<str>
467              
468             For more information on transaction, see L<Rinci::Transaction>.
469              
470             =back
471              
472             Returns an enveloped result (an array).
473              
474             First element (status) is an integer containing HTTP status code
475             (200 means OK, 4xx caller error, 5xx function error). Second element
476             (msg) is a string containing error message, or 'OK' if status is
477             200. Third element (result) is optional, the actual result. Fourth
478             element (meta) is called result metadata and is optional, a hash
479             that contains extra information.
480              
481             Return value: (any)
482              
483             =for HTML <p><img src="http://blogs.perl.org/users/perlancar/screenshot-trashu.jpg" /><br />
484              
485             =head1 HOMEPAGE
486              
487             Please visit the project's homepage at L<https://metacpan.org/release/File-Trash-Undoable>.
488              
489             =head1 SOURCE
490              
491             Source repository is at L<https://github.com/sharyanto/perl-File-Trash-Undoable>.
492              
493             =head1 BUGS
494              
495             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=File-Trash-Undoable>
496              
497             When submitting a bug or request, please include a test-file or a
498             patch to an existing test-file that illustrates the bug or desired
499             feature.
500              
501             =head1 SEE ALSO
502              
503             =over 4
504              
505             =item * B<gvfs-trash>
506              
507             A command-line utility, part of the GNOME project.
508              
509             =item * B<trash-cli>, https://github.com/andreafrancia/trash-cli
510              
511             A Python-based command-line application. Also follows freedesktop.org trash
512             specification.
513              
514             =item * B<rmv>, http://code.google.com/p/rmv/
515              
516             A bash script. Features undo ("rollback"). At the time of this writing, does not
517             support per-filesystem trash (everything goes into home trash).
518              
519             =back
520              
521             =head1 AUTHOR
522              
523             perlancar <perlancar@cpan.org>
524              
525             =head1 COPYRIGHT AND LICENSE
526              
527             This software is copyright (c) 2016 by perlancar@cpan.org.
528              
529             This is free software; you can redistribute it and/or modify it under
530             the same terms as the Perl 5 programming language system itself.
531              
532             =cut