Rough draft of low-level store mechanisam.

git-svn-id: https://perl-cwmp.googlecode.com/svn/branches/store-pluggable@133 836a5e1a-633d-0410-964b-294494ad4392

diff --git a/bin/acs.pl b/bin/acs.pl
index 39e4d0f..01d2c5f 100755 (executable)
--- a/bin/acs.pl
+++ b/bin/acs.pl
@@ -12,17 +12,18 @@ use Getopt::Long;
 
 my $port = 3333;
 my $debug = 0;
-my $store_path = 'state.db';
 
 GetOptions(
        'debug+' => \$debug,
        'port=i' => \$port,
-       'store-path=s' => \$store_path,
 );
 
 my $server = CWMP::Server->new({
        port => $port,
-       store_path => $store_path,
+       store => {
+               module => 'DBMDeep',
+               store_path => 'state.db',
+       },
        debug => $debug,
        default_queue => [ qw/
                GetRPCMethods

diff --git a/lib/CWMP/Server.pm b/lib/CWMP/Server.pm
index 0a67293..381e255 100644 (file)
--- a/lib/CWMP/Server.pm
+++ b/lib/CWMP/Server.pm
@@ -7,7 +7,7 @@ use warnings;
 use base qw/Class::Accessor/;
 __PACKAGE__->mk_accessors( qw/
 port
-store_path
+store
 default_queue
 background
 debug
@@ -30,7 +30,7 @@ CWMP::Server - description
 
   my $server = CWMP::Server->new({
        port => 3333,
-       store_path => 'state.db',
+       store => 'state.db',
        default_queue => [ qw/GetRPCMethods GetParameterNames/ ],                                                           
        background => 1,
        debug => 1
@@ -44,9 +44,10 @@ Options:
 
 port to listen on
 
-=item store_path
+=item store
 
-path to L<DBM::Deep> database file to preserve state
+hash with key C<module> with value C<DBMDeep> if L<CWMP::Store::DBMDeep>
+is used. Other parametars are optional.
 
 =item default_queue
 
@@ -72,7 +73,7 @@ sub new {
                        proto => 'tcp',
                        port => $self->port,
                        default_queue => $self->default_queue,
-                       store_path => $self->store_path,
+                       store => $self->store,
                        debug => $self->debug,
                        background => $self->background,
                })
@@ -109,7 +110,7 @@ sub options {
        $self->SUPER::options($template);
 
        # new single-value options
-       foreach my $p ( qw/ store_path debug / ) {
+       foreach my $p ( qw/ store debug / ) {
                $prop->{ $p } ||= undef;
                $template->{ $p } = \$prop->{ $p };
        }
@@ -139,7 +140,7 @@ sub process_request {
        my $session = CWMP::Session->new({
                sock => $sock,
                queue => $prop->{default_queue},
-               store_path => $prop->{store_path},
+               store => $prop->{store},
                debug => $prop->{debug},
        }) || confess "can't create session";
 

diff --git a/lib/CWMP/Session.pm b/lib/CWMP/Session.pm
index 41e99d1..bd24efd 100644 (file)
--- a/lib/CWMP/Session.pm
+++ b/lib/CWMP/Session.pm
@@ -7,7 +7,7 @@ use warnings;
 use base qw/Class::Accessor/;
 __PACKAGE__->mk_accessors( qw/
 debug
-store_path
+store
 
 sock
 state
@@ -34,7 +34,7 @@ CWMP::Session - implement logic of CWMP protocol
 
   my $server = CWMP::Session->new({
        sock => $io_socket_object,
-       store_path => 'state.db',
+       store => 'state.db',
        queue => [ qw/GetRPCMethods GetParameterNames/ ],
        debug => 1,
   });
@@ -51,12 +51,15 @@ sub new {
 
        warn "created ", __PACKAGE__, "(", dump( @_ ), ") for ", $self->sock->peerhost, "\n" if $self->debug;
 
-       $self->store( CWMP::Store->new({
+       my $store_obj = CWMP::Store->new({
                debug => $self->debug,
-               path => $self->store_path,
-       }) );
+               %{ $self->store },
+       });
+
+       croak "can't open ", dump( $self->store ), ": $!" unless $store_obj;
 
-       croak "can't open ", $self->store_path, ": $!" unless $self->store;
+       # FIXME looks ugly. Should we have separate accessor for this?
+       $self->store( $store_obj );
 
        return $self;
 }
@@ -122,11 +125,11 @@ sub process_request {
 
        } else {
 
-               warn "## empty request\n";
+               warn "## empty request, using last request state\n";
 
                $state = $self->state;
                delete( $state->{_dispatch} );
-               warn "last request state = ", dump( $state ), "\n" if $self->debug > 1;
+               #warn "last request state = ", dump( $state ), "\n" if $self->debug > 1;
        }
 
 
@@ -146,7 +149,7 @@ sub process_request {
        } elsif ( $dispatch = shift @{ $self->queue } ) {
                $xml = $self->dispatch( $dispatch );
        } elsif ( $size == 0 ) {
-               warn ">>> closing connection\n";
+               warn ">>> no more queued commands, closing connection\n";
                return 0;
        } else {
                warn ">>> empty response\n";

diff --git a/lib/CWMP/Store.pm b/lib/CWMP/Store.pm
index a307b31..8787175 100644 (file)
--- a/lib/CWMP/Store.pm
+++ b/lib/CWMP/Store.pm
@@ -7,15 +7,14 @@ use warnings;
 
 use base qw/Class::Accessor/;
 __PACKAGE__->mk_accessors( qw/
-debug
+module
 path
-
-db
+debug
 / );
 
 use Carp qw/confess/;
 use Data::Dump qw/dump/;
-use DBM::Deep;
+use Module::Pluggable search_path => 'CWMP::Store', sub_name => 'possible_stores', require => 1;
 
 =head1 NAME
 
@@ -26,6 +25,7 @@ CWMP::Store - parsist CPE state on disk
 =head2 new
 
   my $store = CWMP::Store->new({
+       module => 'DBMDeep',
        path => '/path/to/state.db',
        debug => 1,
   });
@@ -36,25 +36,36 @@ sub new {
        my $class = shift;
        my $self = $class->SUPER::new( @_ );
 
-       warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;
+       confess "requed parametar module is missing" unless $self->module;
 
-       confess "need path to state.db" unless ( $self->path );
+       warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;
 
-       $self->db(
-               DBM::Deep->new(
-                       file => $self->path,
-                       locking => 1,
-                       autoflush => 1,
-               )
-       );
+       warn "Found store plugins: ", join(", ", __PACKAGE__->possible_stores() );
 
-       foreach my $init ( qw/ state / ) {
-               $self->db->put( $init => {} ) unless $self->db->get( $init );
-       }
+       $self->current_store->open( @_ );
 
        return $self;
 }
 
+=head2 current_store
+
+Returns currnet store plugin object
+
+=cut
+
+sub current_store {
+       my $self = shift;
+
+       my $module = $self->module;
+       my $s = $self->only( ref($self).'::'.$module );
+
+       confess "unknown store module $module not one of ", dump( $self->possible_stores ) unless $s;
+
+       warn "current store = ",dump( $s );
+
+       return $s;
+}
+
 =head2 update_state
 
   $store->update_state( ID => $ID, $state );
@@ -86,13 +97,7 @@ sub update_state {
                $uid = $v;
        }
 
-       if ( my $o = $self->db->get('state')->get( $uid ) ) {
-               warn "## update state of $uid [$v]\n" if $self->debug;
-               return $o->import( $state );
-       } else {
-               warn "## create new state for $uid [$v]\n" if $self->debug;
-               return $self->db->get('state')->put( $uid => $state );
-       }
+       $self->current_store->update_uid_state( $uid, $state );
 }
 
 =head2 state
@@ -125,11 +130,7 @@ sub state {
                $uid = $v;
        }
 
-       if ( my $state = $self->db->get('state')->get( $uid ) ) {
-               return $state->export;
-       } else {
-               return;
-       }
+       return $self->current_store->get_state( $uid );
 
 }
 
@@ -141,7 +142,7 @@ sub state {
 
 sub known_CPE {
        my $self = shift;
-       my @cpes = keys %{ $self->db->{state} };
+       my @cpes = $self->current_store->all_uids;
        warn "all CPE: ", dump( @cpes ), "\n" if $self->debug;
        return @cpes;
 }

diff --git a/lib/CWMP/Store/DBMDeep.pm b/lib/CWMP/Store/DBMDeep.pm
new file mode 100644 (file)
index 0000000..0c3c6d3
--- /dev/null
+++ b/lib/CWMP/Store/DBMDeep.pm
@@ -0,0 +1,84 @@
+# 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/;
+
+=head1 NAME
+
+CWMP::Store::DBMDeep - use DBM::Deep as storage
+
+=head1 METHODS
+
+=head2 open
+
+=cut
+
+my $db;
+
+my $debug = 1;
+
+sub open {
+       my $self = shift;
+
+       warn "open ",dump( @_ );
+
+       my $path = 'state.db';
+
+       $db = DBM::Deep->new(
+               file => $path,
+               locking => 1,
+               autoflush => 1,
+       );
+
+}
+
+=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;

diff --git a/t/05-store.t b/t/05-store.t
index 7295f40..fc848d1 100755 (executable)
--- a/t/05-store.t
+++ b/t/05-store.t
@@ -4,13 +4,14 @@ use warnings;
 
 my $debug = shift @ARGV;
 
-use Test::More tests => 17;
+use Test::More tests => 18;
 use Data::Dump qw/dump/;
 use Cwd qw/abs_path/;
 use lib 'lib';
 
 BEGIN {
        use_ok('CWMP::Store');
+       use_ok('CWMP::Store::DBMDeep');
 }
 
 ok(my $abs_path = abs_path($0), "abs_path");
@@ -22,6 +23,7 @@ unlink $path if -e $path;
 
 ok( my $store = CWMP::Store->new({
        debug => $debug,
+       module => 'DBMDeep',
        path => $path,
 }), 'new' );
 isa_ok( $store, 'CWMP::Store' );