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