r200@brr: dpavlin | 2007-11-12 21:56:04 +0100

 implemented simple IPC::DirQueue based queue

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

diff --git a/Makefile.PL b/Makefile.PL
index e46ad2b..7e975c4 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -21,17 +21,26 @@ requires    'Getopt::Long';
 requires       'Module::Pluggable';
 requires       'YAML';
 requires       'Hash::Merge';
+requires       'IPC::DirQueue';
+requires       'File::Spec';
+requires       'File::Path';
 
 build_requires 'Test::More';
 
 features(
        'Command-line access to modems (tcli.pl)' => [
                -default => 1,
-               requires('Expect'),
-               requires('Net::Telnet'),
+               recommends('Expect'),
+               recommends('Net::Telnet'),
        ],
 );
 
+features(
+       'HTML documentation (make html)' => [
+               -default => 0,
+               recommends('Pod::Xhtml'),
+       ],
+);
 
 my_targets();
 

diff --git a/lib/CWMP/Queue.pm b/lib/CWMP/Queue.pm
new file mode 100644 (file)
index 0000000..014f5db
--- /dev/null
+++ b/lib/CWMP/Queue.pm
@@ -0,0 +1,102 @@
+package CWMP::Queue;
+
+use strict;
+use warnings;
+
+
+use base qw/Class::Accessor/;
+__PACKAGE__->mk_accessors( qw/
+id
+debug
+
+/ );
+
+#use Carp qw/confess/;
+use Data::Dump qw/dump/;
+use File::Spec;
+use File::Path qw/mkpath/;
+use IPC::DirQueue;
+use Carp qw/confess/;
+
+=head1 NAME
+
+CWMP::Queue - implement commands queue for CPE
+
+=head1 METHODS
+
+=head2 new
+
+  my $obj = CWMP::Queue->new({
+       id => 'CPE_serial_number',
+       debug => 1
+  });
+
+=cut
+
+sub new {
+       my $class = shift;
+       my $self = $class->SUPER::new( @_ );
+
+       die "need id" unless $self->id;
+
+       warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;
+
+       my $dir = File::Spec->catfile('queue',$self->id);
+
+       if ( ! -e $dir ) {
+               mkpath $dir || die "can't create $dir: $!";
+               print "created new queue $dir\n";
+       }
+
+       my $id = $self->id;
+
+       if ( ! defined( $self->{dq}->{$id} ) ) {
+               $self->{dq}->{$id} = IPC::DirQueue->new({
+                       dir => $dir,
+                       ordered => 1,
+                       queue_fanout => 0,
+               });
+               warn "## created queue object for CPE $id path $dir\n" if $self->debug;
+       }
+
+       return $self;
+}
+
+=head2 enqueue
+
+  $q->enqueue(
+       'foo.bar.baz' => 42,
+  );
+
+=cut
+
+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 );
+}
+
+=head2 dequeue
+
+  my $data = $q->dequeue;
+
+=cut
+
+sub dequeue {
+       my $self = shift;
+
+       my $id = $self->id;
+
+       my $data = $self->{dq}->{$id}->pickup_queued_job();
+       return unless defined $data;
+
+       warn "## dequeue( $id ) = ", dump( $data ), " )\n" if $self->debug;
+
+       return $data->{metadata};
+}
+1;

diff --git a/t/06-queue.t b/t/06-queue.t
new file mode 100755 (executable)
index 0000000..e8cfe3e
--- /dev/null
+++ b/t/06-queue.t
@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+my $debug = shift @ARGV;
+
+use Test::More tests => 129;
+use Data::Dump qw/dump/;
+use lib 'lib';
+
+BEGIN {
+       use_ok('CWMP::Queue');
+}
+
+#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',
+       debug => $debug,
+}), 'new' );
+isa_ok( $obj, 'CWMP::Queue' );
+
+for my $i ( 1 .. 42 ) {
+       ok( $obj->enqueue(
+               i => $i,
+               foo => 'bar',
+       ), "enqueue $i" );
+};
+
+my $i = 1;
+
+while ( my $data = $obj->dequeue ) {
+       ok( $data, "dequeue $i" );
+       cmp_ok( $data->{i}, '==', $i, "i == $i" );
+       $i++;
+}