r39849 - in /trunk/libtest-poe-server-tcp-perl: ./ debian/ inc/Module/Install/ lib/Test/POE/Server/ t/

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Tue Jul 14 02:23:59 UTC 2009


Author: jawnsy-guest
Date: Tue Jul 14 02:23:53 2009
New Revision: 39849

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=39849
Log:
* New upstream release
  + Add a feature to broadcast to all clients (send_to_all_clients)
* Added /me to Uploaders and Copyright
* Rewrote description (a bit shorter) - the synopsis is different

Added:
    trunk/libtest-poe-server-tcp-perl/inc/Module/Install/ReadmeFromPod.pm
    trunk/libtest-poe-server-tcp-perl/t/12_all_clients.t
Modified:
    trunk/libtest-poe-server-tcp-perl/Changes
    trunk/libtest-poe-server-tcp-perl/MANIFEST
    trunk/libtest-poe-server-tcp-perl/META.yml
    trunk/libtest-poe-server-tcp-perl/Makefile.PL
    trunk/libtest-poe-server-tcp-perl/README
    trunk/libtest-poe-server-tcp-perl/debian/changelog
    trunk/libtest-poe-server-tcp-perl/debian/control
    trunk/libtest-poe-server-tcp-perl/debian/copyright
    trunk/libtest-poe-server-tcp-perl/debian/rules
    trunk/libtest-poe-server-tcp-perl/inc/Module/Install/GithubMeta.pm
    trunk/libtest-poe-server-tcp-perl/lib/Test/POE/Server/TCP.pm

Modified: trunk/libtest-poe-server-tcp-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-poe-server-tcp-perl/Changes?rev=39849&op=diff
==============================================================================
--- trunk/libtest-poe-server-tcp-perl/Changes (original)
+++ trunk/libtest-poe-server-tcp-perl/Changes Tue Jul 14 02:23:53 2009
@@ -1,5 +1,8 @@
 Test::POE::Server::TCP
 ======================
+
+1.08  Mon Jul 13 15:33:34 BST 2009
+  - Added send_to_all_clients, a broadcast mechanism
 
 1.06	Wed Jun 10 21:47:29 BST 2009
 	- Added client_wheel method to get at the erm client wheel

Modified: trunk/libtest-poe-server-tcp-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-poe-server-tcp-perl/MANIFEST?rev=39849&op=diff
==============================================================================
--- trunk/libtest-poe-server-tcp-perl/MANIFEST (original)
+++ trunk/libtest-poe-server-tcp-perl/MANIFEST Tue Jul 14 02:23:53 2009
@@ -8,6 +8,7 @@
 inc/Module/Install/GithubMeta.pm
 inc/Module/Install/Makefile.pm
 inc/Module/Install/Metadata.pm
+inc/Module/Install/ReadmeFromPod.pm
 inc/Module/Install/Win32.pm
 inc/Module/Install/WriteAll.pm
 lib/Test/POE/Server/TCP.pm
@@ -28,5 +29,6 @@
 t/09_client_info.t
 t/10_prefix.t
 t/11_pause.t
+t/12_all_clients.t
 t/99_pod.t
 t/99_pod_coverage.t

Modified: trunk/libtest-poe-server-tcp-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-poe-server-tcp-perl/META.yml?rev=39849&op=diff
==============================================================================
--- trunk/libtest-poe-server-tcp-perl/META.yml (original)
+++ trunk/libtest-poe-server-tcp-perl/META.yml Tue Jul 14 02:23:53 2009
@@ -23,7 +23,7 @@
 provides:
   Test::POE::Server::TCP:
     file: lib/Test/POE/Server/TCP.pm
-    version: 1.06
+    version: 1.08
 requires:
   POE: 1.004
   POE::Filter: 0
@@ -35,4 +35,4 @@
   homepage: http://github.com/bingos/test-poe-server-tcp/tree
   license: http://dev.perl.org/licenses/
   repository: git://github.com/bingos/test-poe-server-tcp.git
-version: 1.06
+version: 1.08

Modified: trunk/libtest-poe-server-tcp-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-poe-server-tcp-perl/Makefile.PL?rev=39849&op=diff
==============================================================================
--- trunk/libtest-poe-server-tcp-perl/Makefile.PL (original)
+++ trunk/libtest-poe-server-tcp-perl/Makefile.PL Tue Jul 14 02:23:53 2009
@@ -5,6 +5,7 @@
 author 'Chris Williams <chris at bingosnet.co.uk>';
 version_from 'lib/Test/POE/Server/TCP.pm';
 abstract_from 'lib/Test/POE/Server/TCP.pm';
+readme_from 'lib/Test/POE/Server/TCP.pm';
 license 'perl';
 auto_license holder => 'Chris Williams, Rocco Caputo, Ann Barcomb and Jos Boumans';
 perl_version '5.006';

Modified: trunk/libtest-poe-server-tcp-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-poe-server-tcp-perl/README?rev=39849&op=diff
==============================================================================
--- trunk/libtest-poe-server-tcp-perl/README (original)
+++ trunk/libtest-poe-server-tcp-perl/README Tue Jul 14 02:23:53 2009
@@ -3,22 +3,98 @@
     for test cases
 
 SYNOPSIS
-       # An echo server test
+    A very simple echo server with logging of requests by each client:
+
+       use strict;
+       use POE;
+       use Test::POE::Server::TCP;
+
+       POE::Session->create(
+         package_states => [
+            'main' => [qw(
+                            _start
+                            testd_connected
+                            testd_disconnected
+                            testd_client_input
+            )],
+         ],
+       );
+   
+       $poe_kernel->run();
+       exit 0;
+   
+       sub _start {
+         # Spawn the Test::POE::Server::TCP server.
+         $_[HEAP]->{testd} = Test::POE::Server::TCP->spawn(
+            address => '127.0.0.1',
+            port => 0,
+         );
+         return;
+       }
+   
+       sub testd_connected {
+         my ($heap,$id) = @_[HEAP,ARG0];
+
+         # A client connected the unique ID is in ARG0
+         # Create a blank arrayref for this client on *our* heap
+
+         $heap->{clients}->{ $id } = [ ];
+
+         return;
+       }
+   
+       sub testd_client_input {
+         my ($kernel,$heap,$sender,$id,$input) = @_[KERNEL,HEAP,SENDER,ARG0,ARG1];
+
+         # The client sent us a line of input
+         # lets store it
+
+         push @{ $heap->{clients}->{ $id }, $input;
+
+         # Okay, we are an echo server so lets send it back to the client
+         # We know the SENDER so can always obtain the server object.
+
+         my $testd = $sender->get_heap();
+         $testd->send_to_client( $id, $input );
+
+         # Or even
+
+         # $sender->get_heap()->send_to_client( $id, $input );
+
+         # Alternatively we could just post back to the SENDER
+
+         # $kernel->post( $sender, 'send_to_client', $id, $input );
+
+         return;
+       }
+
+       sub testd_disconnected {
+         my ($heap,$id) = @_[HEAP,ARG0];
+
+         # Client disconnected for whatever reason
+         # We need to free up our storage
+
+         delete $heap->{clients}->{ $id };
+
+         return;
+       }
+
+    Using the module in a testcase:
 
        use strict;
        use Test::More;
        use POE qw(Wheel::SocketFactory Wheel::ReadWrite Filter::Line);
        use Test::POE::Server::TCP;
-       
-   plan tests => 5;
-       
-   my @data = (
+   
+       plan tests => 5;
+   
+       my @data = (
          'This is a test',
          'This is another test',
          'This is the last test',
        );
-       
-   POE::Session->create(
+   
+       POE::Session->create(
          package_states => [
             'main' => [qw(
                             _start
@@ -26,7 +102,6 @@
                             _sock_fail
                             _sock_in
                             _sock_err
-                            testd_registered
                             testd_connected
                             testd_disconnected
                             testd_client_input
@@ -34,19 +109,19 @@
          ],
          heap => { data => \@data, },
        );
-       
-   $poe_kernel->run();
+   
+       $poe_kernel->run();
        exit 0;
-       
-   sub _start {
+   
+       sub _start {
          $_[HEAP]->{testd} = Test::POE::Server::TCP->spawn(
             address => '127.0.0.1',
             port => 0,
          );
          return;
        }
-       
-   sub testd_registered {
+   
+       sub testd_registered {
          my ($heap,$object) = @_[HEAP,ARG0];
          $heap->{port} = $object->port();
          $heap->{factory} = POE::Wheel::SocketFactory->new(
@@ -57,8 +132,8 @@
          );
          return;
        }
-       
-   sub _sock_up {
+   
+       sub _sock_up {
          my ($heap,$socket) = @_[HEAP,ARG0];
          delete $heap->{factory};
          $heap->{socket} = POE::Wheel::ReadWrite->new(
@@ -69,15 +144,15 @@
          $heap->{socket}->put( $heap->{data}->[0] );
          return;
        }
-       
-   sub _sock_fail {
+   
+       sub _sock_fail {
          my $heap = $_[HEAP];
          delete $heap->{factory};
          $heap->{testd}->shutdown();
          return;
        }
-       
-   sub _sock_in {
+   
+       sub _sock_in {
          my ($heap,$input) = @_[HEAP,ARG0];
          my $data = shift @{ $heap->{data} };
          ok( $input eq $data, 'Data matched' );
@@ -88,25 +163,25 @@
          $heap->{socket}->put( $heap->{data}->[0] );
          return;
        }
-       
-   sub _sock_err {
+   
+       sub _sock_err {
          delete $_[HEAP]->{socket};
          return;
        }
-       
-   sub testd_connected {
+   
+       sub testd_connected {
          my ($heap,$state,$id) = @_[HEAP,STATE,ARG0];
          pass($state);
          return;
        }
-       
-   sub testd_disconnected {
+   
+       sub testd_disconnected {
          pass($_[STATE]);
          $poe_kernel->post( $_[SENDER], 'shutdown' );
          return;
        }
-       
-   sub testd_client_input {
+   
+       sub testd_client_input {
          my ($sender,$id,$input) = @_[SENDER,ARG0,ARG1];
          my $testd = $_[SENDER]->get_heap();
          $testd->send_to_client( $id, $input );
@@ -125,7 +200,7 @@
     disconnecting a client connection.
 
 CONSTRUCTOR
-    spawn
+    "spawn"
         Takes a number of optional arguments:
 
           'alias', set an alias on the component;
@@ -135,6 +210,7 @@
           'filter', specify a POE::Filter to use for client connections, default is POE::Filter::Line;
           'inputfilter', specify a POE::Filter for client input;
           'outputfilter', specify a POE::Filter for output to clients;
+          'prefix', specify a different prefix than 'testd' for events;
 
         The semantics for "filter", "inputfilter" and "outputfilter" are the
         same as for POE::Component::Server::TCP in that one may provide
@@ -144,94 +220,153 @@
         automatically "register" the parent session to receive "all" events.
 
 METHODS
-    session_id
+    "session_id"
         Returns the POE::Session ID of the component.
 
-    shutdown
+    "shutdown"
         Terminates the component. Shuts down the listener and disconnects
         connected clients.
 
-    send_to_client
+    "send_to_client"
         Send some output to a connected client. First parameter must be a
-        valid client id. Second parameter is a string of text to send.
-
-    disconnect
+        valid client id. Second parameter is a string of text to send. The
+        second parameter may also be an arrayref of items to send to the
+        client. If the filter you have used requires an arrayref as input,
+        nest that arrayref within another arrayref.
+
+    "send_to_all_clients"
+        Send some output to all connected clients. The parameter is a string
+        of text to send. The parameter may also be an arrayref of items to
+        send to the clients. If the filter you have used requires an
+        arrayref as input, nest that arrayref within another arrayref.
+
+    "client_info"
+        Retrieve socket information of a given client. Requires a valid
+        client ID as a parameter. If called in a list context it returns a
+        list consisting of, in order, the client address, the client TCP
+        port, our address and our TCP port. In a scalar context it returns a
+        HASHREF with the following keys:
+
+          'peeraddr', the client address;
+          'peerport', the client TCP port;
+          'sockaddr', our address;
+          'sockport', our TCP port;
+
+    "client_wheel"
+        Retrieve the POE::Wheel::ReadWrite object of a given client.
+        Requires a valid client ID as a parameter. This enables one to
+        manipulate the given POE::Wheel::ReadWrite object, say to switch
+        POE::Filter.
+
+    "disconnect"
         Places a client connection in pending disconnect state. Requires a
         valid client ID as a parameter. Set this, then send an applicable
         message to the client using send_to_client() and the client
         connection will be terminated.
 
-    getsockname
+    "terminate"
+        Immediately disconnects a client conenction. Requires a valid client
+        ID as a parameter.
+
+    "pause_listening"
+        Stops the underlying listening socket from accepting new
+        connections. This lets you test whether you handle the connection
+        timing out gracefully.
+
+    "resume_listening"
+        The companion of "pause_listening"
+
+    "getsockname"
         Access to the POE::Wheel::SocketFactory method of the underlying
         listening socket.
 
-    port
+    "port"
         Returns the port that the component is listening on.
 
 INPUT EVENTS
     These are events that the component will accept:
 
-    register
+    "register"
         Takes N arguments: a list of event names that your session wants to
         listen for, minus the 'testd_' prefix.
 
         Registering for 'all' will cause it to send all TESTD-related events
         to you; this is the easiest way to handle it.
 
-    unregister
+    "unregister"
         Takes N arguments: a list of event names which you don't want to
         receive. If you've previously done a 'register' for a particular
         event which you no longer care about, this event will tell the POP3D
         to stop sending them to you. (If you haven't, it just ignores you.
         No big deal).
 
-    shutdown
+    "shutdown"
         Terminates the component. Shuts down the listener and disconnects
         connected clients.
 
-    send_to_client
+    "send_to_client"
         Send some output to a connected client. First parameter must be a
-        valid client ID. Second parameter is a string of text to send.
-
-    disconnect
+        valid client id. Second parameter is a string of text to send. The
+        second parameter may also be an arrayref of items to send to the
+        client. If the filter you have used requires an arrayref as input,
+        nest that arrayref within another arrayref.
+
+    "send_to_all_clients"
+        Send some output to all connected clients. The parameter is a string
+        of text to send. The parameter may also be an arrayref of items to
+        send to the clients. If the filter you have used requires an
+        arrayref as input, nest that arrayref within another arrayref.
+
+    "disconnect"
         Places a client connection in pending disconnect state. Requires a
         valid client ID as a parameter. Set this, then send an applicable
         message to the client using send_to_client() and the client
         connection will be terminated.
 
+    "terminate"
+        Immediately disconnects a client conenction. Requires a valid client
+        ID as a parameter.
+
 OUTPUT EVENTS
-    The component sends the following events to registered sessions:
-
-    testd_registered
+    The component sends the following events to registered sessions. If you
+    have changed the "prefix" option in "spawn" then substitute "testd" with
+    the event prefix that you specified.
+
+    "testd_registered"
         This event is sent to a registering session. ARG0 is the
         Test::POE::Server::TCP object.
 
-    testd_listener_failed
+    "testd_listener_failed"
         Generated if the component cannot either start a listener or there
         is a problem accepting client connections. ARG0 contains the name of
         the operation that failed. ARG1 and ARG2 hold numeric and string
         values for $!, respectively.
 
-    testd_connected
+    "testd_connected"
         Generated whenever a client connects to the component. ARG0 is the
         client ID, ARG1 is the client's IP address, ARG2 is the client's TCP
         port. ARG3 is our IP address and ARG4 is our socket port.
 
-    testd_disconnected
+    "testd_disconnected"
         Generated whenever a client disconnects. ARG0 is the client ID.
 
-    testd_client_input
+    "testd_client_input"
         Generated whenever a client sends us some traffic. ARG0 is the
         client ID, ARG1 is the data sent ( tokenised by whatever POE::Filter
         you specified.
 
-    testd_client_flushed
+    "testd_client_flushed"
         Generated whenever anything we send to the client is actually
         flushed down the 'line'. ARG0 is the client ID.
 
 AUTHOR
+    Chris "BinGOs" Williams <chris at bingosnet.co.uk>
+
+    with code borrowed from POE::Component::Server::TCP by Rocco Caputo, Ann
+    Barcomb and Jos Boumans.
+
 LICENSE
-    Copyright "(c)" Chris Williams
+    Copyright © Chris Williams, Rocco Caputo, Ann Barcomb and Jos Boumans.
 
     This module may be used, modified, and distributed under the same terms
     as Perl itself. Please see the license that came with your Perl

Modified: trunk/libtest-poe-server-tcp-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-poe-server-tcp-perl/debian/changelog?rev=39849&op=diff
==============================================================================
--- trunk/libtest-poe-server-tcp-perl/debian/changelog (original)
+++ trunk/libtest-poe-server-tcp-perl/debian/changelog Tue Jul 14 02:23:53 2009
@@ -1,3 +1,12 @@
+libtest-poe-server-tcp-perl (1.08-1) UNRELEASED; urgency=low
+
+  * New upstream release
+    + Add a feature to broadcast to all clients (send_to_all_clients)
+  * Added /me to Uploaders and Copyright
+  * Rewrote description (a bit shorter) - the synopsis is different
+
+ -- Jonathan Yu <frequency at cpan.org>  Mon, 13 Jul 2009 18:15:03 -0400
+
 libtest-poe-server-tcp-perl (1.06-1) unstable; urgency=low
 
   [ Nathan Handler ]

Modified: trunk/libtest-poe-server-tcp-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-poe-server-tcp-perl/debian/control?rev=39849&op=diff
==============================================================================
--- trunk/libtest-poe-server-tcp-perl/debian/control (original)
+++ trunk/libtest-poe-server-tcp-perl/debian/control Tue Jul 14 02:23:53 2009
@@ -2,10 +2,10 @@
 Section: perl
 Priority: optional
 Build-Depends: debhelper (>= 7)
-Build-Depends-Indep: perl (>= 5.6.0-12), libpoe-perl (>= 2:1.0040),
- libtest-pod-perl, libtest-pod-coverage-perl, netbase
+Build-Depends-Indep: perl (>= 5.6.0-12), libpoe-perl (>= 2:1.0040), netbase,
+ libtest-pod-perl, libtest-pod-coverage-perl
 Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
-Uploaders: Antonio Radici <antonio at dyne.org>,
+Uploaders: Antonio Radici <antonio at dyne.org>, Jonathan Yu <frequency at cpan.org>,
  gregor herrmann <gregoa at debian.org>, Ryan Niebur <ryanryan52 at gmail.com>,
  Nathan Handler <nhandler at ubuntu.com>
 Standards-Version: 3.8.2
@@ -16,13 +16,10 @@
 Package: libtest-poe-server-tcp-perl
 Architecture: all
 Depends: ${perl:Depends}, ${misc:Depends}, libpoe-perl (>= 2:1.0040)
-Description: POE Component providing TCP server services for test cases
- Test::POE::Server::TCP is a POE component that provides a TCP server
- framework for inclusion in client component test cases, instead of having to
- roll your own.
- .
- Once registered with the component, a session will receive events related to
- client connects, disconnects, input and flushed output. Each of these events
- will refer to a unique client ID which may be used in communication with the
- component when sending data to the client or disconnecting a client
+Description: Test framework for TCP client libraries using POE
+ Test::POE::Server::TCP is a POE component that provides a TCP server framework
+ for inclusion in client component test cases. Once registered, a session will
+ receive events related to client connects, disconnects, input and any written
+ output. Each of these events refers to a unique client ID which may be used in
+ communication with the component when sending data to the client or ending a
  connection.

Modified: trunk/libtest-poe-server-tcp-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-poe-server-tcp-perl/debian/copyright?rev=39849&op=diff
==============================================================================
--- trunk/libtest-poe-server-tcp-perl/debian/copyright (original)
+++ trunk/libtest-poe-server-tcp-perl/debian/copyright Tue Jul 14 02:23:53 2009
@@ -5,8 +5,10 @@
 Upstream-Name: Test-POE-Server-TCP
 
 Files: *
-Copyright: 
- (c) 2009 Chris Williams, Rocco Caputo, Ann Barcomb and Jos Boumans.
+Copyright: 2009, Chris Williams <chris at bingosnet.co.uk>
+ 2009, Rocco Caputo <rcaputo at cpan.org>
+ 2009, Ann Barcomb <kudra at domaintje.com>
+ 2009, Jos Boumans <kane at cpan.org>
 License-Alias: Perl
 License: Artistic | GPL-1+
 
@@ -18,8 +20,8 @@
 License: Artistic | GPL-1+
 
 Files: debian/*
-Copyright: 
- (c) 2009, Antonio Radici <antonio at dyne.org>
+Copyright: 2009, Jonathan Yu <frequency at cpan.org>
+ 2009, Antonio Radici <antonio at dyne.org>
 License: Artistic | GPL-1+
 
 License: Artistic

Modified: trunk/libtest-poe-server-tcp-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-poe-server-tcp-perl/debian/rules?rev=39849&op=diff
==============================================================================
--- trunk/libtest-poe-server-tcp-perl/debian/rules (original)
+++ trunk/libtest-poe-server-tcp-perl/debian/rules Tue Jul 14 02:23:53 2009
@@ -1,23 +1,4 @@
 #!/usr/bin/make -f
 
-build: build-stamp
-build-stamp:
-	dh build
-	touch $@
-
-clean:
+%:
 	dh $@
-
-install: install-stamp
-install-stamp: build-stamp
-	dh install
-	touch $@
-
-binary-arch:
-
-binary-indep: install
-	dh $@
-
-binary: binary-arch binary-indep
-
-.PHONY: binary binary-arch binary-indep install clean build

Modified: trunk/libtest-poe-server-tcp-perl/inc/Module/Install/GithubMeta.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-poe-server-tcp-perl/inc/Module/Install/GithubMeta.pm?rev=39849&op=diff
==============================================================================
--- trunk/libtest-poe-server-tcp-perl/inc/Module/Install/GithubMeta.pm (original)
+++ trunk/libtest-poe-server-tcp-perl/inc/Module/Install/GithubMeta.pm Tue Jul 14 02:23:53 2009
@@ -7,14 +7,14 @@
 use base qw(Module::Install::Base);
 use vars qw($VERSION);
 
-$VERSION = '0.08';
+$VERSION = '0.10';
 
 sub githubmeta {
   my $self = shift;
   return unless $Module::Install::AUTHOR;
   return unless _under_git();
   return unless $self->can_run('git');
-  return unless my ($git_url) = `git remote show origin` =~ /URL: (.*)$/m;
+  return unless my ($git_url) = `git remote show -n origin` =~ /URL: (.*)$/m;
   return unless $git_url =~ /github\.com/; # Not a Github repository
   my $http_url = $git_url;
   $git_url =~ s![\w\-]+\@([^:]+):!git://$1/!;

Added: trunk/libtest-poe-server-tcp-perl/inc/Module/Install/ReadmeFromPod.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-poe-server-tcp-perl/inc/Module/Install/ReadmeFromPod.pm?rev=39849&op=file
==============================================================================
--- trunk/libtest-poe-server-tcp-perl/inc/Module/Install/ReadmeFromPod.pm (added)
+++ trunk/libtest-poe-server-tcp-perl/inc/Module/Install/ReadmeFromPod.pm Tue Jul 14 02:23:53 2009
@@ -1,0 +1,36 @@
+#line 1
+package Module::Install::ReadmeFromPod;
+
+use strict;
+use warnings;
+use base qw(Module::Install::Base);
+use vars qw($VERSION);
+
+$VERSION = '0.06';
+
+sub readme_from {
+  my $self = shift;
+  return unless $Module::Install::AUTHOR;
+  my $file = shift || return;
+  my $clean = shift;
+  require Pod::Text;
+  my $parser = Pod::Text->new();
+  open README, '> README' or die "$!\n";
+  $parser->output_fh( *README );
+  $parser->parse_file( $file );
+  return 1 unless $clean;
+  $self->postamble(<<"END");
+distclean :: license_clean
+
+license_clean:
+\t\$(RM_F) README
+END
+  return 1;
+}
+
+'Readme!';
+
+__END__
+
+#line 89
+

Modified: trunk/libtest-poe-server-tcp-perl/lib/Test/POE/Server/TCP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-poe-server-tcp-perl/lib/Test/POE/Server/TCP.pm?rev=39849&op=diff
==============================================================================
--- trunk/libtest-poe-server-tcp-perl/lib/Test/POE/Server/TCP.pm (original)
+++ trunk/libtest-poe-server-tcp-perl/lib/Test/POE/Server/TCP.pm Tue Jul 14 02:23:53 2009
@@ -7,7 +7,7 @@
 use Carp qw(carp croak);
 use vars qw($VERSION);
 
-$VERSION = '1.06';
+$VERSION = '1.08';
 
 sub spawn {
   my $package = shift;
@@ -20,13 +20,14 @@
   $self->{_prefix} .= '_' unless $self->{_prefix} =~ /\_$/;
   $self->{session_id} = POE::Session->create(
 	object_states => [
-	   $self => { shutdown       => '_shutdown',
-		      send_event     => '__send_event',
-		      send_to_client => '_send_to_client',
-		      disconnect     => '_disconnect',
-		      terminate      => '_terminate',
+	   $self => { shutdown      => '_shutdown',
+		      send_event          => '__send_event',
+		      send_to_client      => '_send_to_client',
+		      send_to_all_clients => '_send_to_all_clients',
+		      disconnect          => '_disconnect',
+		      terminate           => '_terminate',
 	            },
-	   $self => [ qw(_start register unregister _accept_client _accept_failed _conn_input _conn_error _conn_flushed _conn_alarm _send_to_client __send_event _disconnect) ],
+	   $self => [ qw(_start register unregister _accept_client _accept_failed _conn_input _conn_error _conn_flushed _conn_alarm _send_to_client __send_event _disconnect _send_to_all_clients) ],
 	],
 	heap => $self,
 	( ref($options) eq 'HASH' ? ( options => $options ) : () ),
@@ -414,13 +415,27 @@
   return unless $output;
 
   if ( ref $output eq 'ARRAY' ) {
-    my $first = shift @{ $output };
-    $self->{clients}->{ $id }->{BUFFER} = $output if scalar @{ $output };
+    my $temp = [ @{ $output } ];
+    my $first = shift @{ $temp };
+    $self->{clients}->{ $id }->{BUFFER} = $temp if scalar @{ $temp };
     $self->{clients}->{ $id }->{wheel}->put($first) if defined $first;
     return 1;
   }
 
   $self->{clients}->{ $id }->{wheel}->put($output);
+  return 1;
+}
+
+sub send_to_all_clients {
+  my $self = shift;
+  $poe_kernel->call( $self->{session_id}, '_send_to_all_clients', @_ );
+}
+
+sub _send_to_all_clients {
+  my ($kernel,$self,$output) = @_[KERNEL,OBJECT,ARG0];
+  return unless $output;
+  $self->send_to_client( $_, $output ) for
+    keys %{ $self->{clients} };
   return 1;
 }
 
@@ -671,6 +686,12 @@
 The second parameter may also be an arrayref of items to send to the client. If the filter you have used requires an arrayref as
 input, nest that arrayref within another arrayref.
 
+=item C<send_to_all_clients>
+
+Send some output to all connected clients. The parameter is a string of text to send.
+The parameter may also be an arrayref of items to send to the clients. If the filter you have used requires an arrayref as
+input, nest that arrayref within another arrayref.
+
 =item C<client_info>
 
 Retrieve socket information of a given client. Requires a valid client ID as a parameter. If called in a list context it returns a list 
@@ -735,8 +756,16 @@
 
 =item C<send_to_client>
 
-Send some output to a connected client. First parameter must be a valid client ID. 
-Second parameter is a string of text to send.
+Send some output to a connected client. First parameter must be a valid client id. Second parameter is a string of text to send.
+The second parameter may also be an arrayref of items to send to the client. If the filter you have used requires an arrayref as
+input, nest that arrayref within another arrayref.
+
+
+=item C<send_to_all_clients>
+
+Send some output to all connected clients. The parameter is a string of text to send.
+The parameter may also be an arrayref of items to send to the clients. If the filter you have used requires an arrayref as
+input, nest that arrayref within another arrayref.
 
 =item C<disconnect>
 

Added: trunk/libtest-poe-server-tcp-perl/t/12_all_clients.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-poe-server-tcp-perl/t/12_all_clients.t?rev=39849&op=file
==============================================================================
--- trunk/libtest-poe-server-tcp-perl/t/12_all_clients.t (added)
+++ trunk/libtest-poe-server-tcp-perl/t/12_all_clients.t Tue Jul 14 02:23:53 2009
@@ -1,0 +1,130 @@
+use strict;
+use Socket;
+use Test::More;
+use POE qw(Wheel::SocketFactory Wheel::ReadWrite Filter::Line);
+use Test::POE::Server::TCP;
+
+my %data = (
+	tests => [ 
+		[ '+OK' => 'cock' ], 
+		[ '-ERR' => 'quit' ],
+	],
+	clients => 2,
+);
+
+plan tests => 14;
+
+POE::Session->create(
+  package_states => [
+	'main' => [qw(
+			_start
+			_sock_up
+			_sock_fail
+			_sock_in
+			_sock_err
+			testd_registered
+			testd_connected
+			testd_disconnected
+			testd_client_input
+			testd_client_flushed
+	)],
+  ],
+  heap => \%data,
+);
+
+$poe_kernel->run();
+exit 0;
+
+sub _start {
+  $_[HEAP]->{testd} = Test::POE::Server::TCP->spawn(
+	address => '127.0.0.1',
+	port => 0,
+	options => { trace => 0 },
+  );
+  isa_ok( $_[HEAP]->{testd}, 'Test::POE::Server::TCP' );
+  return;
+}
+
+sub testd_registered {
+  my ($heap,$object) = @_[HEAP,ARG0];
+  isa_ok( $object, 'Test::POE::Server::TCP' );
+  $heap->{port} = $object->port();
+  for ( 1 .. $heap->{clients} ) {
+    my $factory = POE::Wheel::SocketFactory->new(
+	RemoteAddress  => '127.0.0.1',
+	RemotePort     => $heap->{port},
+	SuccessEvent   => '_sock_up',
+	FailureEvent   => '_sock_fail',
+    );
+    $heap->{factories}->{ $factory->ID } = $factory;
+  }
+  return;
+}
+
+sub _sock_up {
+  my ($heap,$socket,$fact_id) = @_[HEAP,ARG0,ARG3];
+  delete $heap->{factories}->{ $fact_id };
+  my $wheel = POE::Wheel::ReadWrite->new(
+	Handle => $socket,
+	InputEvent => '_sock_in',
+	ErrorEvent => '_sock_err',
+  );
+  $heap->{wheels}->{ $wheel->ID } = $wheel;
+  $heap->{numbers}->{ $wheel->ID } = 0;
+  return;
+}
+
+sub _sock_fail {
+  my ($heap,$fact_id) = @_[HEAP,ARG3];
+  delete $heap->{factory}->{ $fact_id };
+  $heap->{clients}--;
+  $heap->{testd}->shutdown() if $heap->{clients} <= 0;
+  return;
+}
+
+sub _sock_in {
+  my ($heap,$input,$wheel_id) = @_[HEAP,ARG0,ARG1];
+  is($input,'HELLO ALL','Input from server to all');
+  $heap->{wheels}->{ $wheel_id }->put('quit');
+  return;
+}
+
+sub _sock_err {
+  my ($heap,$wheel_id) = @_[HEAP,ARG3];
+  delete $heap->{wheels}->{ $wheel_id };
+  pass("Disconnected");
+  $heap->{clients}--;
+  $heap->{testd}->shutdown() if $heap->{clients} <= 0;
+  return;
+}
+
+sub testd_connected {
+  my ($heap,$state,$id) = @_[HEAP,STATE,ARG0];
+  pass($state);
+  $heap->{connected}++;
+  return unless $heap->{connected} == $heap->{clients};
+  $poe_kernel->post( $_[SENDER], 'send_to_all_clients', 'HELLO ALL' );
+  return;
+}
+
+sub testd_disconnected {
+  pass($_[STATE]);
+  return;
+}
+
+sub testd_client_flushed {
+  pass($_[STATE]);
+  return;
+}
+
+sub testd_client_input {
+  my ($sender,$id,$input) = @_[SENDER,ARG0,ARG1];
+  my $testd = $_[SENDER]->get_heap();
+  pass($_[STATE]);
+  if ( $input eq 'quit' ) {
+    $testd->terminate( $id );
+    return;
+  }
+  $testd->send_to_client( $id, '-ERR' );
+  return;
+}




More information about the Pkg-perl-cvs-commits mailing list