Revision: | 1.2 |
Committed: | Wed Dec 5 11:08:34 2007 UTC (16 years, 8 months ago) by root |
Branch: | MAIN |
CVS Tags: | rel-2_82, rel-2_81, rel-2_80, rel-2_6, rel-2_7, rel-2_4, rel-2_5, rel-2_72, rel-2_73, rel-2_71, rel-2_76, rel-2_77, rel-2_74, rel-2_75, rel-2_54, rel-2_55, rel-2_56, rel-2_79, rel-2_52, rel-2_53, rel-2_90, rel-2_78, rel-2_61, rel-2_43, rel-2_42, rel-2_41 |
Changes since 1.1: | +3 -3 lines |
Log Message: | switch to JSON::XS 2.01 API |
# | 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::encode_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::decode_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::encode_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 |