From: Dobrica Pavlinusic <dpavlin@rot13.org>
Date: Sun, 25 Nov 2007 18:51:26 +0000 (+0000)
Subject:  r266@brr:  dpavlin | 2007-11-25 19:50:35 +0100
X-Git-Url: http://git.rot13.org/?p=perl-cwmp.git;a=commitdiff_plain;h=5ea6e09597af2a09a847b8973e30601811f52725

 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
--- 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
--- 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
--- 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
--- 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
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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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');
 }