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