File Coverage

blib/lib/File/Append/Undoable.pm
Criterion Covered Total %
statement 54 55 98.1
branch 22 34 64.7
condition 10 14 71.4
subroutine 7 7 100.0
pod 1 1 100.0
total 94 111 84.6


line stmt bran cond sub pod time code
1             package File::Append::Undoable;
2              
3             our $DATE = '2017-07-10'; # DATE
4             our $VERSION = '0.05'; # VERSION
5              
6 1     1   61262 use 5.010001;
  1         6  
7 1     1   8 use strict;
  1         3  
  1         35  
8 1     1   10 use warnings;
  1         4  
  1         46  
9 1     1   4929 use Log::ger;
  1         124  
  1         9  
10              
11 1     1   2403 use File::Trash::Undoable;
  1         17279  
  1         72  
12 1     1   704 use File::Copy;
  1         3049  
  1         967  
13              
14             our %SPEC;
15              
16             $SPEC{append} = {
17             v => 1.1,
18             summary => 'Append string to a file, with undo support',
19             description => <<'_',
20              
21             On do, will trash file, copy it to original location (with the same permission
22             and ownership as the original) and append the string to the end of file. On undo
23             will trash the new file and untrash the original.
24              
25             Some notes:
26              
27             * Chown will not be done if we are not running as root.
28              
29             * Symlink is currently not permitted.
30              
31             * Since transaction requires the function to be idempotent, in the `check_state`
32             phase the function will check if the string has been appended. It will refuse
33             to append the same string twice.
34              
35             * Take care not to use string that are too large, as the string, being a
36             function parameter, is entered into the transaction table.
37              
38             Fixed state: file exists and string has been appended to end of file.
39              
40             Fixable state: file exists and string has not been appended to end of file.
41              
42             Unfixable state: file does not exist or path is not a regular file (directory
43             and symlink included).
44              
45             _
46             args => {
47             path => {
48             summary => 'The file to append',
49             schema => 'str*',
50             req => 1,
51             pos => 0,
52             },
53             string => {
54             summary => 'The string to append to file',
55             req => 1,
56             pos => 1,
57             },
58             },
59             features => {
60             tx => {v=>2},
61             idempotent => 1,
62             },
63             };
64             sub append {
65 28     28 1 2566277 my %args = @_;
66              
67             # TMP, schema
68 28   50     407 my $tx_action = $args{-tx_action} // '';
69             my $taid = $args{-tx_action_id}
70 28 100       347 or return [400, "Please specify -tx_action_id"];
71 23         96 my $dry_run = $args{-dry_run};
72 23         90 my $path = $args{path};
73 23 50       108 defined($path) or return [400, "Please specify path"];
74 23 50       117 defined($args{string}) or return [400, "Please specify string"];
75 23         80 my $string = "$args{string}";
76              
77 23         638 my $is_sym = (-l $path);
78 23         266 my @st = stat($path);
79 23   100     224 my $exists = $is_sym || (-e _);
80 23         71 my $is_file = (-f _);
81 23         64 my $size = (-s _);
82              
83 23 100       200 if ($tx_action eq 'check_state') {
    50          
84 14 100       84 return [412, "File $path does not exist"] unless $exists;
85 13 100 100     153 return [412, "File $path is not a regular file"] if $is_sym||!$is_file;
86 11 50       50 return [500, "File $path can't be stat'd"] unless @st;
87              
88 11 50       57 if ($size >= length($string)) {
89 11         28 my $buf;
90 11 50       512 open my($fh),"<",$path or return [500, "Can't open file $path: $!"];
91 11         92 seek $fh, $size-length($string), 0;
92 11         149 read $fh, $buf, length($string);
93 11 100 66     188 if (defined($buf) && $buf eq $string) {
94 2         104 return [304, "File $path already appended with string, ".
95             "won't append twice"];
96             }
97             }
98 9 50       50 log_info("(DRY) Appending string to file $path ...") if $dry_run;
99 9         495 return [200, "File $path needs to be appended with a string", undef,
100             {undo_actions=>[
101             ['File::Trash::Undoable::untrash', # restore original
102             {path=>$path, suffix=>substr($taid,0,8)}],
103             ['File::Trash::Undoable::trash', # trash new file
104             {path=>$path, suffix=>substr($taid,0,8)."n"}],
105             ]}];
106             } elsif ($tx_action eq 'fix_state') {
107 9         100 log_info("Appending string to file $path ...");
108 9         129 my $res = File::Trash::Undoable::trash(
109             -tx_action=>'fix_state', path=>$path, suffix=>substr($taid,0,8));
110 9 50 33     45349 return $res unless $res->[0] == 200 || $res->[0] == 304;
111 9 50       94 copy $res->[2], $path
112             or return [500, "Can't copy from $res->[2]: $!"];
113 9 50       3591 open my($fh), ">>", $path or return [500, "Can't open for append: $!"];
114 9         102 print $fh $string;
115 9 50       151 close $fh or return [500, "Can't close: $!"];
116 9         166 chmod $st[2] & 07777, $path; # XXX ignore error?
117 9 50       75 unless ($>) { chown $st[4], $st[5], $path } # XXX ignore error?
  9         123  
118 9         1886 return [200, "OK"];
119             }
120 0           [400, "Invalid -tx_action"];
121             }
122              
123             1;
124             # ABSTRACT: Append string to a file, with undo support
125              
126             __END__
127              
128             =pod
129              
130             =encoding UTF-8
131              
132             =head1 NAME
133              
134             File::Append::Undoable - Append string to a file, with undo support
135              
136             =head1 VERSION
137              
138             This document describes version 0.05 of File::Append::Undoable (from Perl distribution File-Append-Undoable), released on 2017-07-10.
139              
140             =head1 FUNCTIONS
141              
142              
143             =head2 append
144              
145             Usage:
146              
147             append(%args) -> [status, msg, result, meta]
148              
149             Append string to a file, with undo support.
150              
151             On do, will trash file, copy it to original location (with the same permission
152             and ownership as the original) and append the string to the end of file. On undo
153             will trash the new file and untrash the original.
154              
155             Some notes:
156              
157             =over
158              
159             =item * Chown will not be done if we are not running as root.
160              
161             =item * Symlink is currently not permitted.
162              
163             =item * Since transaction requires the function to be idempotent, in the C<check_state>
164             phase the function will check if the string has been appended. It will refuse
165             to append the same string twice.
166              
167             =item * Take care not to use string that are too large, as the string, being a
168             function parameter, is entered into the transaction table.
169              
170             =back
171              
172             Fixed state: file exists and string has been appended to end of file.
173              
174             Fixable state: file exists and string has not been appended to end of file.
175              
176             Unfixable state: file does not exist or path is not a regular file (directory
177             and symlink included).
178              
179             This function is not exported.
180              
181             This function is idempotent (repeated invocations with same arguments has the same effect as single invocation). This function supports transactions.
182              
183              
184             Arguments ('*' denotes required arguments):
185              
186             =over 4
187              
188             =item * B<path>* => I<str>
189              
190             The file to append.
191              
192             =item * B<string>* => I<any>
193              
194             The string to append to file.
195              
196             =back
197              
198             Special arguments:
199              
200             =over 4
201              
202             =item * B<-tx_action> => I<str>
203              
204             For more information on transaction, see L<Rinci::Transaction>.
205              
206             =item * B<-tx_action_id> => I<str>
207              
208             For more information on transaction, see L<Rinci::Transaction>.
209              
210             =item * B<-tx_recovery> => I<str>
211              
212             For more information on transaction, see L<Rinci::Transaction>.
213              
214             =item * B<-tx_rollback> => I<str>
215              
216             For more information on transaction, see L<Rinci::Transaction>.
217              
218             =item * B<-tx_v> => I<str>
219              
220             For more information on transaction, see L<Rinci::Transaction>.
221              
222             =back
223              
224             Returns an enveloped result (an array).
225              
226             First element (status) is an integer containing HTTP status code
227             (200 means OK, 4xx caller error, 5xx function error). Second element
228             (msg) is a string containing error message, or 'OK' if status is
229             200. Third element (result) is optional, the actual result. Fourth
230             element (meta) is called result metadata and is optional, a hash
231             that contains extra information.
232              
233             Return value: (any)
234              
235             =head1 HOMEPAGE
236              
237             Please visit the project's homepage at L<https://metacpan.org/release/File-Append-Undoable>.
238              
239             =head1 SOURCE
240              
241             Source repository is at L<https://github.com/perlancar/perl-File-Append-Undoable>.
242              
243             =head1 BUGS
244              
245             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=File-Append-Undoable>
246              
247             When submitting a bug or request, please include a test-file or a
248             patch to an existing test-file that illustrates the bug or desired
249             feature.
250              
251             =head1 SEE ALSO
252              
253             L<Rinci::Transaction>
254              
255             =head1 AUTHOR
256              
257             perlancar <perlancar@cpan.org>
258              
259             =head1 COPYRIGHT AND LICENSE
260              
261             This software is copyright (c) 2017, 2015, 2014, 2012 by perlancar@cpan.org.
262              
263             This is free software; you can redistribute it and/or modify it under
264             the same terms as the Perl 5 programming language system itself.
265              
266             =cut