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 |
# | User | Rev | Content |
---|---|---|---|
1 | root | 1.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 | root | 1.2 | write_file ($self->{db_file}, cf::encode_json ({})); |
36 | root | 1.1 | } |
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 | root | 1.2 | my $maildb = eval { my $m = cf::decode_json read_file $self->{db_file}; return $m }; |
49 | root | 1.1 | 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 | root | 1.2 | write_file ($self->{db_file}, cf::encode_json ($self->{maildb})); |
65 | root | 1.1 | $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 |