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 =cut
  20
  21 my $db;
  22
  23 my $debug = 1;
  24
  25 sub open {
  26         my $self = shift;
  27
  28         my $args = shift;
  29
  30         $debug = $args->{debug};
  31         my $path = $args->{path} || confess "no path?";
  32
  33         warn "open ",dump( $args ) if $debug;
  34
  35         $path = "$path/state.db" if ( -d $args->{path} );
  36
  37         $db = DBM::Deep->new(
  38                 file => $path,
  39                 locking => 1,
  40                 autoflush => 1,
  41         ) || confess "can't open $path: $!";
  42
  43 }
  44
  45 =head2 update_uid_state
  46
  47   $store->update_uid_state( $uid, $state );
  48
  49 =cut
  50
  51 sub update_uid_state {
  52         my ( $self, $uid, $state ) = @_;
  53
  54         if ( my $o = $db->get( $uid ) ) {
  55                 warn "## update state of $uid\n" if $debug;
  56                 return $o->import( $state );
  57         } else {
  58                 warn "## create new state for $uid\n" if $debug;
  59                 return $db->put( $uid => $state );
  60         }
  61 }
  62
  63 =head2 get_state
  64
  65   $store->get_state( $uid );
  66
  67 =cut
  68
  69 sub get_state {
  70         my ( $self, $uid ) = @_;
  71
  72         if ( my $state = $db->get( $uid ) ) {
  73                 return $state->export;
  74         } else {
  75                 return;
  76         }
  77 }
  78
  79 =head2 all_uids
  80
  81   my @uids = $store->all_uids;
  82
  83 =cut
  84
  85 sub all_uids {
  86         my $self = shift;
  87         return keys %$db;
  88 }
  89
  90 1;