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 |