r257@brr: dpavlin | 2007-11-24 03:16:39 +0100

 massive amount of tweaks including replacement of YAML with YAML::Syck
 and scoping all over the place

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

diff --git a/Makefile.PL b/Makefile.PL
index ac51fa1..89ac6df 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -20,7 +20,6 @@ requires      'Clone';        # CWMP::Store::DBMDeep
 requires       'Getopt::Long';
 #requires      'Term::Shelly'  =>      '0.03';
 requires       'Module::Pluggable';
 requires       'Getopt::Long';
 #requires      'Term::Shelly'  =>      '0.03';
 requires       'Module::Pluggable';

-requires       'YAML';

 requires       'Hash::Merge';
 requires       'IPC::DirQueue';
 requires       'File::Spec';
 requires       'Hash::Merge';
 requires       'IPC::DirQueue';
 requires       'File::Spec';


@@ -31,6 +30,14 @@ requires     'File::Find';
 build_requires 'Test::More';
 
 features(
 build_requires 'Test::More';
 
 features(

+       'CWMP::Store::YAML' => [
+               -default => 1,
+               recommends('YAML::Syck' => 0.91),
+       ],
+       'CWMP::Store::JSON' => [
+               -default => 1,
+               recommends('JSON::XS'),
+       ],

        'Command-line access to modems (tcli.pl)' => [
                -default => 1,
                recommends('Expect'),
        'Command-line access to modems (tcli.pl)' => [
                -default => 1,
                recommends('Expect'),

diff --git a/bin/acs.pl b/bin/acs.pl
index 1cf9de8..1b341e7 100755 (executable)
--- a/bin/acs.pl
+++ b/bin/acs.pl
@@ -14,8 +14,6 @@ use Getopt::Long;
 use Data::Dump qw/dump/;
 use File::Find;
 
 use Data::Dump qw/dump/;
 use File::Find;
 

-use Devel::LeakTrace::Fast;
-

 my $port = 3333;
 my $debug = 0;
 my $store_path = './';
 my $port = 3333;
 my $debug = 0;
 my $store_path = './';

diff --git a/lib/CWMP/Request.pm b/lib/CWMP/Request.pm
index d4817b0..5ae478e 100644 (file)
--- a/lib/CWMP/Request.pm
+++ b/lib/CWMP/Request.pm
@@ -4,7 +4,6 @@ use warnings;
 use strict;
 
 use XML::Rules;
 use strict;
 
 use XML::Rules;

-use CWMP::Tree;

 use Data::Dump qw/dump/;
 use Carp qw/confess cluck/;
 use Class::Trigger;
 use Data::Dump qw/dump/;
 use Carp qw/confess cluck/;
 use Class::Trigger;


@@ -21,7 +20,7 @@ All methods described below call triggers with same name
 
 our $state;    # FIXME check this!
 
 
 our $state;    # FIXME check this!
 

-my $rules =  [
+our $rules =  [

                #_default => 'content trim',
                x_default => sub {
                        my ($tag_name, $tag_hash, $context, $parent_data) = @_;
                #_default => 'content trim',
                x_default => sub {
                        my ($tag_name, $tag_hash, $context, $parent_data) = @_;


@@ -125,12 +124,7 @@ push @$rules,
 
 =cut
 
 
 =cut
 

-sub parse {
-       my $self = shift;
-
-       my $xml = shift || confess "no xml?";
-
-       my $parser = XML::Rules->new(
+my $parser = XML::Rules->new(

 #              start_rules => [
 #                      '^division_name,fax' => 'skip',
 #              ],
 #              start_rules => [
 #                      '^division_name,fax' => 'skip',
 #              ],


@@ -142,7 +136,12 @@ sub parse {
                        'urn:dslforum-org:cwmp-1-0' => '',
                },
                rules => $rules,
                        'urn:dslforum-org:cwmp-1-0' => '',
                },
                rules => $rules,

-       );
+);
+
+sub parse {
+       my $self = shift;
+
+       my $xml = shift || confess "no xml?";

 
        $state = {};
 
 
        $state = {};
 

diff --git a/lib/CWMP/Session.pm b/lib/CWMP/Session.pm
index 3cd9a78..e2f6b8c 100644 (file)
--- a/lib/CWMP/Session.pm
+++ b/lib/CWMP/Session.pm
@@ -17,13 +17,15 @@ store
 
 use HTTP::Daemon;
 use Data::Dump qw/dump/;
 
 use HTTP::Daemon;
 use Data::Dump qw/dump/;

-use Carp qw/confess cluck croak/;
+use Carp qw/carp confess cluck croak/;

 use File::Slurp;
 
 use CWMP::Request;
 use CWMP::Methods;
 use CWMP::Store;
 
 use File::Slurp;
 
 use CWMP::Request;
 use CWMP::Methods;
 use CWMP::Store;
 

+#use Devel::LeakTrace::Fast;
+

 =head1 NAME
 
 CWMP::Session - implement logic of CWMP protocol
 =head1 NAME
 
 CWMP::Session - implement logic of CWMP protocol


@@ -100,7 +102,12 @@ sub process_request {
        # solution from http://use.perl.org/~Matts/journal/12896
        ${*$sock}{'httpd_daemon'} = HTTP::Daemon->new;
 
        # solution from http://use.perl.org/~Matts/journal/12896
        ${*$sock}{'httpd_daemon'} = HTTP::Daemon->new;
 

-       my $r = $sock->get_request || confess "can't get_request";
+       my $r = $sock->get_request;
+       
+       if ( ! $r ) {
+               carp "can't get_request";
+               return 0;
+       }

 
        my $xml = $r->content;
 
 
        my $xml = $r->content;
 


@@ -182,8 +189,9 @@ sub process_request {
        } elsif ( $job = $queue->dequeue ) {
                $xml = $self->dispatch( $job->dispatch );
        } elsif ( $size == 0 ) {
        } elsif ( $job = $queue->dequeue ) {
                $xml = $self->dispatch( $job->dispatch );
        } elsif ( $size == 0 ) {

-               warn ">>> no more queued commands, closing connection $to_uid";
-               return 0;
+               warn ">>> no more queued commands, no client pending, closing connection $to_uid";
+               $sock->close;
+               return;

        } else {
                warn ">>> empty response $to_uid";
                $state->{NoMoreRequests} = 1;
        } else {
                warn ">>> empty response $to_uid";
                $state->{NoMoreRequests} = 1;

diff --git a/lib/CWMP/Store/YAML.pm b/lib/CWMP/Store/YAML.pm
index 0fa1950..6b5ea15 100644 (file)
--- a/lib/CWMP/Store/YAML.pm
+++ b/lib/CWMP/Store/YAML.pm
@@ -5,7 +5,7 @@ use strict;
 use warnings;
 
 use Data::Dump qw/dump/;
 use warnings;
 
 use Data::Dump qw/dump/;

-use YAML qw/LoadFile DumpFile/;
+use YAML::Syck;

 use Hash::Merge qw/merge/;
 use Carp qw/confess/;
 
 use Hash::Merge qw/merge/;
 use Carp qw/confess/;
 

diff --git a/lib/CWMP/Vendor.pm b/lib/CWMP/Vendor.pm
index 3d7a31b..e0cb1d3 100644 (file)
--- a/lib/CWMP/Vendor.pm
+++ b/lib/CWMP/Vendor.pm
@@ -39,7 +39,7 @@ sub new {
        return $self;
 }
 
        return $self;
 }
 

-my $cpe_faulty;
+our $cpe_faulty;

 
 my $serial2ip = {
        'CP0636JT3SH' => '10.0.0.1',
 
 my $serial2ip = {
        'CP0636JT3SH' => '10.0.0.1',

diff --git a/t/30-server.t b/t/30-server.t
index 5926000..7545d60 100755 (executable)
--- a/t/30-server.t
+++ b/t/30-server.t
@@ -4,7 +4,7 @@ use warnings;
 
 my $debug = shift @ARGV;
 
 
 my $debug = shift @ARGV;
 

-use Test::More tests => 19;
+use Test::More tests => 20;

 use Data::Dump qw/dump/;
 use Cwd qw/abs_path/;
 use blib;
 use Data::Dump qw/dump/;
 use Cwd qw/abs_path/;
 use blib;


@@ -192,7 +192,9 @@ my $state = {
   _dispatch      => "InformResponse",
 };
 
   _dispatch      => "InformResponse",
 };
 

-is_deeply( $store->current_store->get_state( 'CP0644JTHJ4' ), $state, 'store->current_store->get_state' );
+ok( my $store_state = $store->current_store->get_state( 'CP0644JTHJ4' ), 'get_state' );
+
+is_deeply( $store_state, $state, 'store->current_store->get_state' );

 
 diag "shutdown server";
 
 
 diag "shutdown server";