r266@brr: dpavlin | 2007-11-25 19:50:35 +0100

 - first pass with Devel::LeakTrace::Fast
 - remove DBM::Deep store
 - CWMP::Queue now supports dir and clean args
 - create new parser for each request

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

diff --git a/Makefile.PL b/Makefile.PL
index 74d5ef8..ccae059 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -15,8 +15,6 @@ requires      'Class::Accessor';
 requires       'Net::HTTP';
 requires       'Cwd';
 requires       'File::Slurp';
-requires       'DBM::Deep';
-requires       'Clone';        # CWMP::Store::DBMDeep
 requires       'Getopt::Long';
 #requires      'Term::Shelly'  =>      '0.03';
 requires       'Module::Pluggable';

diff --git a/bin/acs.pl b/bin/acs.pl
index 1cf9de8..cc1a2ad 100755 (executable)
--- a/bin/acs.pl
+++ b/bin/acs.pl
@@ -14,7 +14,7 @@ use Getopt::Long;
 use Data::Dump qw/dump/;
 use File::Find;
 
-use Devel::LeakTrace::Fast;
+#use Devel::LeakTrace::Fast;
 
 my $port = 3333;
 my $debug = 0;

diff --git a/lib/CWMP/Queue.pm b/lib/CWMP/Queue.pm
index 8087255..87a7e54 100644 (file)
--- a/lib/CWMP/Queue.pm
+++ b/lib/CWMP/Queue.pm
@@ -7,6 +7,8 @@ use warnings;
 use base qw/Class::Accessor/;
 __PACKAGE__->mk_accessors( qw/
 id
+dir
+clean
 debug
 
 / );
@@ -14,11 +16,13 @@ debug
 #use Carp qw/confess/;
 use Data::Dump qw/dump/;
 use File::Spec;
-use File::Path qw/mkpath/;
+use File::Path qw/mkpath rmtree/;
 use IPC::DirQueue;
-use YAML qw/Dump/;
+use YAML::Syck qw/Dump/;
 use Carp qw/confess/;
 
+#use Devel::LeakTrace::Fast;
+
 =head1 NAME
 
 CWMP::Queue - implement commands queue for CPE
@@ -29,6 +33,8 @@ CWMP::Queue - implement commands queue for CPE
 
   my $obj = CWMP::Queue->new({
        id => 'CPE_serial_number',
+       dir => 'queue',
+       clean => 1,
        debug => 1
   });
 
@@ -42,7 +48,12 @@ sub new {
 
        warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;
 
-       my $dir = File::Spec->catfile('queue',$self->id);
+       my $dir = File::Spec->catfile( $self->dir || 'queue', $self->id );
+
+       if ( -e $dir && $self->clean ) {
+               rmtree $dir || die "can't remove $dir: $!";
+               warn "## clean $dir\n" if $self->debug;
+       }
 
        if ( ! -e $dir ) {
                mkpath $dir || die "can't create $dir: $!";
@@ -161,6 +172,7 @@ Finish job and remove it from queue
 sub finish {
        my $self = shift;
        $self->job->finish;
+       return 1;
 }
 
 1;

diff --git a/lib/CWMP/Request.pm b/lib/CWMP/Request.pm
index 6649688..51f70f3 100644 (file)
--- a/lib/CWMP/Request.pm
+++ b/lib/CWMP/Request.pm
@@ -126,7 +126,14 @@ push @$rules,
 
 =cut
 
-my $parser = XML::Rules->new(
+sub parse {
+       my $self = shift;
+
+       my $xml = shift || confess "no xml?";
+
+       $state = {};
+
+       my $parser = XML::Rules->new(
 #              start_rules => [
 #                      '^division_name,fax' => 'skip',
 #              ],
@@ -138,16 +145,14 @@ my $parser = XML::Rules->new(
                        'urn:dslforum-org:cwmp-1-0' => '',
                },
                rules => $rules,
-);
+       );
 
-sub parse {
-       my $self = shift;
+       warn "## created $parser\n";
 
-       my $xml = shift || confess "no xml?";
+       $parser->parsestring( $xml );
 
-       $state = {};
+       undef $parser;
 
-       $parser->parsestring( $xml );
        if ( my $trigger = $state->{_trigger} ) {
                warn "### call_trigger( $trigger )\n";
                $self->call_trigger( $trigger, $state );

diff --git a/lib/CWMP/Store/DBMDeep.pm b/lib/CWMP/Store/DBMDeep.pm
deleted file mode 100644 (file)
index 80fabd1..0000000
--- a/lib/CWMP/Store/DBMDeep.pm
+++ /dev/null
@@ -1,102 +0,0 @@
-# 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 Clone qw/clone/;
-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 ) = @_;
-
-       my $data = clone( $state );
-
-       if ( my $o = $db->get( $uid ) ) {
-               warn "## update state of $uid\n" if $debug;
-               $o->import( $data );
-       } else {
-               warn "## create new state for $uid\n" if $debug;
-               $db->put( $uid => $data );
-       }
-}
-
-=head2 get_state
-
-  $store->get_state( $uid );
-
-=cut
-
-sub get_state {
-       my ( $self, $uid ) = @_;
-
-       if ( my $state = $db->get( $uid ) ) {
-               $state->export;
-       }
-}
-
-=head2 all_uids
-
-  my @uids = $store->all_uids;
-
-=cut
-
-sub all_uids {
-       my $self = shift;
-       return keys %$db;
-}
-
-1;

diff --git a/lib/CWMP/Store/HASH.pm b/lib/CWMP/Store/HASH.pm
index d79466c..87bec30 100644 (file)
--- a/lib/CWMP/Store/HASH.pm
+++ b/lib/CWMP/Store/HASH.pm
@@ -55,7 +55,7 @@ sub open {
 
 =head2 update_uid_state
 
-  $store->update_uid_state( $uid, $state );
+  my $new_state = $store->update_uid_state( $uid, $state );
 
 =cut
 
@@ -72,6 +72,7 @@ sub update_uid_state {
 
        $self->save_hash( $file, $combined ) || die "can't write $file: $!";
 
+       return $combined;
 }
 
 =head2 get_state

diff --git a/t/00-load.t b/t/00-load.t
index ccd135f..108eb6a 100755 (executable)
--- a/t/00-load.t
+++ b/t/00-load.t
@@ -7,6 +7,8 @@ my $debug = shift @ARGV;
 use Test::More tests => 4;
 use blib;
 
+#use Devel::LeakTrace::Fast;
+
 BEGIN {
        use_ok('CWMP::Server');
        use_ok('CWMP::Request');

diff --git a/t/05-store.t b/t/05-store.t
index 1d061bc..6748641 100755 (executable)
--- a/t/05-store.t
+++ b/t/05-store.t
@@ -4,7 +4,7 @@ use warnings;
 
 my $debug = shift @ARGV;
 
-use Test::More tests => 47;
+use Test::More tests => 32;
 use Data::Dump qw/dump/;
 use Cwd qw/abs_path/;
 use lib 'lib';
@@ -13,7 +13,6 @@ use lib 'lib';
 
 BEGIN {
        use_ok('CWMP::Store');
-       use_ok('CWMP::Store::DBMDeep');
        use_ok('CWMP::Store::YAML');
        use_ok('CWMP::Store::JSON');
 }
@@ -79,13 +78,10 @@ sub test_store {
 
        is_deeply( [ $store->all_uids ], [ 123456, 99999 ], 'all_uids' );
 
-       undef $store;
-
 }
 
 # now test all stores
 
-test_store('DBMDeep');
 test_store('YAML');
 test_store('JSON');
 

diff --git a/t/06-queue.t b/t/06-queue.t
index 8cdc92b..c14da96 100755 (executable)
--- a/t/06-queue.t
+++ b/t/06-queue.t
@@ -4,20 +4,24 @@ use warnings;
 
 my $debug = shift @ARGV;
 
-use Test::More tests => 255;
+use Test::More tests => 256;
 use Data::Dump qw/dump/;
 use lib 'lib';
 
+use Devel::LeakTrace::Fast;
+
 BEGIN {
        use_ok('CWMP::Queue');
 }
 
-#use Cwd qw/abs_path/;
-#ok(my $abs_path = abs_path($0), "abs_path");
-#$abs_path =~ s!/[^/]*$!/!;    #!fix-vim
+use Cwd qw/abs_path/;
+ok(my $abs_path = abs_path($0), "abs_path");
+$abs_path =~ s!/[^/]*$!/!;     #!fix-vim
 
 ok( my $obj = CWMP::Queue->new({
        id => 'test',
+       dir => "$abs_path/queue",
+       clean => 1,
        debug => $debug,
 }), 'new' );
 isa_ok( $obj, 'CWMP::Queue' );

diff --git a/t/10-request.t b/t/10-request.t
index 03e9098..6aba6a7 100755 (executable)
--- a/t/10-request.t
+++ b/t/10-request.t
@@ -10,6 +10,8 @@ use Cwd qw/abs_path/;
 use File::Slurp;
 use blib;
 
+#use Devel::LeakTrace::Fast;
+
 BEGIN {
        use_ok('CWMP::Request');
 }

diff --git a/t/20-methods.t b/t/20-methods.t
index 56f4c35..9f71e7d 100755 (executable)
--- a/t/20-methods.t
+++ b/t/20-methods.t
@@ -10,6 +10,8 @@ use Cwd qw/abs_path/;
 use File::Slurp;
 use blib;
 
+use Devel::LeakTrace::Fast;
+
 BEGIN {
        use_ok('CWMP::Methods');
 }