r206@brr: dpavlin | 2007-11-12 23:02:21 +0100

 - move protocol dump to new cpe-queue.pl command
 - queue now stores data in YAML to preserve perl structures intact
 - queue jobs are now finished correctly
 - remove all traces of default_queue

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

diff --git a/bin/acs.pl b/bin/acs.pl
index f143b4c..b4b1e8e 100755 (executable)
--- a/bin/acs.pl
+++ b/bin/acs.pl
@@ -14,40 +14,14 @@ my $port = 3333;
 my $debug = 0;
 my $store_path = './';
 my $store_plugin = 'YAML';
-my $protocol_dump = 0;
 
 GetOptions(
        'debug+' => \$debug,
        'port=i' => \$port,
        'store-path=s' => \$store_path,
        'store-plugin=s' => \$store_plugin,
-       'protocol-dump!' => \$protocol_dump,
 );
 
-my $queue;
-
-if ( $protocol_dump ) {
-
-       warn "generating dump of xml protocol with CPE\n";
-
-       $queue = [
-                       'GetRPCMethods',
-                       'GetParameterNames',
-#                      [ 'GetParameterNames', 'InternetGatewayDevice.DeviceInfo.SerialNumber', 0 ],
-#                      [ 'GetParameterNames', 'InternetGatewayDevice.DeviceInfo.', 1 ],
-                       [ 'GetParameterValues',
-                               'InternetGatewayDevice.DeviceInfo.SerialNumber',
-                               'InternetGatewayDevice.DeviceInfo.VendorConfigFile.',
-                               'InternetGatewayDevice.DeviceInfo.X_000E50_Country',
-                       ],
-                       [ 'SetParameterValues',
-                               'InternetGatewayDevice.DeviceInfo.ProvisioningCode' => 'test provision',
-#                      'InternetGatewayDevice.DeviceInfo.X_000E50_Country' => 1,
-                       ],
-#                      'Reboot',
-       ];
-};
-
 
 my $server = CWMP::Server->new({
        port => $port,
@@ -57,7 +31,6 @@ my $server = CWMP::Server->new({
                debug => $debug,
        },
        debug => $debug,
-       default_queue => [ $queue ],
 });
 $server->run();
 

diff --git a/bin/cpe-queue.pl b/bin/cpe-queue.pl
new file mode 100755 (executable)
index 0000000..2135884
--- /dev/null
+++ b/bin/cpe-queue.pl
@@ -0,0 +1,53 @@
+#!/usr/bin/perl -w
+
+# cpe-queue.pl
+#
+# 11/12/2007 10:03:53 PM CET  <>
+
+use strict;
+
+use lib './lib';
+use CWMP::Queue;
+use Getopt::Long;
+
+my $debug = 0;
+my $protocol_dump = 1;
+
+GetOptions(
+       'debug+' => \$debug,
+       'protocol-dump!' => \$protocol_dump,
+);
+
+my $id = shift @ARGV || die "usage: $0 CPE_id [--protocol-dump]\n";
+
+$id =~ s!^.*queue/+!!;
+$id =~ s!/+$!!;        #!
+
+die "ID isn't valid: $id\n" unless $id =~ m/^\w+$/;
+
+my $q = CWMP::Queue->new({ id => $id, debug => $debug });
+
+if ( $protocol_dump ) {
+
+       warn "generating dump of xml protocol with CPE\n";
+
+       $q->enqueue( 'GetRPCMethods' );
+       $q->enqueue( 'GetParameterNames' );
+
+#      $q->enqueue( 'GetParameterNames', 'InternetGatewayDevice.DeviceInfo.SerialNumber', 0 );
+#      $q->enqueue( 'GetParameterNames', 'InternetGatewayDevice.DeviceInfo.', 1 );
+
+       $q->enqueue( 'GetParameterValues',
+                               'InternetGatewayDevice.DeviceInfo.SerialNumber',
+                               'InternetGatewayDevice.DeviceInfo.VendorConfigFile.',
+                               'InternetGatewayDevice.DeviceInfo.X_000E50_Country',
+       );
+       $q->enqueue( 'SetParameterValues',
+                               'InternetGatewayDevice.DeviceInfo.ProvisioningCode' => 'test provision',
+#                      'InternetGatewayDevice.DeviceInfo.X_000E50_Country' => 1,
+       );
+
+#      $q->enqueue( 'Reboot' );
+
+}
+

diff --git a/lib/CWMP/Queue.pm b/lib/CWMP/Queue.pm
index 014f5db..bf4595e 100644 (file)
--- a/lib/CWMP/Queue.pm
+++ b/lib/CWMP/Queue.pm
@@ -16,6 +16,7 @@ use Data::Dump qw/dump/;
 use File::Spec;
 use File::Path qw/mkpath/;
 use IPC::DirQueue;
+use YAML qw/Dump/;
 use Carp qw/confess/;
 
 =head1 NAME
@@ -74,16 +75,18 @@ sub enqueue {
        my $self = shift;
 
        my $id = $self->id;
-       my $data = {@_} || confess "need data";
-
-       warn "## enqueue( $id, ", dump( $data ), " )\n" if $self->debug;
-
-       $self->{dq}->{$id}->enqueue_string( $id, $data );
+       
+       warn "## enqueue( $id, ", dump( @_ ), " )\n" if $self->debug;
+       
+       $self->{dq}->{$id}->enqueue_string( Dump( @_ ) );
 }
 
 =head2 dequeue
 
-  my $data = $q->dequeue;
+  my $job = $q->dequeue;
+  my $dispatch = $job->dispatch;
+  # after dispatch is processed
+  $job->finish;
 
 =cut
 
@@ -92,11 +95,32 @@ sub dequeue {
 
        my $id = $self->id;
 
-       my $data = $self->{dq}->{$id}->pickup_queued_job();
-       return unless defined $data;
+       my $job = $self->{dq}->{$id}->pickup_queued_job();
+       return unless defined $job;
 
-       warn "## dequeue( $id ) = ", dump( $data ), " )\n" if $self->debug;
+       warn "## dequeue( $id ) = ", dump( $job ), " )\n" if $self->debug;
 
-       return $data->{metadata};
+       return CWMP::Queue::Job->new({ job => $job });
 }
+
+package CWMP::Queue::Job;
+
+use base qw/Class::Accessor/;
+__PACKAGE__->mk_accessors( qw/
+job
+/ );
+
+use YAML qw/LoadFile/;
+
+sub dispatch {
+       my $self = shift;
+       my $path = $self->job->get_data_path || die "get_data_path?";
+       return LoadFile( $path ) || die "can't read $path: $!";
+}
+
+sub finish {
+       my $self = shift;
+       $self->job->finish;
+}
+
 1;

diff --git a/lib/CWMP/Server.pm b/lib/CWMP/Server.pm
index d64e472..e90fa13 100644 (file)
--- a/lib/CWMP/Server.pm
+++ b/lib/CWMP/Server.pm
@@ -8,7 +8,6 @@ use base qw/Class::Accessor/;
 __PACKAGE__->mk_accessors( qw/
 port
 store
-default_queue
 background
 debug
 
@@ -16,6 +15,7 @@ server
 / );
 
 use CWMP::Session;
+use CWMP::Queue;
 
 use Carp qw/confess/;
 use Data::Dump qw/dump/;
@@ -34,7 +34,6 @@ CWMP::Server - description
                module => 'DBMDeep',
                path => 'var/',
        },
-       default_queue => [ qw/GetRPCMethods GetParameterNames/ ],                                                           
        background => 1,
        debug => 1
   });
@@ -52,10 +51,6 @@ port to listen on
 hash with key C<module> with value C<DBMDeep> if L<CWMP::Store::DBMDeep>
 is used. Other parametars are optional.
 
-=item default_queue
-
-commands which will be issued to every CPE on connect
-
 =back
 
 =cut
@@ -75,7 +70,6 @@ sub new {
                CWMP::Server::Helper->new({
                        proto => 'tcp',
                        port => $self->port,
-                       default_queue => $self->default_queue,
                        store => $self->store,
                        debug => $self->debug,
                        background => $self->background,
@@ -119,10 +113,10 @@ sub options {
        }
 
        # new multi-value options
-       foreach my $p ( qw/ default_queue / ) {
-               $prop->{ $p } ||= [];
-               $template->{ $p } = $prop->{ $p };
-       }
+#      foreach my $p ( qw/ default_queue / ) {
+#              $prop->{ $p } ||= [];
+#              $template->{ $p } = $prop->{ $p };
+#      }
 }
 
 
@@ -138,12 +132,9 @@ sub process_request {
        my $sock = $prop->{client};
        confess "no sock in ", ref( $self ) unless $sock;
 
-       warn "default CPE queue ", dump( $prop->{default_queue} ), "\n" if defined($prop->{default_queue});
-
        eval  {
                my $session = CWMP::Session->new({
                        sock => $sock,
-                       queue => $prop->{default_queue},
                        store => $prop->{store},
                        debug => $prop->{debug},
                }) || confess "can't create session";

diff --git a/lib/CWMP/Session.pm b/lib/CWMP/Session.pm
index f30dc59..488bd4f 100644 (file)
--- a/lib/CWMP/Session.pm
+++ b/lib/CWMP/Session.pm
@@ -11,7 +11,6 @@ store
 
 sock
 state
-queue
 store
 / );
 
@@ -35,10 +34,6 @@ CWMP::Session - implement logic of CWMP protocol
   my $server = CWMP::Session->new({
        sock => $io_socket_object,
        store => 'state.db',
-       queue => [
-               'GetRPCMethods',
-               [ 'GetParameterValyes', 'InternetGatewayDevice.DeviceInfo.SerialNumber', 0 ],
-       ],
        debug => 1,
   });
 
@@ -153,13 +148,18 @@ sub process_request {
        )."\r\n");
 
        $sock->send( "Set-Cookie: ID=" . $state->{ID} . "; path=/\r\n" ) if ( $state->{ID} );
-       
+
+       my $queue = CWMP::Queue->new({
+               id => $self->store->ID_to_uid( $state->{ID}, $state ),
+               debug => $self->debug,
+       });
+       my $job;
        $xml = '';
 
        if ( my $dispatch = $state->{_dispatch} ) {
                $xml = $self->dispatch( $dispatch );
-       } elsif ( $dispatch = shift @{ $self->queue } ) {
-               $xml = $self->dispatch( $dispatch );
+       } elsif ( $job = $queue->dequeue ) {
+               $xml = $self->dispatch( $job->dispatch );
        } elsif ( $size == 0 ) {
                warn ">>> no more queued commands, closing connection\n";
                return 0;
@@ -174,6 +174,7 @@ sub process_request {
 
        warn ">>>> " . $sock->peerhost . " [" . localtime() . "] sent ", length( $xml )," bytes\n";
 
+       $job->finish if $job;
        warn "### request over\n" if $self->debug;
 
        return 1;       # next request

diff --git a/t/06-queue.t b/t/06-queue.t
index e8cfe3e..e56b93e 100755 (executable)
--- a/t/06-queue.t
+++ b/t/06-queue.t
@@ -4,7 +4,7 @@ use warnings;
 
 my $debug = shift @ARGV;
 
-use Test::More tests => 129;
+use Test::More tests => 213;
 use Data::Dump qw/dump/;
 use lib 'lib';
 
@@ -23,16 +23,18 @@ ok( my $obj = CWMP::Queue->new({
 isa_ok( $obj, 'CWMP::Queue' );
 
 for my $i ( 1 .. 42 ) {
-       ok( $obj->enqueue(
+       ok( $obj->enqueue({
                i => $i,
                foo => 'bar',
-       ), "enqueue $i" );
+       }), "enqueue $i" );
 };
 
 my $i = 1;
 
-while ( my $data = $obj->dequeue ) {
-       ok( $data, "dequeue $i" );
-       cmp_ok( $data->{i}, '==', $i, "i == $i" );
+while ( my $job = $obj->dequeue ) {
+       ok( $job, "dequeue $i" );
+       ok( my $dispatch = $job->dispatch, "dispatch $i" );
+       cmp_ok( $dispatch->{i}, '==', $i, "i == $i" );
+       ok( $job->finish, "finish $i" );
        $i++;
 }

diff --git a/t/30-server.t b/t/30-server.t
index d8bcbd4..4b7747c 100755 (executable)
--- a/t/30-server.t
+++ b/t/30-server.t
@@ -191,6 +191,8 @@ my $state = {
 
 is_deeply( $store->current_store->get_state( 'CP0644JTHJ4' ), $state, 'store->current_store->get_state' );
 
+diag "shutdown server";
+
 ok( kill(9,$pid), 'kill ' . $pid );
 
 ok( waitpid($pid,0), 'waitpid' );