CWMP/Store/HASH.pm

package CWMP::Store::HASH;

use strict;
use warnings;

use Exporter 'import';
our @EXPORT = qw/
        $debug
/;

use Data::Dump qw/dump/;
use Hash::Merge qw/merge/;
use Carp qw/confess/;

=head1 NAME

CWMP::Store::HASH - base class for hash based storage engines

=head1 METHODS

=head2 open

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

=cut

my $path;

my $debug = 0;

sub open {
        my $self = shift;

        my $args = shift;

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

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

        $path = $self->full_path( $path );

        if ( ! -e $path ) {
                mkdir $path || die "can't create $path: $!";
                warn "created $path directory\n" if $debug;
        } elsif ( $args->{clean} ) {
                warn "removed old $path\n" if $debug;
                foreach my $uid ( $self->all_uids ) {
                        my $file = $self->file( $uid );
                        unlink $file || die "can't remove $file: $!";
                }
        }


}

=head2 update_uid_state

  my $new_state = $store->update_uid_state( $uid, $state );

=cut

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

        my $file = $self->file( $uid );

        my $old_state = $self->get_state( $uid );

        my $combined = merge( $state, $old_state );

#       warn "## ",dump( $old_state, $state, $combined );

        $self->save_hash( $file, $combined ) || die "can't write $file: $!";

        return $combined;
}

=head2 get_state

  $store->get_state( $uid );

=cut

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

        my $file = $self->file( $uid );

        if ( -e $file ) {
                return $self->load_hash( $file );
        }

        return;
}

=head2 all_uids

  my @uids = $store->all_uids;

=cut

sub all_uids {
        my $self = shift;

        my $ext = $self->extension;
        #warn "## extension: $ext";

        opendir(my $d, $path) || die "can't opendir $path: $!";
        my @uids = grep { $_ =~ m/\Q$ext\E$/ && -f "$path/$_" } readdir($d);
        closedir $d;

        return map { my $l = $_; $l =~ s/\Q$ext\E$//; $l } @uids;
}

1;
1	package CWMP::Store::HASH;
2
3	use strict;
4	use warnings;
5
6	use Exporter 'import';
7	our @EXPORT = qw/
8	$debug
9	/;
10
11	use Data::Dump qw/dump/;
12	use Hash::Merge qw/merge/;
13	use Carp qw/confess/;
14
15	=head1 NAME
16
17	CWMP::Store::HASH - base class for hash based storage engines
18
19	=head1 METHODS
20
21	=head2 open
22
23	$store->open({
24	path => 'var/',
25	debug => 1,
26	clean => 1,
27	});
28
29	=cut
30
31	my $path;
32
33	my $debug = 0;
34
35	sub open {
36	my $self = shift;
37
38	my $args = shift;
39
40	$debug = $args->{debug};
41	$path = $args->{path} \|\| confess "no path?";
42
43	warn "open ",dump( $args ) if $debug;
44
45	$path = $self->full_path( $path );
46
47	if ( ! -e $path ) {
48	mkdir $path \|\| die "can't create $path: $!";
49	warn "created $path directory\n" if $debug;
50	} elsif ( $args->{clean} ) {
51	warn "removed old $path\n" if $debug;
52	foreach my $uid ( $self->all_uids ) {
53	my $file = $self->file( $uid );
54	unlink $file \|\| die "can't remove $file: $!";
55	}
56	}
57
58
59	}
60
61	=head2 update_uid_state
62
63	my $new_state = $store->update_uid_state( $uid, $state );
64
65	=cut
66
67	sub update_uid_state {
68	my ( $self, $uid, $state ) = @_;
69
70	my $file = $self->file( $uid );
71
72	my $old_state = $self->get_state( $uid );
73
74	my $combined = merge( $state, $old_state );
75
76	# warn "## ",dump( $old_state, $state, $combined );
77
78	$self->save_hash( $file, $combined ) \|\| die "can't write $file: $!";
79
80	return $combined;
81	}
82
83	=head2 get_state
84
85	$store->get_state( $uid );
86
87	=cut
88
89	sub get_state {
90	my ( $self, $uid ) = @_;
91
92	my $file = $self->file( $uid );
93
94	if ( -e $file ) {
95	return $self->load_hash( $file );
96	}
97
98	return;
99	}
100
101	=head2 all_uids
102
103	my @uids = $store->all_uids;
104
105	=cut
106
107	sub all_uids {
108	my $self = shift;
109
110	my $ext = $self->extension;
111	#warn "## extension: $ext";
112
113	opendir(my $d, $path) \|\| die "can't opendir $path: $!";
114	my @uids = grep { $_ =~ m/\Q$ext\E$/ && -f "$path/$_" } readdir($d);
115	closedir $d;
116
117	return map { my $l = $_; $l =~ s/\Q$ext\E$//; $l } @uids;
118	}
119
120	1;