CWMP/Store/DBMDeep.pm

# Dobrica Pavlinusic, <dpavlin@rot13.org> 10/26/07 21:37:12 CEST
package CWMP::Store::DBMDeep;

use strict;
use warnings;

use DBM::Deep;
use Data::Dump qw/dump/;

=head1 NAME

CWMP::Store::DBMDeep - use DBM::Deep as storage

=head1 METHODS

=head2 open

=cut

my $db;

my $debug = 1;

sub open {
        my $self = shift;

        warn "open ",dump( @_ );

        my $path = 'state.db';

        $db = DBM::Deep->new(
                file => $path,
                locking => 1,
                autoflush => 1,
        );

}

=head2 update_uid_state

  $store->update_uid_state( $uid, $state );

=cut

sub update_uid_state {
        my ( $self, $uid, $state ) = @_;

        if ( my $o = $db->get( $uid ) ) {
                warn "## update state of $uid\n" if $debug;
                return $o->import( $state );
        } else {
                warn "## create new state for $uid\n" if $debug;
                return $db->put( $uid => $state );
        }
}

=head2 get_state

  $store->get_state( $uid );

=cut

sub get_state {
        my ( $self, $uid ) = @_;

        if ( my $state = $db->get( $uid ) ) {
                return $state->export;
        } else {
                return;
        }
}

=head2 all_uids

  my @uids = $store->all_uids;

=cut

sub all_uids {
        my $self = shift;
        return keys %$db;
}

1;
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
10	=head1 NAME
11
12	CWMP::Store::DBMDeep - use DBM::Deep as storage
13
14	=head1 METHODS
15
16	=head2 open
17
18	=cut
19
20	my $db;
21
22	my $debug = 1;
23
24	sub open {
25	my $self = shift;
26
27	warn "open ",dump( @_ );
28
29	my $path = 'state.db';
30
31	$db = DBM::Deep->new(
32	file => $path,
33	locking => 1,
34	autoflush => 1,
35	);
36
37	}
38
39	=head2 update_uid_state
40
41	$store->update_uid_state( $uid, $state );
42
43	=cut
44
45	sub update_uid_state {
46	my ( $self, $uid, $state ) = @_;
47
48	if ( my $o = $db->get( $uid ) ) {
49	warn "## update state of $uid\n" if $debug;
50	return $o->import( $state );
51	} else {
52	warn "## create new state for $uid\n" if $debug;
53	return $db->put( $uid => $state );
54	}
55	}
56
57	=head2 get_state
58
59	$store->get_state( $uid );
60
61	=cut
62
63	sub get_state {
64	my ( $self, $uid ) = @_;
65
66	if ( my $state = $db->get( $uid ) ) {
67	return $state->export;
68	} else {
69	return;
70	}
71	}
72
73	=head2 all_uids
74
75	my @uids = $store->all_uids;
76
77	=cut
78
79	sub all_uids {
80	my $self = shift;
81	return keys %$db;
82	}
83
84	1;