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/;
use Carp qw/confess/;

=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;

        my $args = shift;

        $debug = $args->{debug};
        my $path = $args->{path} || confess "no path?";

        warn "open ",dump( $args ) if $debug;

        $path = "$path/state.db" if ( -d $args->{path} );

        $db = DBM::Deep->new(
                file => $path,
                locking => 1,
                autoflush => 1,
        ) || confess "can't open $path: $!";

}

=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	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;