1# $File: //depot/libOurNet/BBS/lib/OurNet/BBS/ScalarFile.pm $ $Author: autrijus $ 2# $Revision: #4 $ $Change: 4012 $ $DateTime: 2003/01/29 11:06:24 $ 3 4package OurNet::BBS::ScalarFile; 5use strict; 6no warnings 'deprecated'; 7 8use if ($^O eq 'MSWin32'), open => (IN => ':bytes', OUT => ':bytes'); 9use if $OurNet::BBS::Encoding, open => ":encoding($OurNet::BBS::Encoding)"; 10 11sub TIESCALAR { 12 my ($class, $filename) = @_; 13 my ($cache, $mtime) = (undef, 0); 14 15 return bless([$filename, $mtime, $cache], $class); 16} 17 18sub FETCH { 19 my $self = shift; 20 my $filename = $self->[0]; 21 22 if (-e $filename) { 23 return $self->[2] if ((stat($filename))[9] == $self->[1]); # cached 24 $self->[1] = (stat($filename))[9]; 25 26 local $/; 27 open(my $FILE, "<$filename") or die "cannot read $filename: $!"; 28 $self->[2] = <$FILE>; 29 close $FILE; 30 31 return $self->[2]; 32 } 33 else { 34 undef $self->[1]; # empties mtime 35 undef $self->[2]; # empties cache 36 return; 37 } 38} 39 40sub STORE { 41 my $self = shift; 42 my $filename = $self->[0]; 43 44 no warnings 'uninitialized'; 45 46 if (defined($_[0])) { 47 if (length($self->[2]) and 48 length($_[0]) >= length($self->[2]) and 49 substr($_[0], 0, length($self->[2])) eq $self->[2]) 50 { 51 # append mode 52 open(my $FILE, ">>$filename") 53 or die "cannot append $filename: $!"; 54 print $FILE substr($_[0], length($self->[2])); 55 close $FILE; 56 } 57 else { 58 open(my $FILE, ">$filename") 59 or die "cannot write $filename: $!"; 60 print $FILE $_[0]; 61 close $FILE; 62 } 63 $self->[1] = (stat($filename))[9]; 64 $self->[2] = $_[0]; 65 } 66 else { 67 # store undef: kill the file 68 undef $self->[1]; 69 unlink $filename or die "cannot delete $filename: $!" if -e $filename; 70 } 71 72 return $self->[2]; 73} 74 751; 76