r228@brr: dpavlin | 2007-11-18 13:58:05 +0100
[perl-cwmp.git] / lib / CWMP / Store / DBMDeep.pm
index 0c3c6d3..80fabd1 100644 (file)
@@ -6,6 +6,8 @@ use warnings;
 
 use DBM::Deep;
 use Data::Dump qw/dump/;
+use Clone qw/clone/;
+use Carp qw/confess/;
 
 =head1 NAME
 
@@ -15,24 +17,40 @@ CWMP::Store::DBMDeep - use DBM::Deep as storage
 
 =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: $!";
 
 }
 
@@ -45,12 +63,14 @@ sub open {
 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 );
        }
 }
 
@@ -64,9 +84,7 @@ sub get_state {
        my ( $self, $uid ) = @_;
 
        if ( my $state = $db->get( $uid ) ) {
-               return $state->export;
-       } else {
-               return;
+               $state->export;
        }
 }