maps/perl/YAMLDB.pm

package YAMLDB;
use YAML::Error;
use Carp;
use YAML qw/LoadFile DumpFile Dump/;
use POSIX qw/strftime/;

sub new {
   my ($class, %arg) = @_;

   my $self = bless {
      %arg,
   }, $class;

   $self->{last_check} = (-M $self->{db_file}) + 1;
   unless (-x $self->{db_file}) {
      DumpFile ($self->{db_file}, {});
   }
   $self->check_maildb ();

   $self;
}

sub check_maildb {
   my ($self) = @_;

   if ($self->{last_check} > (-M $self->{db_file})) {
      $self->{last_check} = -M $self->{db_file};

      my $maildb = eval { my $m = LoadFile ($self->{db_file}); return $m };
      if ($@) {
         warn "ERROR when reading mail database $self->{db_file}: $@\n";
         $self->{db_file} = $self->{db_file} . ".after_failure";
      } else {
         $self->{maildb} = $maildb;
      }
   }
}

# This is not thread or multiprocess safe!
# XXX: A second process will (of course) terribly damage the maildatabase
# but i assume there wont be any second process.
sub sync_maildb {
   my ($self) = @_;

   eval {
      DumpFile ("$self->{db_file}.tmp", $self->{maildb});
   };
   if ($@) {
      warn "ERROR when writing mail database $self->{db_file}.tmp: $@\n";
   } else {
      rename "$self->{db_file}.tmp", $self->{db_file};
      $self->{last_check} = -M $self->{db_file};
   }
}

sub get {
   my ($self, $key) = @_;
   $self->check_maildb;
   $self->{maildb}->{$key};
}

sub clear {
   my ($self, $key) = @_;
   $self->check_maildb;
   delete $self->{maildb}->{$key};
   $self->sync_maildb;
}

sub set {
   my ($self, $key, $value) = @_;
   $self->check_maildb;
   $self->{maildb}->{$key} = $value;
   $self->sync_maildb;
}
1
Revision:	1.3
Committed:	Wed Aug 9 11:54:02 2006 UTC (20 years, 2 months ago) by elmex
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.2:	+0 -0 lines
State:	*FILE REMOVED*
Log Message:	the ipo and board are now converted to JSON and the board works now too.
#	User	Rev	Content
1	elmex	1.1	package YAMLDB;
2	elmex	1.2	use YAML::Error;
3			use Carp;
4	elmex	1.1	use YAML qw/LoadFile DumpFile Dump/;
5			use POSIX qw/strftime/;
6
7			sub new {
8			my ($class, %arg) = @_;
9
10			my $self = bless {
11			%arg,
12			}, $class;
13
14			$self->{last_check} = (-M $self->{db_file}) + 1;
15			unless (-x $self->{db_file}) {
16			DumpFile ($self->{db_file}, {});
17			}
18			$self->check_maildb ();
19
20			$self;
21			}
22
23			sub check_maildb {
24			my ($self) = @_;
25
26			if ($self->{last_check} > (-M $self->{db_file})) {
27			$self->{last_check} = -M $self->{db_file};
28
29			my $maildb = eval { my $m = LoadFile ($self->{db_file}); return $m };
30			if ($@) {
31			warn "ERROR when reading mail database $self->{db_file}: $@\n";
32			$self->{db_file} = $self->{db_file} . ".after_failure";
33			} else {
34			$self->{maildb} = $maildb;
35			}
36			}
37			}
38
39			# This is not thread or multiprocess safe!
40			# XXX: A second process will (of course) terribly damage the maildatabase
41			# but i assume there wont be any second process.
42			sub sync_maildb {
43			my ($self) = @_;
44
45			eval {
46			DumpFile ("$self->{db_file}.tmp", $self->{maildb});
47			};
48			if ($@) {
49			warn "ERROR when writing mail database $self->{db_file}.tmp: $@\n";
50			} else {
51			rename "$self->{db_file}.tmp", $self->{db_file};
52			$self->{last_check} = -M $self->{db_file};
53			}
54			}
55
56			sub get {
57			my ($self, $key) = @_;
58			$self->check_maildb;
59			$self->{maildb}->{$key};
60			}
61
62			sub clear {
63			my ($self, $key) = @_;
64			$self->check_maildb;
65			delete $self->{maildb}->{$key};
66			$self->sync_maildb;
67			}
68
69			sub set {
70			my ($self, $key, $value) = @_;
71			$self->check_maildb;
72			$self->{maildb}->{$key} = $value;
73			$self->sync_maildb;
74			}
75			1