File Coverage

blib/lib/Setup/File.pm
Criterion Covered Total %
statement 349 389 89.7
branch 207 282 73.4
condition 153 196 78.0
subroutine 19 19 100.0
pod 8 8 100.0
total 736 894 82.3


line stmt bran cond sub pod time code
1             package Setup::File;
2              
3             our $DATE = '2017-07-10'; # DATE
4             our $VERSION = '0.23'; # VERSION
5              
6 10     10   409189 use 5.010001;
  10         47  
7 10     10   73 use strict;
  10         23  
  10         253  
8 10     10   62 use warnings;
  10         26  
  10         341  
9 10     10   38103 use Log::ger;
  10         984  
  10         58  
10              
11 10     10   17703 use File::Trash::Undoable;
  10         122596  
  10         432  
12 10     10   95 use File::MoreUtil qw(dir_empty);
  10         29  
  10         26928  
13              
14             require Exporter;
15             our @ISA = qw(Exporter);
16             our @EXPORT_OK = qw(setup_file);
17              
18             our %SPEC;
19              
20             $SPEC{':package'} = {
21             v => 1.1,
22             summary => 'Setup file (existence, mode, permission, content)',
23             };
24              
25             $SPEC{rmdir} = {
26             v => 1.1,
27             summary => 'Delete directory',
28             description => <<'_',
29              
30             Fixed state: `path` doesn't exist.
31              
32             Fixable state: `path` exists and is a directory (or, a symlink to a directory,
33             if `allow_symlink` option is enabled).
34              
35             Unfixable state: `path` exists but is not a directory.
36              
37             _
38             args => {
39             path => {
40             schema => 'str*',
41             req => 1,
42             pos => 0,
43             },
44             allow_symlink => {
45             schema => [bool => {default => 0}],
46             summary => 'Whether to regard symlink to a directory as directory',
47             },
48             delete_nonempty_dir => {
49             schema => [bool => {}],
50             summary => 'Whether to delete non-empty directory',
51             description => <<'_',
52              
53             If set to true, will delete non-empty directory.
54              
55             If set to false, will never delete non-empty directory.
56              
57             If unset (default), will ask for confirmation first by returning status 331.
58             Caller can confirm by passing special argument `-confirm`.
59              
60             _
61             },
62             },
63             features => {
64             tx => {v=>2},
65             idempotent => 1,
66             },
67             };
68             sub rmdir {
69 124     124 1 8829721 my %args = @_;
70              
71             # TMP, schema
72 124   50     1546 my $tx_action = $args{-tx_action} // '';
73             my $taid = $args{-tx_action_id}
74 124 100       866 or return [412, "Please specify -tx_action_id"];
75 115         443 my $dry_run = $args{-dry_run};
76 115         485 my $path = $args{path};
77 115 50       556 defined($path) or return [400, "Please specify path"];
78 115   50     578 my $allow_sym = $args{allow_symlink} // 0;
79              
80 115         2695 my $is_sym = (-l $path);
81 115   100     1140 my $exists = $is_sym || (-e _);
82 115         380 my $is_dir = (-d _);
83 115   100     1183 my $is_sym_to_dir = $is_sym && (-d $path);
84 115   100     1255 my $empty = $exists && dir_empty($path);
85              
86 115         11865 my @undo;
87              
88             #$log->tracef("path=%s, exists=%s, is_dir=%s, allow_sym=%s, is_sym_to_dir=%s", $path, $exists, $is_dir, $allow_sym, $is_sym_to_dir);
89 115 100       767 if ($tx_action eq 'check_state') {
    50          
90 63 100 100     764 return [412, "Not a dir"] if $exists &&
      100        
91             !($is_dir || $allow_sym && $is_sym_to_dir);
92 61 100       265 if ($exists) {
93 55 100       238 if (!$empty) {
94 15         53 my $d = $args{delete_nonempty_dir};
95 15 100 100     145 if (defined($d) && !$d) {
    100          
96 1         46 return [412, "Dir $path is not empty, but instructed ".
97             "never to remove non-empty dir"];
98             } elsif (!defined($d)) {
99 7 100       134 if (!$args{-confirm}) {
100 2         66 return [331, "Dir $path not empty, confirm delete?"];
101             }
102             }
103             }
104 52 50       282 log_info("(DRY) Removing dir $path ...") if $dry_run;
105 52         584 unshift @undo, (
106             ['File::Trash::Undoable::untrash' =>
107             {path=>$path, suffix=>substr($taid,0,8)}],
108             );
109             }
110 58 100       276 if (@undo) {
111 52         2173 return [200, "Dir $path needs to be removed", undef,
112             {undo_actions=>\@undo}];
113             } else {
114 6         193 return [304, "Dir $path already does not exist"];
115             }
116             } elsif ($tx_action eq 'fix_state') {
117 52         706 return File::Trash::Undoable::trash(
118             -tx_action=>'fix_state', suffix=>substr($taid,0,8), path=>$path);
119             }
120 0         0 [400, "Invalid -tx_action"];
121             }
122              
123             $SPEC{mkdir} = {
124             v => 1.1,
125             summary => 'Create directory',
126             description => <<'_',
127              
128             Fixed state: `path` exists and is a directory.
129              
130             Fixable state: `path` doesn't exist.
131              
132             Unfixable state: `path` exists and is not a directory.
133              
134             _
135             args => {
136             path => {
137             summary => 'Path to directory',
138             schema => 'str*',
139             req => 1,
140             pos => 0,
141             },
142             allow_symlink => {
143             summary => 'Whether to regard symlink to a directory as directory',
144             schema => 'str*',
145             },
146             mode => {
147             summary => 'Set mode for the newly created directory',
148             schema => 'str*',
149             },
150             },
151             features => {
152             tx => {v=>2},
153             idempotent => 1,
154             },
155             };
156             sub mkdir {
157 80     80 1 3986411 my %args = @_;
158              
159             # TMP, schema
160 80   50     782 my $tx_action = $args{-tx_action} // '';
161 80         324 my $dry_run = $args{-dry_run};
162 80         291 my $path = $args{path};
163 80 50       366 defined($path) or return [400, "Please specify path"];
164 80   100     704 my $allow_sym = $args{allow_symlink} // 0;
165 80   50     624 my $mode = $args{mode} // 0755; # XXX use umask
166 80 50       592 return [412, "Invalid mode '$mode', please use numeric only"]
167             if $mode =~ /\D/;
168              
169 80         1286 my $is_sym = (-l $path);
170 80   100     567 my $exists = $is_sym || (-e _);
171 80         236 my $is_dir = (-d _);
172 80   100     484 my $is_sym_to_dir = $is_sym && (-d $path);
173              
174 80 100       595 if ($tx_action eq 'check_state') {
    50          
175 52         132 my @undo;
176 52 100 100     755 return [412, "$path is not a dir"] if $exists &&
      100        
177             !($is_dir || $allow_sym && $is_sym_to_dir);
178 46 100       216 if (!$exists) {
179 29         228 unshift @undo, [rmdir => {path => $path}];
180             }
181 46 100       224 if (@undo) {
182 29 50       128 log_info("(DRY) Creating dir $path ...") if $dry_run;
183 29         1248 return [200, "Dir $path needs to be created", undef,
184             {undo_actions=>\@undo}];
185             } else {
186 17         327 return [304, "Dir $path already exists"];
187             }
188             } elsif ($tx_action eq 'fix_state') {
189 28         306 log_info("Creating dir $path ...");
190 28 50       3347 if (CORE::mkdir($path, $mode)) {
191 28         1233 return [200, "Fixed"];
192             } else {
193 0         0 return [500, "Can't mkdir $path: $!"];
194             }
195             }
196 0         0 [400, "Invalid -tx_action"];
197             }
198              
199             $SPEC{chmod} = {
200             v => 1.1,
201             summary => "Set file's permission mode",
202             description => <<'_',
203              
204             Fixed state: `path` exists and mode is already correct.
205              
206             Fixable state: `path` exists but mode is not correct.
207              
208             Unfixable state: `path` doesn't exist.
209              
210             _
211             args => {
212             path => {
213             summary => 'Path to file/directory',
214             schema => 'str*',
215             req => 1,
216             pos => 0,
217             },
218             mode => {
219             summary => 'Permission mode, either numeric or symbolic (e.g. a+w)',
220             schema => 'str*',
221             req => 1,
222             pos => 1,
223             },
224             follow_symlink => {
225             summary => 'Whether to follow symlink',
226             schema => [bool => {default=>0}],
227             },
228             orig_mode => {
229             summary=>'If set, confirm if current mode is not the same as this',
230             schema => 'int',
231             },
232             },
233             features => {
234             tx => {v=>2},
235             idempotent => 1,
236             },
237             };
238             sub chmod {
239 413     413 1 12014833 require File::chmod;
240              
241 413         14344 my %args = @_;
242              
243 413         1661 local $File::chmod::UMASK = 0;
244              
245             # TMP, schema
246 413   50     3290 my $tx_action = $args{-tx_action} // '';
247 413         2023 my $dry_run = $args{-dry_run};
248 413         1713 my $path = $args{path};
249 413 50       2040 defined($path) or return [400, "Please specify path"];
250 413   100     2329 my $follow_sym = $args{follow_symlink} // 0;
251 413         1397 my $orig_mode = $args{orig_mode};
252 413         1337 my $want_mode = $args{mode};
253 413 50       1830 defined($want_mode) or return [400, "Please specify mode"];
254              
255 413         7496 my $is_sym = (-l $path);
256 413 50 33     4479 return [412, "$path is a symlink"] if !$follow_sym && $is_sym;
257 413   66     3346 my $exists = $is_sym || (-e _);
258 413         5777 my @st = stat($path);
259 413 100       2577 my $cur_mode = $st[2] & 07777 if $exists;
260 413 100 100     5801 if (!$args{-tx_recovery} && defined($orig_mode) && defined($cur_mode) &&
      66        
      100        
      100        
261             $cur_mode != $orig_mode && !$args{-confirm}) {
262 1         25 return [331, "File $path has changed permission mode, confirm chmod?"];
263             }
264 412 100       2984 if ($want_mode =~ /\D/) {
265 24 50       116 return [412, "Symbolic mode ($want_mode) requires path $path to exist"]
266             unless $exists;
267 24         155 $want_mode = File::chmod::getchmod($want_mode, $path);
268             }
269              
270             #$log->tracef("path=%s, cur_mode=%04o, want_mode=%04o", $path, $cur_mode, $want_mode);
271 412 100       7373 if ($tx_action eq 'check_state') {
    50          
272 219         603 my @undo;
273 219 100       955 return [412, "Path $path doesn't exist"] if !$exists;
274 217 100       1000 if ($cur_mode != $want_mode) {
275 197 50       817 log_info("(DRY) chmod %s to %04o ...", $path, $want_mode)
276             if $dry_run;
277 197         1982 unshift @undo, [chmod => {
278             path => $path, mode=>$cur_mode, orig_mode=>$want_mode,
279             follow_symlink => $follow_sym,
280             }];
281             }
282 217 100       1723 if (@undo) {
283 197 50       1001 log_info("(DRY) Chmod %s to %04o ...", $path, $want_mode)
284             if $dry_run;
285 197         9162 return [200, "Path $path needs to be chmod'ed to ".
286             sprintf("%04o", $want_mode), undef,
287             {undo_actions=>\@undo}];
288             } else {
289 20         808 return [304, "Fixed, mode already ".sprintf("%04o", $cur_mode)];
290             }
291             } elsif ($tx_action eq 'fix_state') {
292 193         1822 log_info("Chmod %s to %04o ...", $path, $want_mode);
293 193 50       5739 if (CORE::chmod($want_mode, $path)) {
294 193         8648 return [200, "Fixed"];
295             } else {
296 0         0 return [500, "Can't chmod $path, $want_mode: $!"];
297             }
298             }
299 0         0 [400, "Invalid -tx_action"];
300             }
301              
302             $SPEC{chown} = {
303             v => 1.1,
304             summary => "Set file's ownership",
305             description => <<'_',
306              
307             Fixed state: `path` exists and ownership is already correct.
308              
309             Fixable state: `path` exists but ownership is not correct.
310              
311             Unfixable state: `path` doesn't exist.
312              
313             _
314             args => {
315             path => {
316             summary => 'Path to file/directory',
317             schema => 'str*',
318             req => 1,
319             pos => 0,
320             },
321             owner => {
322             summary => 'Numeric UID or username',
323             schema => 'str*',
324             },
325             group => {
326             summary => 'Numeric GID or group',
327             schema => 'str*',
328             },
329             follow_symlink => {
330             summary => 'Whether to follow symlink',
331             schema => [bool => {default=>0}],
332             },
333             orig_owner => {
334             summary=>'If set, confirm if current owner is not the same as this',
335             schema => 'str',
336             },
337             orig_group => {
338             summary=>'If set, confirm if current group is not the same as this',
339             schema => 'str',
340             },
341             },
342             features => {
343             tx => {v=>2},
344             idempotent => 1,
345             },
346             };
347             sub chown {
348 20     20 1 773626 require Lchown;
349 20 50       1923 return [412, "lchown() is not available on this system"] unless
350             Lchown::LCHOWN_AVAILABLE();
351              
352 20         336 my %args = @_;
353              
354             # TMP, schema
355 20   50     130 my $tx_action = $args{-tx_action} // '';
356 20         66 my $dry_run = $args{-dry_run};
357 20         63 my $path = $args{path};
358 20 50       100 defined($path) or return [400, "Please specify path"];
359 20   100     100 my $follow_sym = $args{follow_symlink} // 0;
360 20         58 my $orig_owner = $args{orig_owner};
361 20         52 my $orig_group = $args{orig_group};
362 20         51 my $want_owner = $args{owner};
363 20         63 my $want_group = $args{group};
364 20 50 66     146 defined($want_owner) || defined($want_group)
365             or return [400, "Please specify at least either owner/group"];
366              
367 20         51 my ($orig_uid, $orig_uname);
368 20 50       86 if (defined $orig_owner) {
369 0 0       0 if ($orig_owner =~ /\A\d+\z/) {
370 0         0 $orig_uid = $orig_owner;
371 0         0 my @ent = getpwuid($orig_uid);
372 0 0       0 $orig_uname = $ent[0] if @ent;
373             } else {
374 0         0 $orig_uname = $orig_owner;
375 0         0 my @ent = getpwnam($orig_uname);
376 0 0       0 return [412, "User doesn't exist: $orig_uname"] unless @ent;
377 0         0 $orig_uid = $ent[2];
378             }
379             }
380              
381 20         52 my ($want_uid, $want_uname);
382 20 100       85 if (defined $want_owner) {
383 14 100       91 if ($want_owner =~ /\A\d+\z/) {
384 6         61 $want_uid = $want_owner;
385 6         2099 my @ent = getpwuid($want_uid);
386 6 50       54 $want_uname = $ent[0] if @ent;
387             } else {
388 8         16 $want_uname = $want_owner;
389 8         1424 my @ent = getpwnam($want_uname);
390 8 50       52 return [412, "User doesn't exist: $want_uname"] unless @ent;
391 8         28 $want_uid = $ent[2];
392             }
393             }
394              
395 20         58 my ($orig_gid, $orig_gname);
396 20 50       79 if (defined $orig_group) {
397 0 0       0 if ($orig_group =~ /\A\d+\z/) {
398 0         0 $orig_gid = $orig_group;
399 0         0 my @grent = getgrgid($orig_gid);
400 0 0       0 $orig_gname = $grent[0] if @grent;
401             } else {
402 0         0 $orig_gname = $orig_group;
403 0         0 my @grent = getgrnam($orig_gname);
404 0 0       0 return [412, "Group doesn't exist: $orig_gname"] unless @grent;
405 0         0 $orig_gid = $grent[2];
406             }
407             }
408              
409 20         56 my ($want_gid, $want_gname);
410 20 100       74 if (defined $want_group) {
411 14 100       126 if ($want_group =~ /\A\d+\z/) {
412 6         24 $want_gid = $want_group;
413 6         1054 my @grent = getgrgid($want_gid);
414 6 50       112 $want_gname = $grent[0] if @grent;
415             } else {
416 8         21 $want_gname = $want_group;
417 8         323 my @grent = getgrnam($want_gname);
418 8 50       41 return [412, "Group doesn't exist: $want_gname"] unless @grent;
419 8         24 $want_gid = $grent[2];
420             }
421             }
422              
423 20         269 my @st = lstat($path);
424 20         75 my $is_sym = (-l _);
425 20   66     139 my $exists = $is_sym || (-e _);
426 20 100 66     117 if ($follow_sym && $exists) {
427 12         126 @st = stat($path);
428 12 50       58 return [500, "Can't stat $path (2): $!"] unless @st;
429             }
430 20         51 my $cur_uid = $st[4];
431 20         41 my $cur_gid = $st[5];
432 20 50 33     176 if (!$args{-tx_recovery} && !$args{-confirm}) {
433 20   33     191 my $changed = defined($orig_uid) && $orig_uid != $cur_uid ||
434             defined($orig_gid) && $orig_gid != $cur_gid;
435 20 50       71 return [331, "File $path has changed ownership, confirm chown?"]
436             if $changed;
437             }
438              
439             #$log->tracef("path=%s, cur_uid=%s, cur_gid=%s, want_uid=%s, want_uname=%s, want_gid=%s, want_gname=%s", $cur_uid, $cur_gid, $want_uid, $want_uname, $want_gid, $want_gname);
440 20 100       97 if ($tx_action eq 'check_state') {
    50          
441 15         32 my @undo;
442 15 100       83 return [412, "$path doesn't exist"] if !$exists;
443 13 100 100     154 if (defined($want_uid) && $cur_uid != $want_uid ||
      100        
      100        
444             defined($want_gid) && $cur_gid != $want_gid) {
445 6 50       26 log_info("(DRY) Chown %s to (%s, %s)",
446             $path, $want_owner, $want_group) if $dry_run;
447 6 100 66     104 unshift @undo, [chown => {
    100 100        
448             path => $path,
449             owner => (defined($want_uid) &&
450             $cur_uid != $want_uid ? $cur_uid : undef),
451             group => (defined($want_gid) &&
452             $cur_gid != $want_gid ? $cur_gid : undef),
453             orig_owner => $want_owner, orig_group => $want_group,
454             follow_symlink => $follow_sym,
455             }];
456             }
457 13 100       78 if (@undo) {
458 6   100     250 return [200, "Path $path needs to be chown'ed to ".
      100        
459             "(".($want_owner // "-").", ".($want_group // "-").")",
460             undef, {undo_actions=>\@undo}];
461             } else {
462 7         211 return [304, "Path $path already has correct owner and group"];
463             }
464             } elsif ($tx_action eq 'fix_state') {
465 5         14 my $res;
466 5 100 100     91 log_info("%schown %path to (%s, %s) ...", $follow_sym ? "" : "l",
      100        
467             $path, $want_uid // -1, $want_gid // -1);
468 5 100       41 if ($follow_sym) {
469 4   100     185 $res = CORE::chown ($want_uid // -1, $want_gid // -1, $path);
      100        
470             } else {
471 1   50     24 $res = Lchown::lchown($want_uid // -1, $want_gid // -1, $path);
      50        
472             }
473 5 50       25 if ($res) {
474 5         188 return [200, "Fixed"];
475             } else {
476 0   0     0 return [500, "Can't chown $path, ".($want_uid // -1).", ".
      0        
477             ($want_gid // -1).": $!"];
478             }
479             }
480 0         0 [400, "Invalid -tx_action"];
481             }
482              
483             $SPEC{rmfile} = {
484             v => 1.1,
485             summary => 'Delete file',
486             description => <<'_',
487              
488             Fixed state: `path` doesn't exist.
489              
490             Fixable state: `path` exists and is a file (or, a symlink to a file, if
491             `allow_symlink` option is enabled).
492              
493             Unfixable state: `path` exists but is not a file.
494              
495             _
496             args => {
497             path => {
498             schema => 'str*',
499             req => 1,
500             pos => 0,
501             },
502             allow_symlink => {
503             schema => [bool => {default => 0}],
504             summary => 'Whether to regard symlink to a file as file',
505             },
506             orig_content => {
507             summary =>
508             'If set, confirm if current content is not the same as this',
509             description => <<'_',
510              
511             Alternatively, you can use `orig_content_hash`.
512              
513             _
514             schema => 'str',
515             },
516             orig_content_md5 => {
517             summary =>
518             'If set, confirm if current content MD5 hash '.
519             'is not the same as this',
520             description => <<'_',
521              
522             MD5 hash should be expressed in hex (e.g. bed6626e019e5870ef01736b3553e570).
523              
524             Alternatively, you can use `orig_content` (for shorter content).
525              
526             _
527             schema => 'str',
528             },
529             suffix => {
530             summary => 'Use this suffix when trashing',
531             schema => 'str',
532             },
533             },
534             features => {
535             tx => {v=>2},
536             idempotent => 1,
537             },
538             };
539             sub rmfile {
540 216     216 1 16473479 my %args = @_;
541              
542             # TMP, schema
543 216   50     1617 my $tx_action = $args{-tx_action} // '';
544             my $taid = $args{-tx_action_id}
545 216 100       1338 or return [400, "Please specify -tx_action_id"];
546 204         853 my $dry_run = $args{-dry_run};
547 204         823 my $path = $args{path};
548 204 50       991 defined($path) or return [400, "Please specify path"];
549 204   50     1265 my $allow_sym = $args{allow_symlink} // 0;
550 204   66     2194 my $suffix = $args{suffix} // substr($taid,0,8);
551              
552 204         3934 my $is_sym = (-l $path);
553 204   100     1818 my $exists = $is_sym || (-e _);
554 204         815 my $is_file = (-f _);
555 204   100     1157 my $is_sym_to_file = $is_sym && (-f $path);
556              
557 204         751 my @undo;
558              
559             #$log->tracef("path=%s, exists=%s, is_file=%s, allow_sym=%s, is_sym_to_file=%s", $path, $exists, $is_file, $allow_sym, $is_sym_to_file);
560 204 100       1308 if ($tx_action eq 'check_state') {
    50          
561 109 100 100     1124 return [412, "Path $path is not a file"] if $exists &&
      100        
562             !($is_file || $allow_sym && $is_sym_to_file);
563 107 100       810 if ($exists) {
564 99 100 100     1189 if (!$args{-confirm} && (defined($args{orig_content}) ||
      100        
565             defined($args{orig_content_md5}))) {
566 68 100       321 if (defined $args{orig_content}) {
567 9         103 require File::Slurper;
568 9         39 my $ct = eval { File::Slurper::read_text($path) };
  9         69  
569 9 50       1295 return [500, "Can't read file $path: $!"]
570             unless defined($ct);
571             return [331, "File $path has changed content, confirm ".
572 9 100       126 "delete?"] if $ct ne $args{orig_content};
573             }
574 66 100       289 if (defined $args{orig_content_md5}) {
575 59         641 require Digest::MD5;
576 59 50       2742 return [500, "Can't open file $path: $!"]
577             unless open my($fh), "<", $path;
578 59         941 my $ctx = Digest::MD5->new;
579 59         1642 $ctx->addfile($fh);
580             return [331, "File $path has changed content, confirm ".
581             "delete?"]
582 59 100       1459 if $ctx->hexdigest ne $args{orig_content_md5};
583             }
584             }
585 95 50       500 log_info("(DRY) Removing file $path ...") if $dry_run;
586 95         836 unshift @undo, (
587             ['File::Trash::Undoable::untrash' =>
588             {path=>$path, suffix=>$suffix}],
589             );
590             }
591 103 100       621 if (@undo) {
592 95         4756 return [200, "File $path needs to be removed",
593             undef, {undo_actions=>\@undo}];
594             } else {
595 8         290 return [304, "File $path already does not exist"];
596             }
597             } elsif ($tx_action eq 'fix_state') {
598 95         1782 return File::Trash::Undoable::trash(
599             -tx_action=>'fix_state', suffix=>$suffix, path=>$path);
600             }
601 0         0 [400, "Invalid -tx_action"];
602             }
603              
604             $SPEC{mkfile} = {
605             v => 1.1,
606             summary => 'Create file (and/or set content)',
607             description => <<'_',
608              
609             Fixed state: `path` exists, is a file, and content is correct.
610              
611             Fixable state: `path` doesn't exist. Or `path` exists, is a file, and content is
612             incorrect. Or `orig_path` specified and exists.
613              
614             Unfixable state: `path` exists and is not a file.
615              
616             _
617             args => {
618             path => {
619             summary => 'Path to file',
620             schema => 'str*',
621             req => 1,
622             pos => 0,
623             },
624             allow_symlink => {
625             summary => 'Whether to regard symlink to a file as file',
626             schema => 'str*',
627             },
628             content => {
629             schema => 'str',
630             summary => 'Desired file content',
631             description => <<'_',
632              
633             Alternatively you can also use `content_md5`, or `gen_content_func` and
634             `check_content_func`.
635              
636             _
637             },
638             content_md5 => {
639             schema => 'str',
640             summary => 'Check content against MD5 hash',
641             description => <<'_',
642              
643             MD5 hash should be expressed in hex (e.g. bed6626e019e5870ef01736b3553e570).
644              
645             Used when checking content of existing file.
646              
647             Alternatively you can also use `content`, or `check_content_func`.
648              
649             _
650             },
651             check_content_func => {
652             schema => 'str',
653             summary => 'Name of function to check content',
654             description => <<'_',
655              
656             If unset, file will not be checked for its content. If set, function will be
657             called whenever file content needs to be checked. Function will be passed the
658             reference to file content and should return a boolean value indicating whether
659             content is acceptable. If it returns a false value, content is deemed
660             unacceptable and needs to be fixed.
661              
662             Alternatively you can use the simpler `content` or `content_md5` argument.
663              
664             _
665             },
666             gen_content_func => {
667             schema => 'str',
668             summary => 'Name of function to generate content',
669             description => <<'_',
670              
671             If set, whenever a new file content is needed (e.g. when file is created or file
672             content reset), this function will be called to provide it. If unset, empty
673             string will be used instead.
674              
675             Function will be passed the reference to the current content (or undef) and
676             should return the new content.
677              
678             Alternatively you can use the simpler `content` argument.
679              
680             _
681             },
682             suffix => {
683             schema => 'str',
684             },
685             },
686             features => {
687             tx => {v=>2},
688             idempotent => 1,
689             },
690             };
691             sub mkfile {
692 251     251 1 15312213 require Digest::MD5;
693 251         1695 require File::Slurper;
694              
695 251         2179 my %args = @_;
696              
697             # TMP, schema
698 251   50     2109 my $tx_action = $args{-tx_action} // '';
699             my $taid = $args{-tx_action_id}
700 251 100       1558 or return [400, "Please specify -tx_action_id"];
701 238         1872 my $dry_run = $args{-dry_run};
702 238         897 my $path = $args{path};
703 238 50       1325 defined($path) or return [400, "Please specify path"];
704 238   100     2424 my $allow_sym = $args{allow_symlink} // 0;
705 238   66     1976 my $suffix = $args{suffix} // substr($taid, 0, 8);
706              
707 238         4713 my @st = lstat($path);
708 238         1263 my $is_sym = (-l _);
709 238   100     1872 my $exists = $is_sym || (-e _);
710 238         706 my $is_file = (-f _);
711 238   100     1303 my $is_sym_to_file = $is_sym && (-f $path);
712 238 100 100     2022 return [412, "Path $path is not a file"] if $exists &&
      100        
713             !($is_file || $allow_sym && $is_sym_to_file);
714 235         1118 my $msg;
715              
716             my $fix_content;
717 235 100       1357 if ($exists) {
718 131         393 my $ct = eval { File::Slurper::read_text($path) };
  131         1099  
719 131 50       22634 return [500, "Can't read content of file $path: $!"]
720             unless defined($ct);
721 131         449 my $res;
722 131 100       1382 if (defined $args{check_content_func}) {
    100          
    100          
723 10     10   112 no strict 'refs';
  10         27  
  10         1622  
724 20         75 $fix_content = !(*{$args{check_content_func}}{CODE}->(\$ct));
  20         232  
725             } elsif (defined $args{content_md5}) {
726 20         304 $fix_content = Digest::MD5::md5_hex($ct) ne $args{content_md5};
727             } elsif (defined $args{content}) {
728 85         514 $fix_content = $ct ne $args{content};
729             }
730             }
731              
732 235 100       1664 if ($tx_action eq 'check_state') {
    50          
733              
734 136         470 my @undo;
735 136 100       505 if ($exists) {
736 84 100       439 if ($fix_content) {
737 67 50       348 log_info("(DRY) Replacing file $path ...") if $dry_run;
738 67         356 $msg = "File $path needs to be replaced";
739 67         859 unshift @undo, (
740             ["File::Trash::Undoable::untrash",
741             {path=>$path, suffix=>$suffix}],
742             ["File::Trash::Undoable::trash",
743             {path=>$path, suffix=>$suffix."n"}],
744             );
745             }
746             } else {
747 52         440 log_info("(DRY) File $path should be created");
748 52         295 my $ct = "";
749 52 100       351 if (defined $args{gen_content_func}) {
    100          
750 10     10   67 no strict 'refs';
  10         29  
  10         1931  
751 7         26 $ct = *{$args{gen_content_func}}{CODE}->(\$ct);
  7         123  
752             } elsif (defined $args{content}) {
753 24         81 $ct = $args{content};
754             }
755 52         516 my $md5 = Digest::MD5::md5_hex($ct);
756 52 50       223 log_info("(DRY) Creating file $path ...") if $dry_run;
757 52         199 $msg = "File $path needs to be created";
758 52         424 unshift @undo, [rmfile =>
759             {path => $path, suffix=>$suffix."n",
760             orig_content_md5=>$md5}];
761             }
762 136 100       732 if (@undo) {
763 119         4086 return [200, $msg, undef, {undo_actions=>\@undo}];
764             } else {
765 17         456 return [304, "File $path already exists"];
766             }
767              
768             } elsif ($tx_action eq 'fix_state') {
769              
770 99 100       524 if ($fix_content) {
771 47         537 my $res = File::Trash::Undoable::trash(
772             -tx_action=>'fix_state', path=>$path,
773             suffix=>$suffix);
774 47 50       103878 return $res unless $res->[0] == 200;
775             }
776              
777 99 50 66     1112 if ($fix_content || !$exists) {
778 99         429 my $ct = "";
779 99 100       917 if (defined $args{gen_content_func}) {
    100          
780 10     10   71 no strict 'refs';
  10         24  
  10         6281  
781 16         216 $ct = *{$args{gen_content_func}}{CODE}->(\$ct);
  16         212  
782             } elsif (defined $args{content}) {
783 53         271 $ct = $args{content};
784             }
785 99         1280 log_info("Creating file $path ...");
786 99 50       583 if (eval { File::Slurper::write_text($path, $ct); 1 }) {
  99         939  
  99         25854  
787 99         2743 CORE::chmod(0644, $path);
788 99         4852 return [200, "OK"];
789             } else {
790 0         0 return [500, "Can't write_file($path): $!"];
791             }
792             } else {
793             # shouldn't reach here
794 0         0 return [304, "Nothing done"];
795             }
796             }
797 0         0 [400, "Invalid -tx_action"];
798             }
799              
800             sub _setup_file_or_dir {
801 118     118   1002 my %args = @_;
802              
803 118         548 my $which = $args{-which}; # file or dir
804 118         494 my $Which = ucfirst $which;
805              
806             # TMP, SCHEMA
807             my $taid = $args{-tx_action_id}
808 118 100       891 or return [400, "Please specify -tx_action_id"];
809 100         365 my $dry_run = $args{-dry_run};
810 100         358 my $path = $args{path};
811 100 50       461 defined($path) or return [400, "Please specify path"];
812 100         471 my $should_exist = $args{should_exist};
813 100   50     487 my $allow_sym = $args{allow_symlink} // 1;
814 100   50     471 my $replace_file = $args{replace_file} // 1;
815 100   50     494 my $replace_dir = $args{replace_dir} // 1;
816 100   50     481 my $replace_sym = $args{replace_symlink} // 1;
817              
818 100         309 my $ct = $args{content};
819 100         355 my $ct_md5 = $args{content_md5};
820 100         292 my $check_ct = $args{check_content_func};
821 100         362 my $gen_ct = $args{gen_content_func};
822 100 50 25     1139 return [400, "If check_content_func is specified, ".
823             "gen_content_func must also be specified"]
824             if defined($check_ct) xor defined($gen_ct);
825 100 50 33     805 return [400, "If content is specified, then check_content_func/".
      66        
826             "gen_content_func must not be specified (and vice versa)"]
827             if defined($ct) && (defined($check_ct) || defined($gen_ct));
828              
829 100         1637 my $is_sym = (-l $path);
830 100         361 my $sym_exists = (-e _);
831 100 50       441 my $sym_target = readlink($path) if $is_sym;
832 100         924 my @st = stat($path); # stricture complains about _
833 100         402 my $exists = (-e _);
834 100         284 my $is_file = (-f _);
835 100         277 my $is_dir = (-d _);
836              
837             #$log->tracef("exists=%s, sym_exists=%s, is_sym=%s, sym_target=%s, is_file=%s, is_dir=%s", $exists, $sym_exists, $is_sym, $sym_target, $is_file, $is_dir);
838              
839 100         270 my (@do, @undo);
840              
841 100         816 my $act_trash = ["File::Trash::Undoable::trash" => {
842             path => $path,
843             suffix => substr($taid,0,8),
844             }];
845 100         705 my $act_untrash = ["File::Trash::Undoable::untrash" => {
846             path => $path,
847             suffix => substr($taid,0,8),
848             }];
849 100         722 my $act_trash_n = ["File::Trash::Undoable::trash" => {
850             path => $path,
851             suffix => substr($taid,0,8)."n",
852             }];
853 100         743 my $act_untrash_n = ["File::Trash::Undoable::untrash" => {
854             path => $path,
855             suffix => substr($taid,0,8)."n",
856             }];
857 100         886 my $act_mkfile = [mkfile => {
858             path => $path,
859             content => $ct,
860             content_md5 => $ct_md5,
861             check_content_func => $check_ct,
862             gen_content_func => $gen_ct,
863             suffix => substr($taid,0,8)."o",
864             }];
865 100         592 my $act_mkdir = [mkdir => {
866             path => $path,
867             }];
868              
869             {
870 100 100 100     309 if (defined($should_exist) && !$should_exist) {
  100         946  
871 18 100       76 if ($exists) {
872 14 50       62 log_info("(DRY) Removing $which $path ...") if $dry_run;
873 14         44 push @do , $act_trash;
874 14         48 unshift @undo, $act_untrash;
875             }
876 18         55 last;
877             }
878              
879 82 100 100     396 last if !defined($should_exist) && !$exists;
880              
881 80 50 33     1210 if (!$allow_sym && $is_sym) {
    50 66        
    100 100        
882 0 0       0 if (!$replace_sym) {
883 0         0 return [412,
884             "must replace symlink $path but instructed not to"];
885             }
886 0 0       0 log_info("(DRY) Replacing symlink $path with $which ...")
887             if $dry_run;
888 0         0 push @do , $act_trash;
889 0         0 unshift @undo, $act_untrash;
890             } elsif ($is_dir && $which eq 'file') {
891 0 0       0 if (!$replace_dir) {
892 0         0 return [412, "must replace dir $path but instructed not to"];
893             }
894 0 0       0 log_info("(DRY) Replacing file $path with $which ...")
895             if $dry_run;
896 0         0 push @do , $act_trash;
897 0         0 unshift @undo, $act_untrash;
898             } elsif (!$is_dir && $which eq 'dir') {
899 17 50       75 if (!$replace_file) {
900 0         0 return [412, "must replace file $path but instructed not to"];
901             }
902 17 50       101 log_info("(DRY) Replacing dir $path with $which ...")
903             if $dry_run;
904 17         64 push @do , $act_trash;
905 17         60 unshift @undo, $act_untrash;
906             }
907              
908 80 100       424 my $act_mk = $which eq 'file' ? $act_mkfile : $act_mkdir;
909 80 100       334 if (!$exists) {
910 41         118 push @do , $act_mk;
911 41         139 unshift @undo, $act_trash_n;
912             } else {
913             # get the undo actions from the mk action
914 10     10   156 no strict 'refs';
  10         28  
  10         6936  
915             my $res =
916 39         368 *{$act_mk->[0]}{CODE}->(
917 39         147 %{$act_mk->[1]},
  39         320  
918             -tx_action=>'check_state', -tx_action_id=>$taid,
919             );
920 39 100       266 if ($res->[0] == 200) {
    50          
921             push @do , $res->[3]{do_actions} ?
922 20 50       136 @{ $res->[3]{do_actions} } : $act_mk;
  0         0  
923 20         68 unshift @undo, @{ $res->[3]{undo_actions} };
  20         111  
924             } elsif ($res->[0] == 304) {
925             # do nothing
926             } else {
927 0         0 return $res;
928             }
929             }
930              
931 80 100       397 if (defined $args{mode}) {
932 40 100       210 my $cur_mode = @st ? $st[2] & 07777 : undef;
933             push @do, ["chmod" => {
934 40         631 path=>$path, mode=>$args{mode}}];
935 40 100       300 unshift @undo, ["chmod" => {
936             path=>$path, mode=>$cur_mode}] if defined($cur_mode);
937             }
938              
939 80 100       476 if (defined $args{owner}) {
940 4 100       17 my $cur_uid = @st ? $st[4] : undef;
941             push @do, ["chown" => {
942             path=>$path, follow_symlink=>$allow_sym,
943 4         37 owner=>$args{owner}}];
944 4 100       30 unshift @undo, ["chown" => {
945             path=>$path, follow_symlink=>$allow_sym,
946             mode=>$cur_uid}] if defined($cur_uid);
947             }
948              
949 80 100       374 if (defined $args{group}) {
950 4 100       18 my $cur_gid =@st ? $st[5] : undef;
951             push @do, ["chown" => {
952             path=>$path, follow_symlink=>$allow_sym,
953 4         25 group=>$args{group}}];
954 4 100       26 unshift @undo, ["chown" => {
955             path=>$path, follow_symlink=>$allow_sym,
956             group=>$cur_gid}] if defined($cur_gid);
957             }
958             } # block
959              
960 100 100       407 if (@do) {
961 88         6455 [200, "", undef, {do_actions=>\@do, undo_actions=>\@undo}];
962             } else {
963 12         611 [304, "Already fixed"];
964             }
965             }
966              
967             $SPEC{setup_file} = {
968             v => 1.1,
969             name => 'setup_file',
970             summary => "Setup file (existence, mode, permission, content)",
971             description => <<'_',
972              
973             On do, will create file (if it doesn't already exist) and correct
974             mode/permission as well as content.
975              
976             On undo, will restore old mode/permission/content, or delete the file again if
977             it was created by this function *and* its content hasn't changed since (if
978             content/ownership/mode has changed, function will request confirmation).
979              
980             _
981             args => {
982             path => {
983             schema => ['str*'],
984             summary => 'Path to file',
985             req => 1,
986             pos => 0,
987             },
988             should_exist => {
989             schema => 'bool',
990             summary => 'Whether file should exist',
991             description => <<'_',
992              
993             If undef, file need not exist. If set to 0, file must not exist and will be
994             deleted if it does. If set to 1, file must exist and will be created if it
995             doesn't.
996              
997             _
998             },
999             mode => {
1000             schema => 'str',
1001             summary => 'Expected permission mode',
1002             description => <<'_',
1003              
1004             Mode is as supported by File::chmod. Either an octal string (e.g. '0755') or a
1005             symbolic mode (e.g. 'u+rw').
1006              
1007             _
1008             },
1009             owner => {
1010             schema => 'str',
1011             summary => 'Expected owner (either numeric or username)',
1012             },
1013             group => {
1014             schema => 'str',
1015             summary => 'Expected group (either numeric or group name)',
1016             },
1017             content => {
1018             schema => 'str',
1019             summary => 'Desired file content',
1020             description => <<'_',
1021              
1022             Alternatively you can also use `content_md5`, or `check_content_func` and
1023             `gen_content_func`.
1024              
1025             _
1026             },
1027             check_content_func => {
1028             schema => 'str',
1029             summary => 'Name of function to check content',
1030             description => <<'_',
1031              
1032             If unset, file will not be checked for its content. If set, function will be
1033             called whenever file content needs to be checked. Function will be passed the
1034             reference to file content and should return a boolean value indicating whether
1035             content is acceptable. If it returns a false value, content is deemed
1036             unacceptable and needs to be fixed.
1037              
1038             Alternatively you can use the simpler `content` argument.
1039              
1040             _
1041             },
1042             gen_content_func => {
1043             schema => 'str',
1044             summary => 'Name of function to generate content',
1045             description => <<'_',
1046              
1047             If set, whenever a new file content is needed (e.g. when file is created or file
1048             content reset), this function will be called to provide it. If unset, empty
1049             string will be used instead.
1050              
1051             Function will be passed the reference to the current content (or undef) and
1052             should return the new content.
1053              
1054             Alternatively you can use the simpler `content` argument.
1055              
1056             _
1057             },
1058             allow_symlink => {
1059             schema => [bool => {default=>1}],
1060             summary => 'Whether symlink is allowed',
1061             description => <<'_',
1062              
1063             If existing file is a symlink to a file then if allow_symlink is false then it
1064             is an unacceptable condition (the symlink will be replaced if replace_symlink is
1065             true).
1066              
1067             Note: if you want to setup symlink instead, use Setup::Symlink.
1068              
1069             _
1070             },
1071             replace_symlink => {
1072             schema => [bool => {default=>1}],
1073             summary => "Replace existing symlink if it needs to be replaced",
1074             },
1075             replace_file => {
1076             schema => [bool => {default=>1}],
1077             summary => "Replace existing file if it needs to be replaced",
1078             },
1079             replace_dir => {
1080             schema => [bool => {default=>1}],
1081             summary => "Replace existing dir if it needs to be replaced",
1082             },
1083             },
1084             features => {
1085             tx => {v=>2},
1086             idempotent => 1,
1087             },
1088             };
1089             sub setup_file {
1090 71     71 1 8478935 _setup_file_or_dir(@_, -which => 'file');
1091             }
1092              
1093             $SPEC{setup_dir} = {
1094             v => 1.1,
1095             summary => "Setup directory (existence, mode, permission)",
1096             description => <<'_',
1097              
1098             On do, will create directory (if it doesn't already exist) and fix its
1099             mode/permission.
1100              
1101             On undo, will restore old mode/permission (and delete directory if it is empty
1102             and was created by this function). If directory was created by this function but
1103             is not empty, will return status 331 to ask for confirmation (`-confirm`). If
1104             confirmation is set to true, will delete non-empty directory.
1105              
1106             Will *not* create intermediate directories like "mkdir -p". Create intermediate
1107             directories using several setup_dir() invocation.
1108              
1109             _
1110             args => {
1111             path => {
1112             schema => ['str*'],
1113             summary => 'Path to file',
1114             req => 1,
1115             pos => 0,
1116             },
1117             should_exist => {
1118             schema => ['bool' => {}],
1119             summary => 'Whether dir should exist',
1120             description => <<'_',
1121              
1122             If undef, dir need not exist. If set to 0, dir must not exist and will be
1123             deleted if it does. If set to 1, dir must exist and will be created if it
1124             doesn't.
1125              
1126             _
1127             },
1128             mode => {
1129             schema => ['str' => {}],
1130             summary => 'Expected permission mode',
1131             },
1132             owner => {
1133             schema => ['str' => {}],
1134             summary => 'Expected owner',
1135             },
1136             group => {
1137             schema => ['str' => {}],
1138             summary => 'Expected group',
1139             },
1140             allow_symlink => {
1141             schema => ['bool*' => {default=>1}],
1142             summary => 'Whether symlink is allowed',
1143             description => <<'_',
1144              
1145             If existing dir is a symlink then if allow_symlink is false then it is an
1146             unacceptable condition (the symlink will be replaced if replace_symlink is
1147             true).
1148              
1149             Note: if you want to setup symlink instead, use Setup::Symlink.
1150              
1151             _
1152             },
1153             replace_symlink => {
1154             schema => ['bool*' => {default=>1}],
1155             summary => "Replace existing symlink if it needs to be replaced",
1156             },
1157             replace_file => {
1158             schema => ['bool*' => {default=>1}],
1159             summary => "Replace existing file if it needs to be replaced",
1160             },
1161             replace_dir => {
1162             schema => ['bool*' => {default=>1}],
1163             summary => "Replace existing dir if it needs to be replaced",
1164             },
1165             },
1166             features => {
1167             tx => {v=>2},
1168             idempotent => 1,
1169             },
1170             };
1171             sub setup_dir {
1172 47     47 1 5939460 Setup::File::_setup_file_or_dir(@_, -which => 'dir');
1173             }
1174              
1175             1;
1176             # ABSTRACT: Setup file (existence, mode, permission, content)
1177              
1178             __END__
1179              
1180             =pod
1181              
1182             =encoding UTF-8
1183              
1184             =head1 NAME
1185              
1186             Setup::File - Setup file (existence, mode, permission, content)
1187              
1188             =head1 VERSION
1189              
1190             This document describes version 0.23 of Setup::File (from Perl distribution Setup-File), released on 2017-07-10.
1191              
1192             =head1 FUNCTIONS
1193              
1194              
1195             =head2 chmod
1196              
1197             Usage:
1198              
1199             chmod(%args) -> [status, msg, result, meta]
1200              
1201             Set file's permission mode.
1202              
1203             Fixed state: C<path> exists and mode is already correct.
1204              
1205             Fixable state: C<path> exists but mode is not correct.
1206              
1207             Unfixable state: C<path> doesn't exist.
1208              
1209             This function is not exported.
1210              
1211             This function is idempotent (repeated invocations with same arguments has the same effect as single invocation). This function supports transactions.
1212              
1213              
1214             Arguments ('*' denotes required arguments):
1215              
1216             =over 4
1217              
1218             =item * B<follow_symlink> => I<bool> (default: 0)
1219              
1220             Whether to follow symlink.
1221              
1222             =item * B<mode>* => I<str>
1223              
1224             Permission mode, either numeric or symbolic (e.g. a+w).
1225              
1226             =item * B<orig_mode> => I<int>
1227              
1228             If set, confirm if current mode is not the same as this.
1229              
1230             =item * B<path>* => I<str>
1231              
1232             Path to file/directory.
1233              
1234             =back
1235              
1236             Special arguments:
1237              
1238             =over 4
1239              
1240             =item * B<-tx_action> => I<str>
1241              
1242             For more information on transaction, see L<Rinci::Transaction>.
1243              
1244             =item * B<-tx_action_id> => I<str>
1245              
1246             For more information on transaction, see L<Rinci::Transaction>.
1247              
1248             =item * B<-tx_recovery> => I<str>
1249              
1250             For more information on transaction, see L<Rinci::Transaction>.
1251              
1252             =item * B<-tx_rollback> => I<str>
1253              
1254             For more information on transaction, see L<Rinci::Transaction>.
1255              
1256             =item * B<-tx_v> => I<str>
1257              
1258             For more information on transaction, see L<Rinci::Transaction>.
1259              
1260             =back
1261              
1262             Returns an enveloped result (an array).
1263              
1264             First element (status) is an integer containing HTTP status code
1265             (200 means OK, 4xx caller error, 5xx function error). Second element
1266             (msg) is a string containing error message, or 'OK' if status is
1267             200. Third element (result) is optional, the actual result. Fourth
1268             element (meta) is called result metadata and is optional, a hash
1269             that contains extra information.
1270              
1271             Return value: (any)
1272              
1273              
1274             =head2 chown
1275              
1276             Usage:
1277              
1278             chown(%args) -> [status, msg, result, meta]
1279              
1280             Set file's ownership.
1281              
1282             Fixed state: C<path> exists and ownership is already correct.
1283              
1284             Fixable state: C<path> exists but ownership is not correct.
1285              
1286             Unfixable state: C<path> doesn't exist.
1287              
1288             This function is not exported.
1289              
1290             This function is idempotent (repeated invocations with same arguments has the same effect as single invocation). This function supports transactions.
1291              
1292              
1293             Arguments ('*' denotes required arguments):
1294              
1295             =over 4
1296              
1297             =item * B<follow_symlink> => I<bool> (default: 0)
1298              
1299             Whether to follow symlink.
1300              
1301             =item * B<group> => I<str>
1302              
1303             Numeric GID or group.
1304              
1305             =item * B<orig_group> => I<str>
1306              
1307             If set, confirm if current group is not the same as this.
1308              
1309             =item * B<orig_owner> => I<str>
1310              
1311             If set, confirm if current owner is not the same as this.
1312              
1313             =item * B<owner> => I<str>
1314              
1315             Numeric UID or username.
1316              
1317             =item * B<path>* => I<str>
1318              
1319             Path to file/directory.
1320              
1321             =back
1322              
1323             Special arguments:
1324              
1325             =over 4
1326              
1327             =item * B<-tx_action> => I<str>
1328              
1329             For more information on transaction, see L<Rinci::Transaction>.
1330              
1331             =item * B<-tx_action_id> => I<str>
1332              
1333             For more information on transaction, see L<Rinci::Transaction>.
1334              
1335             =item * B<-tx_recovery> => I<str>
1336              
1337             For more information on transaction, see L<Rinci::Transaction>.
1338              
1339             =item * B<-tx_rollback> => I<str>
1340              
1341             For more information on transaction, see L<Rinci::Transaction>.
1342              
1343             =item * B<-tx_v> => I<str>
1344              
1345             For more information on transaction, see L<Rinci::Transaction>.
1346              
1347             =back
1348              
1349             Returns an enveloped result (an array).
1350              
1351             First element (status) is an integer containing HTTP status code
1352             (200 means OK, 4xx caller error, 5xx function error). Second element
1353             (msg) is a string containing error message, or 'OK' if status is
1354             200. Third element (result) is optional, the actual result. Fourth
1355             element (meta) is called result metadata and is optional, a hash
1356             that contains extra information.
1357              
1358             Return value: (any)
1359              
1360              
1361             =head2 mkdir
1362              
1363             Usage:
1364              
1365             mkdir(%args) -> [status, msg, result, meta]
1366              
1367             Create directory.
1368              
1369             Fixed state: C<path> exists and is a directory.
1370              
1371             Fixable state: C<path> doesn't exist.
1372              
1373             Unfixable state: C<path> exists and is not a directory.
1374              
1375             This function is not exported.
1376              
1377             This function is idempotent (repeated invocations with same arguments has the same effect as single invocation). This function supports transactions.
1378              
1379              
1380             Arguments ('*' denotes required arguments):
1381              
1382             =over 4
1383              
1384             =item * B<allow_symlink> => I<str>
1385              
1386             Whether to regard symlink to a directory as directory.
1387              
1388             =item * B<mode> => I<str>
1389              
1390             Set mode for the newly created directory.
1391              
1392             =item * B<path>* => I<str>
1393              
1394             Path to directory.
1395              
1396             =back
1397              
1398             Special arguments:
1399              
1400             =over 4
1401              
1402             =item * B<-tx_action> => I<str>
1403              
1404             For more information on transaction, see L<Rinci::Transaction>.
1405              
1406             =item * B<-tx_action_id> => I<str>
1407              
1408             For more information on transaction, see L<Rinci::Transaction>.
1409              
1410             =item * B<-tx_recovery> => I<str>
1411              
1412             For more information on transaction, see L<Rinci::Transaction>.
1413              
1414             =item * B<-tx_rollback> => I<str>
1415              
1416             For more information on transaction, see L<Rinci::Transaction>.
1417              
1418             =item * B<-tx_v> => I<str>
1419              
1420             For more information on transaction, see L<Rinci::Transaction>.
1421              
1422             =back
1423              
1424             Returns an enveloped result (an array).
1425              
1426             First element (status) is an integer containing HTTP status code
1427             (200 means OK, 4xx caller error, 5xx function error). Second element
1428             (msg) is a string containing error message, or 'OK' if status is
1429             200. Third element (result) is optional, the actual result. Fourth
1430             element (meta) is called result metadata and is optional, a hash
1431             that contains extra information.
1432              
1433             Return value: (any)
1434              
1435              
1436             =head2 mkfile
1437              
1438             Usage:
1439              
1440             mkfile(%args) -> [status, msg, result, meta]
1441              
1442             Create file (and/or set content).
1443              
1444             Fixed state: C<path> exists, is a file, and content is correct.
1445              
1446             Fixable state: C<path> doesn't exist. Or C<path> exists, is a file, and content is
1447             incorrect. Or C<orig_path> specified and exists.
1448              
1449             Unfixable state: C<path> exists and is not a file.
1450              
1451             This function is not exported.
1452              
1453             This function is idempotent (repeated invocations with same arguments has the same effect as single invocation). This function supports transactions.
1454              
1455              
1456             Arguments ('*' denotes required arguments):
1457              
1458             =over 4
1459              
1460             =item * B<allow_symlink> => I<str>
1461              
1462             Whether to regard symlink to a file as file.
1463              
1464             =item * B<check_content_func> => I<str>
1465              
1466             Name of function to check content.
1467              
1468             If unset, file will not be checked for its content. If set, function will be
1469             called whenever file content needs to be checked. Function will be passed the
1470             reference to file content and should return a boolean value indicating whether
1471             content is acceptable. If it returns a false value, content is deemed
1472             unacceptable and needs to be fixed.
1473              
1474             Alternatively you can use the simpler C<content> or C<content_md5> argument.
1475              
1476             =item * B<content> => I<str>
1477              
1478             Desired file content.
1479              
1480             Alternatively you can also use C<content_md5>, or C<gen_content_func> and
1481             C<check_content_func>.
1482              
1483             =item * B<content_md5> => I<str>
1484              
1485             Check content against MD5 hash.
1486              
1487             MD5 hash should be expressed in hex (e.g. bed6626e019e5870ef01736b3553e570).
1488              
1489             Used when checking content of existing file.
1490              
1491             Alternatively you can also use C<content>, or C<check_content_func>.
1492              
1493             =item * B<gen_content_func> => I<str>
1494              
1495             Name of function to generate content.
1496              
1497             If set, whenever a new file content is needed (e.g. when file is created or file
1498             content reset), this function will be called to provide it. If unset, empty
1499             string will be used instead.
1500              
1501             Function will be passed the reference to the current content (or undef) and
1502             should return the new content.
1503              
1504             Alternatively you can use the simpler C<content> argument.
1505              
1506             =item * B<path>* => I<str>
1507              
1508             Path to file.
1509              
1510             =item * B<suffix> => I<str>
1511              
1512             =back
1513              
1514             Special arguments:
1515              
1516             =over 4
1517              
1518             =item * B<-tx_action> => I<str>
1519              
1520             For more information on transaction, see L<Rinci::Transaction>.
1521              
1522             =item * B<-tx_action_id> => I<str>
1523              
1524             For more information on transaction, see L<Rinci::Transaction>.
1525              
1526             =item * B<-tx_recovery> => I<str>
1527              
1528             For more information on transaction, see L<Rinci::Transaction>.
1529              
1530             =item * B<-tx_rollback> => I<str>
1531              
1532             For more information on transaction, see L<Rinci::Transaction>.
1533              
1534             =item * B<-tx_v> => I<str>
1535              
1536             For more information on transaction, see L<Rinci::Transaction>.
1537              
1538             =back
1539              
1540             Returns an enveloped result (an array).
1541              
1542             First element (status) is an integer containing HTTP status code
1543             (200 means OK, 4xx caller error, 5xx function error). Second element
1544             (msg) is a string containing error message, or 'OK' if status is
1545             200. Third element (result) is optional, the actual result. Fourth
1546             element (meta) is called result metadata and is optional, a hash
1547             that contains extra information.
1548              
1549             Return value: (any)
1550              
1551              
1552             =head2 rmdir
1553              
1554             Usage:
1555              
1556             rmdir(%args) -> [status, msg, result, meta]
1557              
1558             Delete directory.
1559              
1560             Fixed state: C<path> doesn't exist.
1561              
1562             Fixable state: C<path> exists and is a directory (or, a symlink to a directory,
1563             if C<allow_symlink> option is enabled).
1564              
1565             Unfixable state: C<path> exists but is not a directory.
1566              
1567             This function is not exported.
1568              
1569             This function is idempotent (repeated invocations with same arguments has the same effect as single invocation). This function supports transactions.
1570              
1571              
1572             Arguments ('*' denotes required arguments):
1573              
1574             =over 4
1575              
1576             =item * B<allow_symlink> => I<bool> (default: 0)
1577              
1578             Whether to regard symlink to a directory as directory.
1579              
1580             =item * B<delete_nonempty_dir> => I<bool>
1581              
1582             Whether to delete non-empty directory.
1583              
1584             If set to true, will delete non-empty directory.
1585              
1586             If set to false, will never delete non-empty directory.
1587              
1588             If unset (default), will ask for confirmation first by returning status 331.
1589             Caller can confirm by passing special argument C<-confirm>.
1590              
1591             =item * B<path>* => I<str>
1592              
1593             =back
1594              
1595             Special arguments:
1596              
1597             =over 4
1598              
1599             =item * B<-tx_action> => I<str>
1600              
1601             For more information on transaction, see L<Rinci::Transaction>.
1602              
1603             =item * B<-tx_action_id> => I<str>
1604              
1605             For more information on transaction, see L<Rinci::Transaction>.
1606              
1607             =item * B<-tx_recovery> => I<str>
1608              
1609             For more information on transaction, see L<Rinci::Transaction>.
1610              
1611             =item * B<-tx_rollback> => I<str>
1612              
1613             For more information on transaction, see L<Rinci::Transaction>.
1614              
1615             =item * B<-tx_v> => I<str>
1616              
1617             For more information on transaction, see L<Rinci::Transaction>.
1618              
1619             =back
1620              
1621             Returns an enveloped result (an array).
1622              
1623             First element (status) is an integer containing HTTP status code
1624             (200 means OK, 4xx caller error, 5xx function error). Second element
1625             (msg) is a string containing error message, or 'OK' if status is
1626             200. Third element (result) is optional, the actual result. Fourth
1627             element (meta) is called result metadata and is optional, a hash
1628             that contains extra information.
1629              
1630             Return value: (any)
1631              
1632              
1633             =head2 rmfile
1634              
1635             Usage:
1636              
1637             rmfile(%args) -> [status, msg, result, meta]
1638              
1639             Delete file.
1640              
1641             Fixed state: C<path> doesn't exist.
1642              
1643             Fixable state: C<path> exists and is a file (or, a symlink to a file, if
1644             C<allow_symlink> option is enabled).
1645              
1646             Unfixable state: C<path> exists but is not a file.
1647              
1648             This function is not exported.
1649              
1650             This function is idempotent (repeated invocations with same arguments has the same effect as single invocation). This function supports transactions.
1651              
1652              
1653             Arguments ('*' denotes required arguments):
1654              
1655             =over 4
1656              
1657             =item * B<allow_symlink> => I<bool> (default: 0)
1658              
1659             Whether to regard symlink to a file as file.
1660              
1661             =item * B<orig_content> => I<str>
1662              
1663             If set, confirm if current content is not the same as this.
1664              
1665             Alternatively, you can use C<orig_content_hash>.
1666              
1667             =item * B<orig_content_md5> => I<str>
1668              
1669             If set, confirm if current content MD5 hash is not the same as this.
1670              
1671             MD5 hash should be expressed in hex (e.g. bed6626e019e5870ef01736b3553e570).
1672              
1673             Alternatively, you can use C<orig_content> (for shorter content).
1674              
1675             =item * B<path>* => I<str>
1676              
1677             =item * B<suffix> => I<str>
1678              
1679             Use this suffix when trashing.
1680              
1681             =back
1682              
1683             Special arguments:
1684              
1685             =over 4
1686              
1687             =item * B<-tx_action> => I<str>
1688              
1689             For more information on transaction, see L<Rinci::Transaction>.
1690              
1691             =item * B<-tx_action_id> => I<str>
1692              
1693             For more information on transaction, see L<Rinci::Transaction>.
1694              
1695             =item * B<-tx_recovery> => I<str>
1696              
1697             For more information on transaction, see L<Rinci::Transaction>.
1698              
1699             =item * B<-tx_rollback> => I<str>
1700              
1701             For more information on transaction, see L<Rinci::Transaction>.
1702              
1703             =item * B<-tx_v> => I<str>
1704              
1705             For more information on transaction, see L<Rinci::Transaction>.
1706              
1707             =back
1708              
1709             Returns an enveloped result (an array).
1710              
1711             First element (status) is an integer containing HTTP status code
1712             (200 means OK, 4xx caller error, 5xx function error). Second element
1713             (msg) is a string containing error message, or 'OK' if status is
1714             200. Third element (result) is optional, the actual result. Fourth
1715             element (meta) is called result metadata and is optional, a hash
1716             that contains extra information.
1717              
1718             Return value: (any)
1719              
1720              
1721             =head2 setup_dir
1722              
1723             Usage:
1724              
1725             setup_dir(%args) -> [status, msg, result, meta]
1726              
1727             Setup directory (existence, mode, permission).
1728              
1729             On do, will create directory (if it doesn't already exist) and fix its
1730             mode/permission.
1731              
1732             On undo, will restore old mode/permission (and delete directory if it is empty
1733             and was created by this function). If directory was created by this function but
1734             is not empty, will return status 331 to ask for confirmation (C<-confirm>). If
1735             confirmation is set to true, will delete non-empty directory.
1736              
1737             Will I<not> create intermediate directories like "mkdir -p". Create intermediate
1738             directories using several setup_dir() invocation.
1739              
1740             This function is not exported.
1741              
1742             This function is idempotent (repeated invocations with same arguments has the same effect as single invocation). This function supports transactions.
1743              
1744              
1745             Arguments ('*' denotes required arguments):
1746              
1747             =over 4
1748              
1749             =item * B<allow_symlink> => I<bool> (default: 1)
1750              
1751             Whether symlink is allowed.
1752              
1753             If existing dir is a symlink then if allow_symlink is false then it is an
1754             unacceptable condition (the symlink will be replaced if replace_symlink is
1755             true).
1756              
1757             Note: if you want to setup symlink instead, use Setup::Symlink.
1758              
1759             =item * B<group> => I<str>
1760              
1761             Expected group.
1762              
1763             =item * B<mode> => I<str>
1764              
1765             Expected permission mode.
1766              
1767             =item * B<owner> => I<str>
1768              
1769             Expected owner.
1770              
1771             =item * B<path>* => I<str>
1772              
1773             Path to file.
1774              
1775             =item * B<replace_dir> => I<bool> (default: 1)
1776              
1777             Replace existing dir if it needs to be replaced.
1778              
1779             =item * B<replace_file> => I<bool> (default: 1)
1780              
1781             Replace existing file if it needs to be replaced.
1782              
1783             =item * B<replace_symlink> => I<bool> (default: 1)
1784              
1785             Replace existing symlink if it needs to be replaced.
1786              
1787             =item * B<should_exist> => I<bool>
1788              
1789             Whether dir should exist.
1790              
1791             If undef, dir need not exist. If set to 0, dir must not exist and will be
1792             deleted if it does. If set to 1, dir must exist and will be created if it
1793             doesn't.
1794              
1795             =back
1796              
1797             Special arguments:
1798              
1799             =over 4
1800              
1801             =item * B<-tx_action> => I<str>
1802              
1803             For more information on transaction, see L<Rinci::Transaction>.
1804              
1805             =item * B<-tx_action_id> => I<str>
1806              
1807             For more information on transaction, see L<Rinci::Transaction>.
1808              
1809             =item * B<-tx_recovery> => I<str>
1810              
1811             For more information on transaction, see L<Rinci::Transaction>.
1812              
1813             =item * B<-tx_rollback> => I<str>
1814              
1815             For more information on transaction, see L<Rinci::Transaction>.
1816              
1817             =item * B<-tx_v> => I<str>
1818              
1819             For more information on transaction, see L<Rinci::Transaction>.
1820              
1821             =back
1822              
1823             Returns an enveloped result (an array).
1824              
1825             First element (status) is an integer containing HTTP status code
1826             (200 means OK, 4xx caller error, 5xx function error). Second element
1827             (msg) is a string containing error message, or 'OK' if status is
1828             200. Third element (result) is optional, the actual result. Fourth
1829             element (meta) is called result metadata and is optional, a hash
1830             that contains extra information.
1831              
1832             Return value: (any)
1833              
1834              
1835             =head2 setup_file
1836              
1837             Usage:
1838              
1839             setup_file(%args) -> [status, msg, result, meta]
1840              
1841             Setup file (existence, mode, permission, content).
1842              
1843             On do, will create file (if it doesn't already exist) and correct
1844             mode/permission as well as content.
1845              
1846             On undo, will restore old mode/permission/content, or delete the file again if
1847             it was created by this function I<and> its content hasn't changed since (if
1848             content/ownership/mode has changed, function will request confirmation).
1849              
1850             This function is not exported by default, but exportable.
1851              
1852             This function is idempotent (repeated invocations with same arguments has the same effect as single invocation). This function supports transactions.
1853              
1854              
1855             Arguments ('*' denotes required arguments):
1856              
1857             =over 4
1858              
1859             =item * B<allow_symlink> => I<bool> (default: 1)
1860              
1861             Whether symlink is allowed.
1862              
1863             If existing file is a symlink to a file then if allow_symlink is false then it
1864             is an unacceptable condition (the symlink will be replaced if replace_symlink is
1865             true).
1866              
1867             Note: if you want to setup symlink instead, use Setup::Symlink.
1868              
1869             =item * B<check_content_func> => I<str>
1870              
1871             Name of function to check content.
1872              
1873             If unset, file will not be checked for its content. If set, function will be
1874             called whenever file content needs to be checked. Function will be passed the
1875             reference to file content and should return a boolean value indicating whether
1876             content is acceptable. If it returns a false value, content is deemed
1877             unacceptable and needs to be fixed.
1878              
1879             Alternatively you can use the simpler C<content> argument.
1880              
1881             =item * B<content> => I<str>
1882              
1883             Desired file content.
1884              
1885             Alternatively you can also use C<content_md5>, or C<check_content_func> and
1886             C<gen_content_func>.
1887              
1888             =item * B<gen_content_func> => I<str>
1889              
1890             Name of function to generate content.
1891              
1892             If set, whenever a new file content is needed (e.g. when file is created or file
1893             content reset), this function will be called to provide it. If unset, empty
1894             string will be used instead.
1895              
1896             Function will be passed the reference to the current content (or undef) and
1897             should return the new content.
1898              
1899             Alternatively you can use the simpler C<content> argument.
1900              
1901             =item * B<group> => I<str>
1902              
1903             Expected group (either numeric or group name).
1904              
1905             =item * B<mode> => I<str>
1906              
1907             Expected permission mode.
1908              
1909             Mode is as supported by File::chmod. Either an octal string (e.g. '0755') or a
1910             symbolic mode (e.g. 'u+rw').
1911              
1912             =item * B<owner> => I<str>
1913              
1914             Expected owner (either numeric or username).
1915              
1916             =item * B<path>* => I<str>
1917              
1918             Path to file.
1919              
1920             =item * B<replace_dir> => I<bool> (default: 1)
1921              
1922             Replace existing dir if it needs to be replaced.
1923              
1924             =item * B<replace_file> => I<bool> (default: 1)
1925              
1926             Replace existing file if it needs to be replaced.
1927              
1928             =item * B<replace_symlink> => I<bool> (default: 1)
1929              
1930             Replace existing symlink if it needs to be replaced.
1931              
1932             =item * B<should_exist> => I<bool>
1933              
1934             Whether file should exist.
1935              
1936             If undef, file need not exist. If set to 0, file must not exist and will be
1937             deleted if it does. If set to 1, file must exist and will be created if it
1938             doesn't.
1939              
1940             =back
1941              
1942             Special arguments:
1943              
1944             =over 4
1945              
1946             =item * B<-tx_action> => I<str>
1947              
1948             For more information on transaction, see L<Rinci::Transaction>.
1949              
1950             =item * B<-tx_action_id> => I<str>
1951              
1952             For more information on transaction, see L<Rinci::Transaction>.
1953              
1954             =item * B<-tx_recovery> => I<str>
1955              
1956             For more information on transaction, see L<Rinci::Transaction>.
1957              
1958             =item * B<-tx_rollback> => I<str>
1959              
1960             For more information on transaction, see L<Rinci::Transaction>.
1961              
1962             =item * B<-tx_v> => I<str>
1963              
1964             For more information on transaction, see L<Rinci::Transaction>.
1965              
1966             =back
1967              
1968             Returns an enveloped result (an array).
1969              
1970             First element (status) is an integer containing HTTP status code
1971             (200 means OK, 4xx caller error, 5xx function error). Second element
1972             (msg) is a string containing error message, or 'OK' if status is
1973             200. Third element (result) is optional, the actual result. Fourth
1974             element (meta) is called result metadata and is optional, a hash
1975             that contains extra information.
1976              
1977             Return value: (any)
1978              
1979             =head1 FAQ
1980              
1981             =head2 Why not allowing coderef in 'check_content_func' and 'gen_content_func' argument?
1982              
1983             Because transactional function needs to store its argument in database
1984             (currently in JSON), coderefs are not representable in JSON.
1985              
1986             =head1 HOMEPAGE
1987              
1988             Please visit the project's homepage at L<https://metacpan.org/release/Setup-File>.
1989              
1990             =head1 SOURCE
1991              
1992             Source repository is at L<https://github.com/perlancar/perl-Setup-File>.
1993              
1994             =head1 BUGS
1995              
1996             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Setup-File>
1997              
1998             When submitting a bug or request, please include a test-file or a
1999             patch to an existing test-file that illustrates the bug or desired
2000             feature.
2001              
2002             =head1 SEE ALSO
2003              
2004             L<Setup>
2005              
2006             L<Setup::File::Dir>
2007              
2008             L<Setup::File::Symlink>
2009              
2010             =head1 AUTHOR
2011              
2012             perlancar <perlancar@cpan.org>
2013              
2014             =head1 COPYRIGHT AND LICENSE
2015              
2016             This software is copyright (c) 2017, 2015, 2014, 2012, 2011 by perlancar@cpan.org.
2017              
2018             This is free software; you can redistribute it and/or modify it under
2019             the same terms as the Perl 5 programming language system itself.
2020              
2021             =cut