r66707 - in /trunk/libnet-smpp-perl: Changes META.yml SMPP.pm debian/changelog test.pl

periapt-guest at users.alioth.debian.org periapt-guest at users.alioth.debian.org
Fri Dec 31 12:36:15 UTC 2010


Author: periapt-guest
Date: Fri Dec 31 12:36:00 2010
New Revision: 66707

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=66707
Log:
New upstream release

Modified:
    trunk/libnet-smpp-perl/Changes
    trunk/libnet-smpp-perl/META.yml
    trunk/libnet-smpp-perl/SMPP.pm
    trunk/libnet-smpp-perl/debian/changelog
    trunk/libnet-smpp-perl/test.pl

Modified: trunk/libnet-smpp-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-smpp-perl/Changes?rev=66707&op=diff
==============================================================================
--- trunk/libnet-smpp-perl/Changes (original)
+++ trunk/libnet-smpp-perl/Changes Fri Dec 31 12:36:00 2010
@@ -49,26 +49,17 @@
 1.14  24.6.2010
       * upgraded to support more recent perls, probably breaking 5.005 and earlier
 
-Note: exact change logs are kept in CVS
+1.16  22.10.2010
+      * more patches to support more recent perls from Zeus Panchenko
 
-Interested readers:
-Paul Morris <paul.morris at totalise.co.uk>
-Chia-liang Kao <clkao at clkao.org>
-Roland Giersig <r.giersig at xsoft.at>
-"Tony Clark" <clarktony at hotmail.com>
-"Andres Maduro" <andres at iconos.com.ve>
-Richard Morgan <Richard at webcom.com.au>
-"Artem Zotov" <zot_aa at inform-mobil.ru>
-lars at thegler.dk
-Ismael Briones <ismael at el-mundo.net>
-lem at cantv.net
-kn at sifira.dk
-Luis Munoz <len at cantv.net>
-Dziugas.Baltrunas at bite.lt
-Maxim.Burenko at kyivstar.net
-Matthias Meyser <Meyser at xenet.de>
-jose.venceslau at optimus.pt
-Francisco.Viana at optimus.pt
-valyakol at gmail.com
+1.17  1.11.2010
+      * Added check for connect failure in new_transciever()
 
-paul.morris at totalise.co.uk, clkao at clkao.org, r.giersig at xsoft.at, clarktony at hotmail.com, andres at iconos.com.ve, Richard at webcom.com.au, zot_aa at inform-mobil.ru, lars at thegler.dk, ismael at el-mundo.net, lem at cantv.net, kn at sifira.dk, len at cantv.net, Dziugas.Baltrunas at bite.lt, Maxim.Burenko at kyivstar.net, Matthias Meyser <Meyser at xenet.de>, jose.venceslau at optimus.pt, Francisco.Viana at optimus.pt, valyakol at gmail.com
+1.18  10.11.2010
+      * Improved connect failure check per patch from Zeus Panchenko
+      * Added multipart message example from Zeus Panchenko
+      * Typo fix from Boris Shomodjvarac
+
+Note: exact change logs are kept in git
+
+(See Interested-Readers)

Modified: trunk/libnet-smpp-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-smpp-perl/META.yml?rev=66707&op=diff
==============================================================================
--- trunk/libnet-smpp-perl/META.yml (original)
+++ trunk/libnet-smpp-perl/META.yml Fri Dec 31 12:36:00 2010
@@ -1,10 +1,10 @@
 # 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.14
+version:      1.18
 version_from: SMPP.pm
 installdirs:  site
 requires:
 
 distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
+generated_by: ExtUtils::MakeMaker version 6.30

Modified: trunk/libnet-smpp-perl/SMPP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-smpp-perl/SMPP.pm?rev=66707&op=diff
==============================================================================
--- trunk/libnet-smpp-perl/SMPP.pm (original)
+++ trunk/libnet-smpp-perl/SMPP.pm Fri Dec 31 12:36:00 2010
@@ -46,7 +46,7 @@
 
 package Net::SMPP;
 
-require 5.005;
+require 5.008;
 use strict;
 use Socket;
 use Symbol;
@@ -56,7 +56,7 @@
 
 use vars qw(@ISA $VERSION %default %param_by_name $trace);
 @ISA = qw(IO::Socket::INET);
-$VERSION = '1.14';
+$VERSION = '1.18';
 $trace = 0;
 
 use constant Transmitter => 1;  # SMPP transmitter mode of operation
@@ -296,6 +296,8 @@
   listen => 120,       # size of listen queue for new_listen()
   mode => Transceiver, # Chooses type of bind #4> (Transceiver is illegal for v4) <4#
 
+  enquire_interval => 0,  # How often enquire PDU is sent during read_hard(). 0 == off
+
 ### Version dependent defaults. Mainly these are used to handle different     #4
 ### message header formats between v34 and v4 in a consistent way. Generally  #4
 ### these are set in the constructor based on the smpp_version field.         #4
@@ -578,7 +580,7 @@
     
     for (my $i=0; $i <= $#_; $i+=2) {
 	next if !defined $_[$i];
-	if ($_[$i] eq 'async') { $async = splice @_,$i,2,undef,undef; }
+	if ($_[$i] eq 'async')  { $async = splice @_,$i,2,undef,undef; }
 	elsif ($_[$i] eq 'seq')   { $seq = splice @_,$i,2,undef,undef; }
     }
     $async = ${*$me}{async} if !defined $async;
@@ -1250,7 +1252,7 @@
 	next if !defined $_[$i];
 	if ($_[$i] eq 'message_id') { $message_id = splice @_,$i,2,undef,undef; }
     }
-    
+    warn "message_id=$message_id" if $trace;
     croak "message_id must be supplied" if !defined $message_id;
     return pack('Z*', $message_id);
 }
@@ -2207,10 +2209,11 @@
     my %arg = @_;
 
     my $s = $type->SUPER::new(
-         PeerAddr => $host,
-	 PeerPort => exists $arg{port} ? $arg{port} : Default->{port},
-	 Proto    => 'tcp',
-	 Timeout  => exists $arg{timeout} ? $arg{timeout} : Default->{timeout},
+         PeerAddr  => $host,
+	 PeerPort  => exists $arg{port} ? $arg{port} : Default->{port},
+	 LocalAddr => exists $arg{local_ip} ? $arg{local_ip} : Default->{local_ip},
+	 Proto     => 'tcp',
+	 Timeout   => exists $arg{timeout} ? $arg{timeout} : Default->{timeout},
 			      @_)  # pass any extra args to constructor
 	or return undef;
     
@@ -2228,7 +2231,10 @@
 sub new_transceiver {
     my $type = shift;
     my $me = $type->new_connect(@_);
+    return undef if !defined $me;
+    warn "Connected, sending bind: ".Dumper($me) if $trace;
     my $resp = $me->bind_transceiver();
+    warn "Bound: ".Dumper($resp) if $trace;
     return ($me, $resp) if wantarray;
     return $me;
 }
@@ -2236,6 +2242,7 @@
 sub new_transmitter {
     my $type = shift;
     my $me = $type->new_connect(@_);
+    return undef if !defined $me;
     warn "Connected, sending bind: ".Dumper($me) if $trace;
     my $resp = $me->bind_transmitter();
     warn "Bound: ".Dumper($resp) if $trace;
@@ -2246,7 +2253,10 @@
 sub new_receiver {
     my $type = shift;
     my $me = $type->new_connect(@_);
+    return undef if !defined $me;
+    warn "Connected, sending bind: ".Dumper($me) if $trace;
     my $resp = $me->bind_receiver();
+    warn "Bound: ".Dumper($resp) if $trace;
     return ($me, $resp) if wantarray;
     return $me;
 }
@@ -2342,7 +2352,7 @@
 
 sub message_id {
     my $me = shift;
-    return ${*$me}{message_id};
+    return $me->{message_id};
 }
 
 sub status {
@@ -2354,26 +2364,26 @@
 
 sub seq {
     my $me = shift;
-    return ${*$me}{seq};
+    return $me->{seq};
 }
 
 sub explain_status {
     my $me = shift;
     return sprintf("%s (%s=0x%08X)",
-		   Net::SMPP::status_code->{${*$me}{status}}->{msg},
-		   Net::SMPP::status_code->{${*$me}{status}}->{code},
-		   ${*$me}{status});
+		   Net::SMPP::status_code->{$me->{status}}->{msg},
+		   Net::SMPP::status_code->{$me->{status}}->{code},
+		   $me->{status});
 }
 
 sub cmd {
     my $me = shift;
-    return ${*$me}{cmd};
+    return $me->{cmd};
 }
 
 sub explain_cmd {
     my $me = shift;
-    my $cmd = Net::SMPP::pdu_tab->{${*$me}{cmd}}
-    || { cmd => sprintf(q{Unknown(0x%08X)}, ${*$me}{cmd}) };
+    my $cmd = Net::SMPP::pdu_tab->{$me->{cmd}}
+    || { cmd => sprintf(q{Unknown(0x%08X)}, $me->{cmd}) };
     return $cmd->{cmd};
 }
 
@@ -2386,19 +2396,29 @@
     my ($me, $len, $dr, $offset) = @_;
     while (length($$dr) < $len+$offset) {
 	my $n = length($$dr) - $offset;
-	#warn "read $n/$len";
-	$n = $me->sysread($$dr, $len-$n, $n+$offset);
-	if (!defined($n)) {
-	    warn "error reading header from socket: $!";
-	    ${*$me}{smpperror} = "read_hard I/O error: $!";
-	    ${*$me}{smpperrorcode} = 1;
-	    return undef;
-	}
-	if (!$n) {
-	    warn "premature eof reading from socket";
-	    ${*$me}{smpperror} = "read_hard premature eof";
-	    ${*$me}{smpperrorcode} = 2;
-	    return undef;
+	eval {
+	    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);
+	};
+	if ($@) {
+	    warn "ENQUIRE $@" if $trace;
+	    die unless $@ eq "alarm\n";   # propagate unexpected errors
+	    $me->enquire_link();   # Send a periodic ping
+	} else {
+	    if (!defined($n)) {
+		warn "error reading header from socket: $!";
+		${*$me}{smpperror} = "read_hard I/O error: $!";
+		${*$me}{smpperrorcode} = 1;
+		return undef;
+	    }
+	    if (!$n) {
+		warn "premature eof reading from socket";
+		${*$me}{smpperror} = "read_hard premature eof";
+		${*$me}{smpperrorcode} = 2;
+		return undef;
+	    }
 	}
     }
     #warn "read complete";
@@ -2460,7 +2480,7 @@
 	}
 	
 	### *** effectively all other PDUs get ignored
-	warn "looking for $look_for_me seq=$seq, skipping $pdu->{cmd} seq=$pdu->{seq}" if $trace;
+	warn "looking for $look_for_me seq=$seq, skipping cmd=$pdu->{cmd} seq=$pdu->{seq}" if $trace;
     }
 }
 
@@ -3297,7 +3317,7 @@
 
   use Net::SMPP;
   $smpp = Net::SMPP->new_transceiver('smsc.foo.net', port=>2552) or die;
-  $resp_pdu = $smpp->submit_sm(desination_addr => '447799658372',
+  $resp_pdu = $smpp->submit_sm(destination_addr => '447799658372',
 			       data => 'test message') or die;
   ***
 
@@ -3308,6 +3328,22 @@
 See test.pl for good templates with all official parameters, but
 beware that the actual parameter values are ficticious as is the flow
 of the dialog.
+
+=head1 MULTIPART MESSAGE
+
+Reportedly (Zeus Panchenko) multipart messages can be gotten to work with
+
+  while (length ($msgtext)) {
+    if ($multimsg_maxparts) {
+      @udh_ar = map { sprintf "%x", $_ } $origref, $multimsg_maxparts, $multimsg_curpart;
+      $udh = pack("hhhhhh",0x05, 0x00, 0x03 , @udh_ar);
+      $resp_pdu = $smpp->submit_sm(destination_addr => $phone,
+                           ...
+                           short_message => $udh . $msgtext,
+                         );
+      ...
+    }
+  }
 
 #4#cut
 =head1 VERSION 4.0 SUPPORT
@@ -3470,8 +3506,6 @@
 
 Interoperates with itself.
 
-*** No real interoperability tests have been performed yet
-
 =head1 TO DO AND BUGS
 
 =over 4

Modified: trunk/libnet-smpp-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-smpp-perl/debian/changelog?rev=66707&op=diff
==============================================================================
--- trunk/libnet-smpp-perl/debian/changelog (original)
+++ trunk/libnet-smpp-perl/debian/changelog Fri Dec 31 12:36:00 2010
@@ -1,8 +1,9 @@
-libnet-smpp-perl (1.14-2) UNRELEASED; urgency=low
+libnet-smpp-perl (1.18-1) UNRELEASED; urgency=low
 
   * Adding myself to Uploaders 
+  * New upstream release
 
- -- Nicholas Bamber <nicholas at periapt.co.uk>  Fri, 31 Dec 2010 12:31:18 +0000
+ -- Nicholas Bamber <nicholas at periapt.co.uk>  Fri, 31 Dec 2010 12:37:58 +0000
 
 libnet-smpp-perl (1.14-1) unstable; urgency=low
 

Modified: trunk/libnet-smpp-perl/test.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-smpp-perl/test.pl?rev=66707&op=diff
==============================================================================
--- trunk/libnet-smpp-perl/test.pl (original)
+++ trunk/libnet-smpp-perl/test.pl Fri Dec 31 12:36:00 2010
@@ -2157,6 +2157,7 @@
 	    if (($pdu->{seq} == $seq) && $pdu->{known_pdu}
 		&& ($pdu->{cmd} == 0x8001000a)
 		&& ($pdu->{status} == 0)
+		&& ($pdu->status == 0)
 		) {
 		print "ok 93  (seq=$seq)\n";
 	    } else {




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