ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cf.schmorp.de/maps/perl/CFDB.pm
Revision: 1.3
Committed: Fri Dec 15 19:11:46 2006 UTC (17 years, 7 months ago) by root
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +0 -0 lines
State: FILE REMOVED
Log Message:
move .ext to server

File Contents

# Content
1 package CFDB;
2
3 use Carp;
4 use POSIX qw/strftime/;
5
6 sub write_file {
7 my ($file, $cont) = @_;
8
9 open my $f, ">", "$file.tmp"
10 or die "Couldn't open file for writing $file.tmp: $!";
11 print $f $cont
12 or die "Couldn't write to file $file.tmp: $!";;
13 close $f
14 or die "Couldn't close written file $file.tmp: $!";
15
16 rename "$file.tmp", $file;
17 }
18
19 sub read_file {
20 my ($file) = @_;
21 open my $f, "<", "$file"
22 or die "Couldn't open file $file: $!";
23 return join '', <$f>;
24 }
25
26 sub new {
27 my ($class, %arg) = @_;
28
29 my $self = bless {
30 %arg,
31 }, $class;
32
33 $self->{last_check} = (-M $self->{db_file}) + 1;
34 unless (-e $self->{db_file}) {
35 write_file ($self->{db_file}, cf::to_json ({}));
36 }
37 $self->check_maildb ();
38
39 $self;
40 }
41
42 sub check_maildb {
43 my ($self) = @_;
44
45 if ($self->{last_check} > (-M $self->{db_file})) {
46 $self->{last_check} = -M $self->{db_file};
47
48 my $maildb = eval { my $m = cf::from_json read_file $self->{db_file}; return $m };
49 if ($@) {
50 warn "ERROR when reading mail database $self->{db_file}: $@\n";
51 $self->{db_file} = $self->{db_file} . ".after_failure";
52 } else {
53 $self->{maildb} = $maildb;
54 }
55 }
56 }
57
58 # This is not thread or multiprocess safe!
59 # XXX: A second process will (of course) terribly damage the maildatabase
60 # but i assume there wont be any second process.
61 sub sync_maildb {
62 my ($self) = @_;
63
64 write_file ($self->{db_file}, cf::to_json ($self->{maildb}));
65 $self->{last_check} = -M $self->{db_file};
66 }
67
68 sub get {
69 my ($self, $key) = @_;
70 $self->check_maildb;
71 $self->{maildb}->{$key};
72 }
73
74 sub clear {
75 my ($self, $key) = @_;
76 $self->check_maildb;
77 delete $self->{maildb}->{$key};
78 $self->sync_maildb;
79 }
80
81 sub set {
82 my ($self, $key, $value) = @_;
83 $self->check_maildb;
84 $self->{maildb}->{$key} = $value;
85 $self->sync_maildb;
86 }
87 1