File Coverage

lib/File/Takeput.pm
Criterion Covered Total %
statement 269 285 94.3
branch 111 154 72.0
condition 12 15 80.0
subroutine 36 38 94.7
pod 11 11 100.0
total 439 503 87.2


line stmt bran cond sub pod time code
1             # File::Takeput.pm
2             # Slurp style file IO with locking.
3             # (c) 2023 Bjørn Hee
4             # Licensed under the Apache License, version 2.0
5             # https://www.apache.org/licenses/LICENSE-2.0.txt
6              
7             package File::Takeput;
8              
9 6     6   1957681 use strict;
  6         13  
  6         289  
10 6     6   36 use experimental qw(signatures);
  6         14  
  6         55  
11             # use Exporter qw(import);
12              
13             our $VERSION = 0.30;
14              
15 6     6   1220 use Scalar::Util qw(reftype); # Later builtin::reftype
  6         31  
  6         488  
16 6     6   84 use Fcntl qw(O_CREAT O_RDONLY O_RDWR O_WRONLY O_EXCL :flock);
  6         47  
  6         1406  
17 6     6   50 use File::Basename qw(basename dirname);
  6         14  
  6         481  
18 6     6   42 use Cwd qw(abs_path);
  6         8  
  6         431  
19 6     6   37 use if $^O eq 'MSWin32' , 'File::Takeput::Win32';
  6         10  
  6         396  
20 6     6   43 use if $^O ne 'MSWin32' , 'File::Takeput::Unix';
  6         15  
  6         3272  
21              
22             my sub qwac( $s ) {grep{/./} map{split /\s+/} map{s/#.*//r} split/\v+/ , $s;};
23              
24             our @EXPORT = qwac '
25             append # Append content to file.
26             grab # Read file content.
27             pass # Release the locks of a taken file.
28             plunk # Overwrite file with content.
29             put # Write to a taken file and release locks.
30             take # Take locks and read file content.
31             ';
32              
33             our @EXPORT_OK = qwac '
34             fgrab # Functional version of grab.
35             fpass # Functional version of pass.
36             ftake # Functional version of take.
37             reset # Reset default values.
38             set # Set default values.
39             ';
40              
41             # ------------------------------------------------------------------------- #
42             # Globals and defaults.
43              
44             my $default = {
45             'File::Takeput' => {
46             create => undef ,
47             error => undef ,
48             flatten => undef ,
49             exclusive => undef ,
50             newline => undef ,
51             patience => 0 ,
52             separator => $/ ,
53             unique => undef ,
54             } ,
55             };
56              
57             my %imfh = (); # Hash for holding implicit filehandles.
58              
59             # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
60              
61             my $errh_msg;
62              
63             my sub advice( $msg ) {
64             # Give an error advice (a warning pointing to the caller).
65             my ($prog,$lno);
66             my $i = 0;
67             while (1) {
68             (my $nsp,$prog,$lno) = (caller($i))[0,1,2] or last;
69             last if $nsp !~ m/^File::Takeput(::.+)?$/n;
70             $i++;
71             };
72             print STDERR $msg;
73             print STDERR ' at '.$prog if defined $prog;
74             print STDERR ' line '.$lno if defined $lno;
75             print STDERR '.';
76             };
77              
78              
79 6     6   10 my sub errah( $msg , $s ) {
  6         11  
  6         10  
  6         8  
80             # Error advice and handling.
81 6 50       21 $msg .= $errh_msg if $errh_msg;
82 6         10 $errh_msg = undef;
83 6         22 advice($msg.'');
84 6         13 $@ = $msg;
85 6 50       19 return $s->{error}->() if defined $s->{error};
86 6         43 return;
87             };
88              
89              
90 29     29   48 my sub errh( $msg , $s = undef ) {
  29         53  
  29         45  
  29         65  
91             # Error handler.
92 29 100       69 if (defined $s) { # For calls coming into Takeput.
93 14 100       43 $msg .= $errh_msg if $errh_msg;
94 14         25 $errh_msg = undef;
95 14         29 $@ = $msg;
96 14 100       63 return $s->{error}->() if defined $s->{error};
97             }
98             else { # For calls internal to Takeput.
99 15         27 $errh_msg = $msg;
100             };
101 26         169 return;
102             };
103              
104              
105 0     0   0 my sub fatal_error( $msg ) {
  0         0  
  0         0  
106 0         0 advice($msg.'--compilation aborted');
107 0         0 exit 1;
108             };
109              
110              
111 57     57   114 my sub full_setting( $s , $d ) {
  57         100  
  57         84  
  57         82  
112             # Check parameter values and provide a full setting.
113              
114 57 100       423 return {$d->%*} if not $s->%*;
115              
116 28 100       86 if (not exists $s->{create}) {
117 20         107 $s->{create} = $d->{create};
118             };
119              
120 28 100       79 if (exists $s->{error}) {
121 8 100       28 if (defined $s->{error}) {
122             return errh('"error" not a ref to a subroutine.')
123 4 100       18 if reftype $s->{error} ne 'CODE';
124             };
125             }
126             else {
127 20         47 $s->{error} = $d->{error};
128             };
129              
130 27 100       70 if (not exists $s->{flatten}) {
131 22         48 $s->{flatten} = $d->{flatten};
132             };
133              
134 27 100       69 if (not exists $s->{exclusive}) {
135 23         48 $s->{exclusive} = $d->{exclusive};
136             };
137              
138 27 100       73 if (not exists $s->{newline}) {
139 19         42 $s->{newline} = $d->{newline};
140             };
141              
142 27 100       72 if (exists $s->{patience}) {
143             return errh('"patience" not defined.')
144 7 50       39 if not defined $s->{patience};
145             return errh('"patience" not numerical.')
146 7 100       72 if $s->{patience} !~ m/^(\d*\.)?\d+$/n;
147             return errh('"patience" negative.')
148 6 50       29 if $s->{patience} < 0;
149             }
150             else {
151 20         51 $s->{patience} = $d->{patience};
152             };
153              
154 26 100       61 if (exists $s->{separator}) {
155             return errh('"separator" an empty string.')
156 14 100 100     100 if defined $s->{separator} and $s->{separator} eq '';
157             }
158             else {
159 12         33 $s->{separator} = $d->{separator};
160             };
161              
162 25 100       60 if (not exists $s->{unique}) {
163 20         51 $s->{unique} = $d->{unique};
164             };
165              
166 25 100       103 if (8 < keys $s->%*) {
167 3         8 return errh('Invalid configuration parameter.');
168             };
169              
170 22         82 return $s;
171              
172             }; # sub full_setting
173              
174             # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
175              
176             sub import( @implist ) {
177             my $mynsp = shift @implist;
178             my $nsp = caller;
179             my %check;
180              
181             if (@implist) {
182             %check = map {$_ => 1} qw(
183             create error exclusive flatten newline patience separator unique
184             );
185              
186             my $cpar = {};
187             my $i = 0;
188             while ($i < @implist) {
189             my $p = $implist[$i];
190             if ($check{$p}) {
191             fatal_error('Takeput: No "'.$p.'" value.')
192             if $i == $#implist;
193             $cpar->{$p} = $implist[$i+1];
194             splice @implist , $i , 2;
195             $i += -2;
196             };
197             $i++;
198             };
199              
200             my $s = full_setting($cpar,$default->{'File::Takeput'})
201             or fatal_error('Takeput: '.$errh_msg);
202             $default->{$nsp} = $s;
203             }
204             else {
205             $default->{$nsp} = {$default->{'File::Takeput'}->%*};
206             };
207              
208             my sub amp( $s ) {
209             return undef if not defined $s;
210             return $s =~ s/^([^\$\@\%\&])/\&$1/r;
211             };
212             %check = map {(amp($_),1)} @EXPORT , @EXPORT_OK;
213              
214             @implist = @EXPORT if not @implist;
215             while ($_ = amp shift @implist) {
216             fatal_error('Takeput: "'.$_.'" not exported.') if not $check{$_};
217 6     6   71 no strict "refs";
  6         12  
  6         2247  
218             if ( m/^\$(.*)$/ ) { *{"${nsp}::$1"} = \$$1; }
219             elsif ( m/^\@(.*)$/ ) { *{"${nsp}::$1"} = \@$1; }
220             elsif ( m/^\%(.*)$/ ) { *{"${nsp}::$1"} = \%$1; }
221             elsif ( m/^\&(.*)$/ ) { *{"${nsp}::$1"} = \&$1; };
222 6     6   78 use strict "refs";
  6         14  
  6         22879  
223             };
224              
225             }; # sub import
226              
227             # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
228              
229             1;
230              
231             # ------------------------------------------------------------------------- #
232             # Private subroutines.
233              
234 43     43   68 my sub canonical( $fname ) {
  43         64  
  43         61  
235             # Return a canonical filename.
236              
237 43 100       2715 return abs_path($fname) if -f $fname;
238 8         483 my $dname = dirname $fname;
239 8 50       199 return undef if not -d $dname;
240 8         745 return abs_path($dname).'/'.basename($fname);
241             };
242              
243              
244 35     35   62 my sub open_file( $cname , $oflag , $lflag , $p ) {
  35         52  
  35         72  
  35         51  
  35         62  
  35         54  
245             # Open an implicit filehandle.
246              
247             return errh('Tried to open "'.$cname.'" twice.')
248 35 100       145 if (exists $imfh{$cname});
249              
250 29         1696 sysopen $imfh{$cname} , $cname , $oflag;
251              
252 29 100       182 $p = 0 if ($oflag&O_EXCL);
253              
254 29 100       125 if ( flock_take $imfh{$cname} , $lflag , $p ) {
255 26         111 return 1;
256             }
257             else {
258 3         10 close $imfh{$cname};
259 3         13 delete $imfh{$cname};
260 3         13 return errh('Not able to take lock for "'.$cname.'".');
261             };
262 0         0 1;};
263              
264              
265 26     26   37 my sub close_file( $cname ) {
  26         63  
  26         34  
266             # Close an implicit filehandle.
267              
268             return errh('No "'.$cname.'" found, could not close it.')
269 26 50       81 if not exists $imfh{$cname};
270              
271 26 50       3182 close( $imfh{$cname} )
272             or return errh('Closing "'.$cname.'" failed. '.$@);
273 26         127 delete $imfh{$cname};
274 26         88 1;};
275              
276              
277             my sub read_file( $fh , $s ) {
278             # Read from filehandle, handling line endings as required.
279              
280             my $data;
281             { # block
282             local $/ = $s->{separator};
283             $data->@* = readline($fh);
284             };
285             if (scalar $data->@* == 0) {
286             return '' if $s->{flatten};
287             return [''];
288             };
289              
290             if (defined $s->{newline} and defined $s->{separator}) {
291             my $e0 = $s->{separator};
292             my $e0n = length $s->{separator};
293             my $e1 = $s->{newline};
294             for (0 .. $data->$#* - 1) {
295             substr($data->[$_],-$e0n) = $e1;
296             };
297             substr($data->[-1],-$e0n) = $e1
298             if substr($data->[-1],-$e0n) eq $e0;
299             };
300              
301             $data = join '' , $data->@* if $s->{flatten};
302              
303             return $data;
304             };
305              
306              
307 10     10   19 my sub print_file( $fh , $s , $data ) {
  10         18  
  10         17  
  10         16  
  10         12  
308             # Print to filehandle, changing line endings as required.
309              
310 10 100 66     51 if (defined $s->{newline} and defined $s->{separator}) {
311 1         2 my $e0 = $s->{newline};
312 1         2 my $e0n = length $s->{newline};
313 1         3 my $e1 = $s->{separator};
314 1         5 for (0 .. $data->$#* - 1) {
315 3         24 print $fh substr($data->[$_],0,-$e0n) , $e1;
316             };
317 1 50       4 substr($data->[-1],0,-$e0n) = $e1
318             if substr($data->[-1],0,-$e0n) eq $e0;
319 1         3 print $fh $data->[-1];
320             }
321             else {
322 9         85 print $fh $data->@*;
323             };
324 10         44 1;};
325              
326             # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
327              
328 20     20   39 my sub pgrab( $cname , $s , $lflag ) {
  20         32  
  20         30  
  20         33  
  20         55  
329             # Private part of grab.
330              
331             open_file $cname , O_RDONLY , $lflag , $s->{patience}
332 20 100       62 or return errh('grab: ',$s);
333 15         90 seek $imfh{$cname} , 0 , 0;
334 15         46 my $data = read_file($imfh{$cname} , $s);
335 15 50       35 close_file($cname)
336             or return errh('grab: ',$s);
337              
338 15 100       65 return $data if ref $data eq '';
339 14         149 return $data->@*;
340             };
341              
342              
343 3     3   6 my sub ppass( $cname , $s ) {
  3         7  
  3         6  
  3         47  
344             # Private part of pass.
345              
346             return errh('pass: "'.$cname.'" not taken.',$s)
347 3 100       18 if not exists $imfh{$cname};
348             return errh('pass: "'.$cname.'" not opened.',$s)
349 1 50       5 if not defined fileno($imfh{$cname});
350              
351 1 50       4 close_file($cname)
352             or return errh('pass: ',$s);
353 1         5 1;};
354              
355              
356 7     7   14 my sub ptake( $cname , $s , $oflag ) {
  7         13  
  7         13  
  7         12  
  7         10  
357             # Private part of take.
358              
359             open_file $cname , O_RDWR|$oflag , LOCK_EX , $s->{patience}
360 7 100       57 or return errh('take: ',$s);
361 5         43 seek $imfh{$cname} , 0 , 0;
362 5         13 my $data = read_file($imfh{$cname} , $s);
363              
364 5 50       18 return $data if ref $data eq '';
365 5         58 return $data->@*;
366             };
367              
368             # ------------------------------------------------------------------------- #
369             # Exportable subroutines.
370              
371 4     4 1 485 sub append( $fname , %set ) {
  4         9  
  4         8  
  4         33  
372             # Append @data to $fname.
373              
374 4         13 my $nsp = caller;
375             my $s = full_setting(\%set,$default->{$nsp})
376 4 50       17 or return errah('append: ',$default->{$nsp});
377              
378             my $oflag = ($s->{unique}) ? (O_CREAT|O_EXCL) :
379 4 50       18 ($s->{create}) ? O_CREAT : 0;
    50          
380              
381 4 50       13 my $cname = canonical $fname
382             or return errah('append: No such file "'.$fname.'" possible.',$s);
383              
384 4     4   8 return sub( @data ) {
  4         19  
  4         7  
385             return errh('append: "'.$cname.'" does not exist.',$s)
386 4 100 66     73 if (not $s->{create}) and (not -f $cname);
387             open_file($cname , O_WRONLY|$oflag , LOCK_EX , $s->{patience})
388 3 100       14 or return errh('append: ',$s);
389 2         30 seek $imfh{$cname} , 0 , 2;
390 2         12 print_file($imfh{$cname} , $s , [@data]);
391 2 50       8 close_file($cname)
392             or return errh('append: ',$s);
393 4         51 1;};
  2         19  
394             };
395              
396              
397 22     22 1 4412 sub grab( $fname , %set ) {
  22         55  
  22         48  
  22         34  
398             # Read content of $fname.
399              
400 22         69 my $nsp = caller;
401             my $s = full_setting(\%set,$default->{$nsp})
402 22 100       79 or return errah('grab: ',$default->{$nsp});
403 17 50       58 my $lflag = $s->{exclusive} ? LOCK_EX : LOCK_SH;
404 17 50       86 my $cname = canonical $fname
405             or return errah('grab: No such file "'.$fname.'" possible.',$s);
406              
407 17         56 return pgrab($cname,$s,$lflag);
408             };
409              
410              
411 0     0 1 0 sub pass( $fname , %set ) {
  0         0  
  0         0  
  0         0  
412             # Close filehandle for $fname without changing its content.
413              
414 0         0 my $nsp = caller;
415             my $s = full_setting(\%set,$default->{$nsp})
416 0 0       0 or return errah('pass: ',$default->{$nsp});
417 0 0       0 my $cname = canonical $fname
418             or return errah('pass: No such file "'.$fname.'" possible.',$s);
419              
420 0         0 return ppass($cname,$s);
421 0         0 1;};
422              
423              
424 5     5 1 2385 sub plunk( $fname , %set ) {
  5         12  
  5         14  
  5         9  
425             # Write @data to $fname.
426              
427 5         15 my $nsp = caller;
428             my $s = full_setting(\%set,$default->{$nsp})
429 5 50       21 or return errah('plunk: ',$default->{$nsp});
430              
431             my $oflag = ($s->{unique}) ? (O_CREAT|O_EXCL) :
432 5 100       27 ($s->{create}) ? O_CREAT : 0;
    50          
433              
434 5 50       14 my $cname = canonical $fname
435             or return errah('plunk: No such file "'.$fname.'" possible.',$s);
436              
437 5     5   10 return sub( @data ) {
  5         22  
  5         8  
438             return errh('plunk: "'.$cname.'" does not exist.',$s)
439 5 50 66     60 if (not $s->{create}) and (not -f $cname);
440             open_file( $cname , O_WRONLY|$oflag , LOCK_EX , $s->{patience})
441 5 100       22 or return errh('plunk: ',$s);
442 4         28 seek $imfh{$cname} , 0 , 0;
443 4         225 truncate $imfh{$cname} , 0;
444 4         34 print_file($imfh{$cname} , $s , [@data]);
445 4 50       15 close_file($cname)
446             or return errh('plunk: ',$s);
447 5         67 1;};
  4         34  
448             };
449              
450              
451 4     4 1 8 sub put( $fname , %set ) {
  4         10  
  4         7  
  4         7  
452             # Write content to $fname and close filehandle.
453              
454 4         9 my $nsp = caller;
455             my $s = full_setting(\%set,$default->{$nsp})
456 4 50       62 or return errah('put: ',$default->{$nsp});
457 4 50       11 my $cname = canonical $fname
458             or return errah('put: No such file "'.$fname.'" possible.',$s);
459              
460 5     5   126 return sub( @data ) {
  5         25  
  5         11  
461             return errh('put: "'.$cname.'" does not exist.',$s)
462 5 100       19 if not exists $imfh{$cname};
463 4         9 my $kludge = $imfh{$cname};
464 4 50       15 return errh('put: "'.$fname.'" no longer open.',$s)
465             if not defined fileno($kludge);
466              
467 4         26 seek $imfh{$cname} , 0 , 0;
468 4         250 truncate $imfh{$cname} , 0;
469 4         69 print_file($imfh{$cname} , $s , [@data]);
470 4 50       14 close_file($cname)
471             or return errh('put: ',$s);
472 4         45 1;};
  4         38  
473             };
474              
475              
476 8     8 1 4947 sub take( $fname , %set ) {
  8         19  
  8         30  
  8         11  
477             # Read content of $fname and keep filehandle open.
478              
479 8         23 my $nsp = caller;
480             my $s = full_setting(\%set,$default->{$nsp})
481 8 50       48 or return errah('ftake: ',$default->{$nsp});
482              
483             my $oflag = ($s->{unique}) ? (O_CREAT|O_EXCL) :
484 8 100       57 ($s->{create}) ? O_CREAT : 0;
    100          
485              
486 8 50       26 my $cname = canonical $fname
487             or return errah('ftake: No such file "'.$fname.'" possible.',$s);
488              
489             return errh('take: "'.$fname.'" does not exist.',$s)
490 8 100 100     157 if (not $s->{create}) and (not -f $cname);
491              
492 7         45 return ptake($cname,$s,$oflag);
493             };
494              
495             # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
496              
497 3     3 1 11 sub fgrab( $fname , %set ) {
  3         8  
  3         52  
  3         6  
498             # Functional version of grab.
499              
500 3         10 my $nsp = caller;
501             my $s = full_setting(\%set,$default->{$nsp})
502 3 100       14 or return errah('grab: ',$default->{$nsp});
503 2 50       10 my $lflag = $s->{exclusive} ? LOCK_EX : LOCK_SH;
504 2 50       7 my $cname = canonical $fname
505             or return errah('grab: No such file "'.$fname.'" possible.',$s);
506              
507             return sub {
508 3     3   13 return pgrab($cname,$s,$lflag);
509 2         24 };
510             };
511              
512              
513 1     1 1 3 sub fpass( $fname , %set ) {
  1         2  
  1         2  
  1         2  
514             # Functional version of pass.
515              
516 1         4 my $nsp = caller;
517             my $s = full_setting(\%set,$default->{$nsp})
518 1 50       4 or return errah('pass: ',$default->{$nsp});
519 1 50       5 my $cname = canonical $fname
520             or return errah('pass: No such file "'.$fname.'" possible.',$s);
521              
522             return sub {
523 3     3   12 return ppass($cname,$s);
524 1         12 };
525 0         0 1;};
526              
527              
528 2     2 1 2473 sub ftake( $fname , %set ) {
  2         7  
  2         5  
  2         3  
529             # Functional version of take.
530              
531 2         6 my $nsp = caller;
532             my $s = full_setting(\%set,$default->{$nsp})
533 2 50       10 or return errah('ftake: ',$default->{$nsp});
534              
535             my $oflag = ($s->{unique}) ? (O_CREAT|O_EXCL) :
536 2 50       9 ($s->{create}) ? O_CREAT : 0;
    50          
537              
538 2 50       24 my $cname = canonical $fname
539             or return errah('ftake: No such file "'.$fname.'" possible.',$s);
540              
541             return sub {
542 4     4   24 return take($cname,$s->%*);
543 2         23 };
544             };
545              
546              
547 2     2 1 905 sub reset() {
  2         3  
548             # Change default settings to the original defaults.
549              
550 2         8 my $nsp = caller;
551 2         22 $default->{$nsp} = {$default->{'File::Takeput'}->%*};
552 2         10 1;};
553              
554              
555 4     4 1 3983 sub set( %set ) {
  4         36  
  4         7  
556             # Change default settings.
557              
558 4         15 my $nsp = caller;
559             my $s = full_setting(\%set,$default->{$nsp})
560 4 50       20 or return errah('set: ',$default->{$nsp});
561              
562 4         19 $default->{$nsp} = $s;
563 4         24 1;};
564              
565             # ------------------------------------------------------------------------- #
566              
567             =pod
568              
569             =encoding utf8
570              
571             =head1 NAME
572              
573             File::Takeput - Slurp style file IO with locking.
574              
575             =head1 VERSION
576              
577             0.30
578              
579             =head1 SYNOPSIS
580              
581             use File::Takeput;
582              
583             # Lock some file and read its content.
584             my @content1 = take('some_file_name.csv');
585              
586             # Read content of some other file.
587             # Retry for up to 2.5 seconds if it is already locked.
588             my @content2 = grab('some_other_file_name.log' , patience => 2.5);
589              
590             # Append some data to that other file.
591             append('some_other_file_name.log')->(@some_data);
592              
593             # Read content of some third file as a single string.
594             my ($content3) = grab('some_third_file_name.html' , separator => undef);
595              
596             # Write content back to the first file after editing it.
597             # The locks will be released right afterwards.
598             $content1[$_] =~ s/,/;/g for (0..$#content1);
599             put('some_file_name.csv')->(@content1);
600              
601             =head1 DESCRIPTION
602              
603             Slurp style file IO with locking. The purpose of Takeput is to make it pleasant for you to script file IO. Slurp style is both user friendly and very effective if you can have your files in memory.
604              
605             The other major point of Takeput is locking. Takeput is careful to help your script be a good citizen in a busy filesystem. All its file operations respect and set flock locking.
606              
607             If your script misses a lock and does not release it, the lock will be released when your script terminates.
608              
609             Encoding is often part of file IO operations, but Takeput keeps out of that. It reads and writes file content just as strings of bytes, in a sort of line-based binmode. Use some other module if you need decoding and encoding. For example:
610              
611             use File::Takeput;
612             use Encode;
613              
614             my @article = map {decode('iso-8859-1',$_)} grab 'article.latin-1';
615              
616             =head1 SUBROUTINES AND VARIABLES
617              
618             Imported by default:
619             L( @data )>,
620             L,
621             L,
622             L( @data )>,
623             L( @data )>,
624             L
625              
626             Imported on demand:
627             L,
628             L,
629             L,
630             L,
631             L
632              
633             =over
634              
635             =item append( $filename )->( @data )
636              
637             Appends @data to the $filename file.
638              
639             =item grab( $filename )
640              
641             Reads and returns the content of the $filename file. Will never change the content of $filename, or create the file.
642              
643             Reading an empty file will return a list with one element, the empty string. If a false value is returned instead, it is because "grab" could not read the file.
644              
645             =item pass( $filename )
646              
647             Releases the lock on the $filename file.
648              
649             The content of the file will normally be the same as when the lock was taken with the "take" subroutine. This is useful when a lock was taken, but it later turned out that there was nothing to write to the file.
650              
651             There are two caveats. If the "create" configuration parameter is true, the file might have been created when it was taken, so it has been changed in that sense. And of course flock locks are only advisory, so other processes can ignore the locks and change the file while it is taken.
652              
653             =item plunk( $filename )->( @data )
654              
655             Overwrites the $filename file with @data.
656              
657             =item put( $filename )->( @data )
658              
659             Overwrites the taken $filename file, with @data, and releases the lock on it.
660              
661             Setting the L<"create" configuration parameter|/create> on this call will not work. Set it on the "take" call instead.
662              
663             =item take( $filename )
664              
665             Sets a lock on the $filename file, reads and returns its content.
666              
667             The "take" call has write intention, because it is the first part of an operation. The second part is a call A call to "put" or "pass".
668              
669             Opening an empty file will return a list with one element, the empty string. If a false value is returned instead, it is because "take" could not read the file.
670              
671             =item fgrab( $filename )
672              
673             A functional version of the "grab" subroutine.
674              
675             =item fpass( $filename )
676              
677             A functional version of the "pass" subroutine.
678              
679             =item ftake( $filename )
680              
681             A functional version of the "take" subroutine.
682              
683             Note that "take"s twin, "put", also returns a function. With these you can separate the file operations from their definitions. As you can with filehandles. This is true for all the functional subroutines. Here is an example using "ftake" and "put", where they are sent as parameters.
684              
685             sub changecurr($r,$w,$x) {
686             $w->( map {s/((\d*\.)?\d+)/$x*$1/ger} $r->() );
687             };
688              
689             my $r = ftake('wednesday.csv' , patience => 5);
690             my $w = put('wednesday.csv');
691             my $rate = current_rate('GBP');
692             changecurr($r,$w,$rate);
693              
694             =item reset
695              
696             Sets the default configuration parameters back to the Takeput defaults.
697              
698             =item set( %settings )
699              
700             Customize the default values by setting parameters as in %settings. Can be reset by calling "reset".
701              
702             =back
703              
704             =head1 CONFIGURATION
705              
706             There are eight configuration parameters.
707              
708             =over
709              
710             =item create
711              
712             A scalar. If true the subroutines that have write intention, will create the file if it does not exist. If false, they will just fail if the file does not exist.
713              
714             Be careful with this parameter. For example if a process renames the file while another process is waiting for the lock, that other process will open the file with the new name when it gets the lock. If it plunks, it is not to a file with the name it was called with, but to the file with this new name. Maybe not what is wanted...
715              
716             The "create" parameter is ignored by "put". Use it on "take" instead, if you want this functionality.
717              
718             =item error
719              
720             A ref to a subroutine that is called if Takeput runs into a runtime error. It will be called without parameters. The $@ variable will be set just prior to the subroutine call, and the subroutines return value will be passed on back to your script. An example:
721              
722             use Logger::Syslog qw(warning);
723             use File::Takeput error => sub {warning 'commit.pl: '.$@; die;};
724              
725             my @data = take('transaction.data' , patience => 10);
726             do_stuff [@data];
727             put('transaction.data')->(@data);
728              
729             If you just need non-fatal warnings, here is a simple error handler you can use:
730              
731             use File::Takeput error => sub {print STDERR "$@\n"; undef;};
732              
733             If the value of "error" is undef, Takeput will not make these calls.
734              
735             =item exclusive
736              
737             A scalar. If true Takeput will take an exclusive lock on read operations. If false it will just take a shared lock on them, as it normally does.
738              
739             =item flatten
740              
741             A scalar. If true Takeput will flatten the file content and return it as a string. If false it will return an array.
742              
743             Normally you would also set "separator" to undef, when you set "flatten" to true. For example:
744              
745             use YAML::XS qw(Load Dump); # Working with YAML.
746              
747             File::Takeput::set(separator => undef , flatten => 1); # Because of this...
748             my $fancy_data = Load grab('my_file.yaml'); # ...this will work.
749              
750             Note that with "flatten" set to true, reading an empty file returns the empty string, which counts as false. Failing to read a file returns undef. So test for definedness to not be tricked by this.
751              
752             =item newline
753              
754             A string that replaces the "separator" string at the end of each line when reading from a file. When writing to a file the replacement is the other way around. Then "separator" will replace "newline".
755              
756             If either the "newline" value or the "separator" value is undef, no replacements will be done.
757              
758             =item patience
759              
760             The time in seconds that a call will wait for a lock to be released. The value can be fractional.
761              
762             If "patience" is set to 0, there will be no waiting.
763              
764             =item separator
765              
766             The string defining the end of a line. It is used in read operations to split the data into lines. Note that the value is read as a bytestring. So take care if you use a special separator in combination with an unusual encoding.
767              
768             Setting this parameter does not change the value of $/ or vice versa.
769              
770             The "separator" value cannot be an empty string. If it is undef the data is seen as a single string.
771              
772             =item unique
773              
774             A scalar. If true Takeput will fail opening a file if it already exists. This can be used to avoid race conditions.
775              
776             Only used by calls with write intention.
777              
778             If "unique" is true, calls will work as if "create" is true and "patience" is 0, no matter what they are set to.
779              
780             =back
781              
782             =head2 CONFIGURATION OPTIONS
783              
784             You have a number of options for setting the configuration parameters.
785              
786             =over
787              
788             =item 1. In a file operation call, as optional named parameters.
789              
790             =item 2. In a statement by calling "set" or "reset".
791              
792             =item 3. Directly in the use statement of your script.
793              
794             =item 4. Default configuration.
795              
796             =back
797              
798             If a parameter is set in more than one way, the most specific setting wins out. In the list above, the item with the lowest number wins out.
799              
800             =head3 1. OPTIONAL NAMED PARAMETERS
801              
802             All the file operation subroutines can take the configuration parameters as optional named parameters. That means that you can set them per call. The place to write them is after the filename parameter. Example:
803              
804             my @text = grab 'windows_file.txt' , separator => "\r\n" , newline => "\n";
805              
806             =head3 2. SET AND RESET SUBROUTINES
807              
808             The two subroutines "set" and "reset" will customize the default values of the configuration parameters, so that subsequent file operations are using those defaults.
809              
810             You use "set" to set the values, and "reset" to set the values back to the Takeput defaults. Think of it as assignment statements. If there are multiple calls, the last one is the one that is in effect.
811              
812             Customized defaults are limited to the namespace in which you set them.
813              
814             =head3 3. USE STATEMENT
815              
816             Another way to customize the default values is in the use statement that imports Takeput. For example:
817              
818             use File::Takeput separator => "\n";
819              
820             When you do it like this, the values are set at compile-time. Because of that, Takeput will die on any errors that those settings will give rise to.
821              
822             Note that customized defaults are limited to the namespace in which you set them.
823              
824             =head3 4. DEFAULT CONFIGURATION
825              
826             The Takeput defaults are:
827              
828             C: undef (false)
829              
830             C: undef
831              
832             C: undef (false)
833              
834             C: undef (false)
835              
836             C: undef
837              
838             C: 0
839              
840             C: $/ (at compile time)
841              
842             C: undef (false)
843              
844             =head1 ERROR HANDLING
845              
846             Takeput will die on compile-time errors, but not on runtime errors. In case of a runtime error it might or might not issue a warning. But it will always write an error message in $@ and return an error value.
847              
848             That said, you have the option of changing how runtime errors are handled, by using the L<"error" configuration parameter|/error>.
849              
850             =head1 DEPENDENCIES
851              
852             Cwd
853              
854             Exporter
855              
856             Fcntl
857              
858             File::Basename
859              
860             Scalar::Util
861              
862             Time::HiRes
863              
864             =head1 KNOWN ISSUES
865              
866             No known issues.
867              
868             =head1 TODO
869              
870             Decide on empty string "separator". It ought to give a list of bytes, but readline gives an unintuitive list. It would be a mess with the line ending transformations.
871              
872             An empty string will be an invalid value for now.
873              
874             =head1 SEE ALSO
875              
876             L
877              
878             L
879              
880             L
881              
882             =head1 LICENSE & COPYRIGHT
883              
884             (c) 2023 Bjørn Hee
885              
886             Licensed under the Apache License, version 2.0
887              
888             https://www.apache.org/licenses/LICENSE-2.0.txt
889              
890             =cut
891              
892             __END__