r262@brr: dpavlin | 2007-11-25 14:33:40 +0100

 - refactored hash-based store base class to CWMP::Store::HASH
 - simple back-ends for YAML and JSON
 - version bump [0.13]

git-svn-id: https://perl-cwmp.googlecode.com/svn/trunk@224 836a5e1a-633d-0410-964b-294494ad4392

diff --git a/Makefile.PL b/Makefile.PL
index 89ac6df..74d5ef8 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -3,7 +3,7 @@ use lib './lib';
 use inc::Module::Install;
 
 name           'CWMP';
-version                '0.12';
+version                '0.13';
 license                'GPL';
 requires       'Net::Server';
 requires       'HTTP::Daemon';

diff --git a/lib/CWMP/Store/HASH.pm b/lib/CWMP/Store/HASH.pm
new file mode 100644 (file)
index 0000000..d79466c
--- /dev/null
+++ b/lib/CWMP/Store/HASH.pm
@@ -0,0 +1,114 @@
+package CWMP::Store::HASH;
+
+use strict;
+use warnings;
+
+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
+
+  $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: $!";
+
+}
+
+=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;

diff --git a/lib/CWMP/Store/JSON.pm b/lib/CWMP/Store/JSON.pm
new file mode 100644 (file)
index 0000000..6a80bdf
--- /dev/null
+++ b/lib/CWMP/Store/JSON.pm
@@ -0,0 +1,46 @@
+package CWMP::Store::JSON;
+
+use strict;
+use warnings;
+
+use CWMP::Store::HASH;
+use base qw/CWMP::Store::HASH/;
+
+use JSON::XS;
+use File::Slurp;
+
+=head1 NAME
+
+CWMP::Store::YAML - use YAML as storage
+
+=cut
+
+my $full_path;
+
+sub full_path {
+       my ( $self, $path ) = @_;
+       $full_path = "$path/json";
+       warn "## full_path: $full_path";
+       return $full_path;
+}
+
+sub file {
+       my ( $self, $uid ) = @_;
+       my $file = "$full_path/$uid" . $self->extension;
+       warn "## file -> $file";
+       return $file;
+}
+
+sub save_hash {
+       my ( $self, $file, $hash ) = @_;
+       write_file( $file, to_json $hash );
+}
+
+sub load_hash {
+       my ( $self, $file ) = @_;
+       from_json read_file( $file );
+}
+
+sub extension { '.js' };
+
+1;

diff --git a/lib/CWMP/Store/YAML.pm b/lib/CWMP/Store/YAML.pm
index 6b5ea15..a523443 100644 (file)
--- a/lib/CWMP/Store/YAML.pm
+++ b/lib/CWMP/Store/YAML.pm
@@ -4,110 +4,43 @@ package CWMP::Store::YAML;
 use strict;
 use warnings;
 
-use Data::Dump qw/dump/;
+use CWMP::Store::HASH;
+use base qw/CWMP::Store::HASH/;
+
 use YAML::Syck;
-use Hash::Merge qw/merge/;
-use Carp qw/confess/;
 
 =head1 NAME
 
 CWMP::Store::YAML - use YAML as storage
 
-=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 = "$path/yaml";
-
-       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 = "$path/$uid.yml";
-                       unlink $file || die "can't remove $file: $!";
-               }
-       }
-
-
-}
-
-=head2 update_uid_state
-
-  $store->update_uid_state( $uid, $state );
-
 =cut
 
-sub update_uid_state {
-       my ( $self, $uid, $state ) = @_;
-
-       my $file = "$path/$uid.yml";
-
-       my $old_state = $self->get_state( $uid );
-
-       my $combined = merge( $state, $old_state );
-
-#      warn "## ",dump( $old_state, $state, $combined );
-
-       DumpFile( $file, $combined ) || die "can't write $file: $!";
+my $full_path;
 
+sub full_path {
+       my ( $self, $path ) = @_;
+       $full_path = "$path/yaml";
+       warn "## full_path: $full_path";
+       return $full_path;
 }
 
-=head2 get_state
-
-  $store->get_state( $uid );
-
-=cut
-
-sub get_state {
+sub file {
        my ( $self, $uid ) = @_;
-
-       my $file = "$path/$uid.yml";
-
-       if ( -e $file ) {
-               return LoadFile( $file );
-       }
-
-       return;
+       my $file = "$full_path/$uid" . $self->extension;
+       warn "## file -> $file";
+       return $file;
 }
 
-=head2 all_uids
-
-  my @uids = $store->all_uids;
-
-=cut
-
-sub all_uids {
-       my $self = shift;
-
-       opendir(my $d, $path) || die "can't opendir $path: $!";
-       my @uids = grep { /\.yml$/ && -f "$path/$_" } readdir($d);
-       closedir $d;
+sub save_hash {
+       my ( $self, $file, $hash ) = @_;
+       DumpFile( $file, $hash );
+}
 
-       return map { my $l = $_; $l =~ s/\.yml$//; $l } @uids;
+sub load_hash {
+       my ( $self, $file ) = @_;
+       LoadFile( $file );
 }
 
+sub extension { '.yml' };
+
 1;

diff --git a/t/05-store.t b/t/05-store.t
index 0e885ad..1d061bc 100755 (executable)
--- a/t/05-store.t
+++ b/t/05-store.t
@@ -4,17 +4,18 @@ use warnings;
 
 my $debug = shift @ARGV;
 
-use Test::More tests => 32;
+use Test::More tests => 47;
 use Data::Dump qw/dump/;
 use Cwd qw/abs_path/;
 use lib 'lib';
 
-use Devel::LeakTrace::Fast;
+#use Devel::LeakTrace::Fast;
 
 BEGIN {
        use_ok('CWMP::Store');
        use_ok('CWMP::Store::DBMDeep');
        use_ok('CWMP::Store::YAML');
+       use_ok('CWMP::Store::JSON');
 }
 
 ok(my $abs_path = abs_path($0), "abs_path");
@@ -86,4 +87,5 @@ sub test_store {
 
 test_store('DBMDeep');
 test_store('YAML');
+test_store('JSON');