lib/CWMP/Store/DBMDeep.pm

   1 # Dobrica Pavlinusic, <dpavlin@rot13.org> 10/26/07 21:37:12 CEST
   2 package CWMP::Store::DBMDeep;
   3
   4 use strict;
   5 use warnings;
   6
   7 use DBM::Deep;
   8 use Data::Dump qw/dump/;
   9 use Carp qw/confess/;
  10
  11 =head1 NAME
  12
  13 CWMP::Store::DBMDeep - use DBM::Deep as storage
  14
  15 =head1 METHODS
  16
  17 =head2 open
  18
  19   $store->open({
  20         path => 'var/',
  21         debug => 1,
  22         clean => 1,
  23   });
  24
  25 =cut
  26
  27 my $db;
  28
  29 my $debug = 0;
  30
  31 sub open {
  32         my $self = shift;
  33
  34         my $args = shift;
  35
  36         $debug = $args->{debug};
  37         my $path = $args->{path} || confess "no path?";
  38
  39         warn "open ",dump( $args ) if $debug;
  40
  41         $path = "$path/state.db" if ( -d $args->{path} );
  42
  43         if ( $args->{clean} && -e $path ) {
  44                 warn "removed old $path\n";
  45                 unlink $path || die "can't remove $path: $!";
  46         }
  47
  48         $db = DBM::Deep->new(
  49                 file => $path,
  50                 locking => 1,
  51                 autoflush => 1,
  52         ) || confess "can't open $path: $!";
  53
  54 }
  55
  56 =head2 update_uid_state
  57
  58   $store->update_uid_state( $uid, $state );
  59
  60 =cut
  61
  62 sub update_uid_state {
  63         my ( $self, $uid, $state ) = @_;
  64
  65         if ( my $o = $db->get( $uid ) ) {
  66                 warn "## update state of $uid\n" if $debug;
  67                 return $o->import( $state );
  68         } else {
  69                 warn "## create new state for $uid\n" if $debug;
  70                 return $db->put( $uid => $state );
  71         }
  72 }
  73
  74 =head2 get_state
  75
  76   $store->get_state( $uid );
  77
  78 =cut
  79
  80 sub get_state {
  81         my ( $self, $uid ) = @_;
  82
  83         if ( my $state = $db->get( $uid ) ) {
  84                 return $state->export;
  85         } else {
  86                 return;
  87         }
  88 }
  89
  90 =head2 all_uids
  91
  92   my @uids = $store->all_uids;
  93
  94 =cut
  95
  96 sub all_uids {
  97         my $self = shift;
  98         return keys %$db;
  99 }
 100
 101 1;