r75379 - in /branches/upstream/libnet-smpp-perl/current: Changes MANIFEST META.yml SMPP.pm SMPP_Test/ SMPP_Test/client.pl SMPP_Test/timeout.t

periapt-guest at users.alioth.debian.org periapt-guest at users.alioth.debian.org
Sat Jun 11 09:37:49 UTC 2011


Author: periapt-guest
Date: Sat Jun 11 09:37:33 2011
New Revision: 75379

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=75379
Log:
[svn-upgrade] new version libnet-smpp-perl (1.19)

Added:
    branches/upstream/libnet-smpp-perl/current/SMPP_Test/
    branches/upstream/libnet-smpp-perl/current/SMPP_Test/client.pl   (with props)
    branches/upstream/libnet-smpp-perl/current/SMPP_Test/timeout.t
Modified:
    branches/upstream/libnet-smpp-perl/current/Changes
    branches/upstream/libnet-smpp-perl/current/MANIFEST
    branches/upstream/libnet-smpp-perl/current/META.yml
    branches/upstream/libnet-smpp-perl/current/SMPP.pm

Modified: branches/upstream/libnet-smpp-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-smpp-perl/current/Changes?rev=75379&op=diff
==============================================================================
--- branches/upstream/libnet-smpp-perl/current/Changes (original)
+++ branches/upstream/libnet-smpp-perl/current/Changes Sat Jun 11 09:37:33 2011
@@ -60,6 +60,9 @@
       * Added multipart message example from Zeus Panchenko
       * Typo fix from Boris Shomodjvarac
 
+1.19  29.5.2011
+      * Improved signal handling in read_hard(), patch from Clemens Dorner
+
 Note: exact change logs are kept in git
 
 (See Interested-Readers)

Modified: branches/upstream/libnet-smpp-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-smpp-perl/current/MANIFEST?rev=75379&op=diff
==============================================================================
--- branches/upstream/libnet-smpp-perl/current/MANIFEST (original)
+++ branches/upstream/libnet-smpp-perl/current/MANIFEST Sat Jun 11 09:37:33 2011
@@ -10,4 +10,6 @@
 esme-hammer.pl
 sendmessage.pl
 esme-rec.pl
+SMPP_Test/client.pl
+SMPP_Test/timeout.t
 META.yml                                 Module meta-data (added by MakeMaker)

Modified: branches/upstream/libnet-smpp-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-smpp-perl/current/META.yml?rev=75379&op=diff
==============================================================================
--- branches/upstream/libnet-smpp-perl/current/META.yml (original)
+++ branches/upstream/libnet-smpp-perl/current/META.yml Sat Jun 11 09:37:33 2011
@@ -1,7 +1,7 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         Net-SMPP
-version:      1.18
+version:      1.19
 version_from: SMPP.pm
 installdirs:  site
 requires:

Modified: branches/upstream/libnet-smpp-perl/current/SMPP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-smpp-perl/current/SMPP.pm?rev=75379&op=diff
==============================================================================
--- branches/upstream/libnet-smpp-perl/current/SMPP.pm (original)
+++ branches/upstream/libnet-smpp-perl/current/SMPP.pm Sat Jun 11 09:37:33 2011
@@ -1,5 +1,5 @@
 # Net::SMPP.pm  -  SMPP over TCP, pure perl implementation
-# Copyright (c) 2001-2010 Sampo Kellomaki <sampo at iki.fi>, All rights reserved.
+# Copyright (c) 2001-2011 Sampo Kellomaki <sampo at iki.fi>, All rights reserved.
 # Portions Copyright (c) 2001-2005 Symlabs, All rights reserved.
 # This code may be distributed under same terms as perl. NO WARRANTY.
 # Work sponsored by Symlabs, the LDAP and directory experts (www.symlabs.com)
@@ -31,6 +31,7 @@
 # 14.12.2008, adapted to SMPPv50, thanks to Gema niskazhu (and curse to
 #             the spec authors for not letting me know about new version) --Sampo
 # 24.6.2010, tweaked for perl 5.8.8 --Sampo
+# 29.5.2011, improved signal handling in read_hard(), patch from Clemens Dorner --Sampo
 #
 # Why ${*$me}{async} vs. $me->async ?
 #
@@ -56,7 +57,7 @@
 
 use vars qw(@ISA $VERSION %default %param_by_name $trace);
 @ISA = qw(IO::Socket::INET);
-$VERSION = '1.18';
+$VERSION = '1.19';
 $trace = 0;
 
 use constant Transmitter => 1;  # SMPP transmitter mode of operation
@@ -2400,7 +2401,12 @@
 	    local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
 	    alarm ${*$me}{enquire_interval} if ${*$me}{enquire_interval};
 	    warn "read $n/$len enqint(${*$me}{enquire_interval})" if $trace>1;
-	    $n = $me->sysread($$dr, $len-$n, $n+$offset);
+	    while (1) {
+		$n = $me->sysread($$dr, $len-$n, $n+$offset);
+		next if $! =~ /^Interrupted/;
+		last;
+	    }
+	    alarm 0;
 	};
 	if ($@) {
 	    warn "ENQUIRE $@" if $trace;

Added: branches/upstream/libnet-smpp-perl/current/SMPP_Test/client.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-smpp-perl/current/SMPP_Test/client.pl?rev=75379&op=file
==============================================================================
--- branches/upstream/libnet-smpp-perl/current/SMPP_Test/client.pl (added)
+++ branches/upstream/libnet-smpp-perl/current/SMPP_Test/client.pl Sat Jun 11 09:37:33 2011
@@ -1,0 +1,38 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Carp;
+
+use IO::Socket;
+
+my $socket;
+
+my $port  = $ARGV[0];
+my $sleep = $ARGV[1];
+
+my $host = '127.0.0.1';
+
+$socket = IO::Socket::INET->new(
+    Proto    => 'tcp',
+    PeerAddr => $host,
+    PeerPort => $port,
+    Timeout  => 1,
+    Blocking => 0,
+) or croak "Cannot connect to $host $port";
+
+sleep $sleep;
+$socket->send("\x00");
+sleep $sleep;
+
+# enquire_link packet:
+my $packet = "\x00\x00\x00\x10"
+           . "\x00\x00\x00\x15"
+           . "\x00\x00\x00\x00"
+           . "\x00\x00\x00\x02"
+;
+$socket->send($packet);
+sleep $sleep;
+
+$socket->close();
+

Propchange: branches/upstream/libnet-smpp-perl/current/SMPP_Test/client.pl
------------------------------------------------------------------------------
    svn:executable = *

Added: branches/upstream/libnet-smpp-perl/current/SMPP_Test/timeout.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-smpp-perl/current/SMPP_Test/timeout.t?rev=75379&op=file
==============================================================================
--- branches/upstream/libnet-smpp-perl/current/SMPP_Test/timeout.t (added)
+++ branches/upstream/libnet-smpp-perl/current/SMPP_Test/timeout.t Sat Jun 11 09:37:33 2011
@@ -1,0 +1,78 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Carp;
+
+use Test::More tests => 6;
+use Test::Exception;
+use Test::Output;
+
+use IO::Socket;
+
+use Readonly;
+
+Readonly my $PORT             => 2255;
+Readonly my $HOST             => '127.0.0.1';
+Readonly my $HEADER_LENGTH    => 16;
+Readonly my $ENQUIRE_INTERVAL => 2;
+Readonly my $SEND_INTERVAL    => 4;
+Readonly my $DEFAULT_SLEEP    => 1;
+
+my $client_pid;
+local $SIG{'ALRM'} = sub { return; };
+local $SIG{'PIPE'} = 'IGNORE';
+
+my $header = q{};
+
+use_ok('Net::SMPP')
+    or croak 'Cannot load module Net::SMPP. No further testing done';
+
+can_ok( 'Net::SMPP', 'read_hard' );
+
+# Set trace variable to catch "ENQUIRE alarm" output.
+no warnings;
+$Net::SMPP::trace = 1;
+use warnings;
+
+#
+# Start listener:
+#
+my $smpp = Net::SMPP->new_listen(
+    $HOST,
+    port => $PORT,
+);
+
+isa_ok( $smpp, 'Net::SMPP' );
+isa_ok( $smpp, 'IO::Socket::INET' );
+${*$smpp}{'enquire_interval'} = $ENQUIRE_INTERVAL;
+
+
+#
+# Start client:
+#
+sleep $DEFAULT_SLEEP;
+system "./client.pl $PORT $SEND_INTERVAL &";
+sleep $DEFAULT_SLEEP;
+
+# Get client PID:
+#open my $fh, '<', 'client.pid'
+#    or croak "Cannot open pid file";
+#$client_pid = <$fh>;
+#chomp $client_pid;
+#close $fh
+#    or croak "Cannot close pid file";
+
+#note("client started with PID $client_pid");
+
+my $server = $smpp->accept();
+ok( $server->connected(), 'server has connection' );
+
+
+#
+# Check STDERR for "ENQUIRE alarm":
+#
+note( 'waiting for alarm ( ~ ' . $ENQUIRE_INTERVAL * 2 . ' s) ...' );
+stderr_like( sub { $server->read_hard( $HEADER_LENGTH, \$header, 0 ) },
+    qr{ENQUIRE[ ]alarm}xms, 'alarm triggered' );
+




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