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

  $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 ) = @_;

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