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

=head1 NAME

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

=head1 METHODS

=head2 open

  $store->open({
        path => 'var/',
        debug => 1,
        clean => 1,
  });

=cut

my $db;

my $debug = 0;

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} );

        if ( $args->{clean} && -e $path ) {
                warn "removed old $path\n";
                unlink $path || die "can't remove $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 ) = @_;

        my $data = clone( $state );

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

=head2 get_state

  $store->get_state( $uid );

=cut

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

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

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