1#!/usr/bin/perl -I../p 2# Copyright (c) 1998-1999 Sampo Kellomaki <sampo@iki.fi>, All Rights Reserved. 3# This software may not be used or distributed for free or under any other 4# terms than those detailed in file COPYING. There is ABSOLUTELY NO WARRANTY. 5 6# Slurp and barf files with flock. These are supposed to be reasonably 7# efficient, too. Stdio is bypassed, for example. 8 9package filex; 10use integer; 11 12$trace = 0; 13 14sub slurp { 15 my ($t,$nowarn) = @_; 16 if (open(T, "<$t")) { 17 flock T, 1; # Shared 18 sysseek(T, 0, 0); 19 sysread T, $t, -s(T); 20 flock T, 8; 21 close T; 22 return $t; 23 } else { 24 my ($p,$f,$l)=caller; 25 warn "$$: Cant read `$t' ($! at $f line $l)\n" unless $nowarn; 26 return undef; 27 } 28} 29 30sub barf { 31 my ($t, $d) = @_; 32 my ($p,$f,$l)=caller; 33 umask 002; 34 ($t) = $t =~ /^([^|;:&]+)$/; # untaint 35 warn "$$: Barfing $t at $f line $l\n" if $trace; 36 if (open(T, ">$t")) { 37 flock T, 2; # Exclusive 38 sysseek(T, 0, 0); 39 syswrite T, $d, length($d); # Bypass stdio for efficiency 40 flock T, 8; 41 close T or do { 42 warn "$$: Cant write `$t' ($! at $f line $l)\n"; 43 return undef; 44 }; 45 return length($d) 46 } else { 47 warn "$$: Cant write `$t' ($! at $f line $l)\n"; 48 return undef; 49 } 50} 51 52### This is really a multitasking synchronization primitive, useful 53### for maintaining unique numbers. 54 55sub inc { 56 my ($t,$inc) = @_; 57 if (open(T, "+<$t")) { 58 flock T, 2; # Exclusive 59 60 seek(T, 0, 0); 61 $t = <T>; 62 chomp $t; 63 seek(T, 0, 0); 64 if ($inc eq 'a') { 65 print T ++$t; 66 } else { 67 print T $t + $inc; 68 } 69 truncate T, tell T; 70 71 flock T, 8; 72 close T; 73 return $t; 74 } else { 75 my ($p,$f,$l)=caller; 76 warn "$$: Cant update `$t' ($! at $f line $l)"; 77 return ''; 78 } 79} 80 81### Safely add a line to log 82 83sub append { 84 my ($t,$line) = @_; 85 if (open(T, ">>$t")) { 86 flock T, 2; # Exclusive 87 88 seek(T, 0, 2); # Go to absolute end of file (someone could have 89 # written to the file while we were waiting for 90 # flock) 91 print T $line; 92 flock T, 8; 93 close T; 94 return 1; 95 } else { 96 my ($p,$f,$l)=caller; 97 warn "$$: Cant append `$t' ($! at $f line $l)"; 98 return 0; 99 } 100} 101 1021; 103 104# EOF 105