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;

my $cleaned = 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} && ! $cleaned ) {
                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: $!";
                }
                $cleaned++;
        }


}

=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	my $cleaned = 0;
36
37	sub open {
38	my $self = shift;
39
40	my $args = shift;
41
42	$debug = $args->{debug};
43	$path = $args->{path} \|\| confess "no path?";
44
45	warn "open ",dump( $args ) if $debug;
46
47	$path = $self->full_path( $path );
48
49	if ( ! -e $path ) {
50	mkdir $path \|\| die "can't create $path: $!";
51	warn "created $path directory\n" if $debug;
52	} elsif ( $args->{clean} && ! $cleaned ) {
53	warn "removed old $path\n" if $debug;
54	foreach my $uid ( $self->all_uids ) {
55	my $file = $self->file( $uid );
56	unlink $file \|\| die "can't remove $file: $!";
57	}
58	$cleaned++;
59	}
60
61
62	}
63
64	=head2 update_uid_state
65
66	my $new_state = $store->update_uid_state( $uid, $state );
67
68	=cut
69
70	sub update_uid_state {
71	my ( $self, $uid, $state ) = @_;
72
73	my $file = $self->file( $uid );
74
75	my $old_state = $self->get_state( $uid );
76
77	my $combined = merge( $state, $old_state );
78
79	# warn "## ",dump( $old_state, $state, $combined );
80
81	$self->save_hash( $file, $combined ) \|\| die "can't write $file: $!";
82
83	return $combined;
84	}
85
86	=head2 get_state
87
88	$store->get_state( $uid );
89
90	=cut
91
92	sub get_state {
93	my ( $self, $uid ) = @_;
94
95	my $file = $self->file( $uid );
96
97	if ( -e $file ) {
98	return $self->load_hash( $file );
99	}
100
101	return;
102	}
103
104	=head2 all_uids
105
106	my @uids = $store->all_uids;
107
108	=cut
109
110	sub all_uids {
111	my $self = shift;
112
113	my $ext = $self->extension;
114	#warn "## extension: $ext";
115
116	opendir(my $d, $path) \|\| die "can't opendir $path: $!";
117	my @uids = grep { $_ =~ m/\Q$ext\E$/ && -f "$path/$_" } readdir($d);
118	closedir $d;
119
120	return map { my $l = $_; $l =~ s/\Q$ext\E$//; $l } @uids;
121	}
122
123	1;