use DBM::Deep;
use Data::Dump qw/dump/;
+use Clone qw/clone/;
+use Carp qw/confess/;
=head1 NAME
=head2 open
+ $store->open({
+ path => 'var/',
+ debug => 1,
+ clean => 1,
+ });
+
=cut
my $db;
-my $debug = 1;
+my $debug = 0;
sub open {
my $self = shift;
- warn "open ",dump( @_ );
+ my $args = shift;
+
+ $debug = $args->{debug};
+ my $path = $args->{path} || confess "no path?";
- my $path = 'state.db';
+ warn "open ",dump( $args ) if $debug;
+
+ $path = "$path/state.db" if ( -d $args->{path} );
+
+ if ( $args->{clean} && -e $path ) {
+ warn "removed old $path\n";
+ unlink $path || die "can't remove $path: $!";
+ }
$db = DBM::Deep->new(
file => $path,
locking => 1,
autoflush => 1,
- );
+ ) || confess "can't open $path: $!";
}
sub update_uid_state {
my ( $self, $uid, $state ) = @_;
+ my $data = clone( $state );
+
if ( my $o = $db->get( $uid ) ) {
warn "## update state of $uid\n" if $debug;
- return $o->import( $state );
+ $o->import( $data );
} else {
warn "## create new state for $uid\n" if $debug;
- return $db->put( $uid => $state );
+ $db->put( $uid => $data );
}
}
my ( $self, $uid ) = @_;
if ( my $state = $db->get( $uid ) ) {
- return $state->export;
- } else {
- return;
+ $state->export;
}
}