r66705 - in /branches/upstream/libnet-smpp-perl/current: Changes META.yml SMPP.pm test.pl
periapt-guest at users.alioth.debian.org
periapt-guest at users.alioth.debian.org
Fri Dec 31 12:34:24 UTC 2010
Author: periapt-guest
Date: Fri Dec 31 12:34:14 2010
New Revision: 66705
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=66705
Log:
[svn-upgrade] new version libnet-smpp-perl (1.18)
Modified:
branches/upstream/libnet-smpp-perl/current/Changes
branches/upstream/libnet-smpp-perl/current/META.yml
branches/upstream/libnet-smpp-perl/current/SMPP.pm
branches/upstream/libnet-smpp-perl/current/test.pl
Modified: branches/upstream/libnet-smpp-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-smpp-perl/current/Changes?rev=66705&op=diff
==============================================================================
--- branches/upstream/libnet-smpp-perl/current/Changes (original)
+++ branches/upstream/libnet-smpp-perl/current/Changes Fri Dec 31 12:34:14 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: 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=66705&op=diff
==============================================================================
--- branches/upstream/libnet-smpp-perl/current/META.yml (original)
+++ branches/upstream/libnet-smpp-perl/current/META.yml Fri Dec 31 12:34:14 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: 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=66705&op=diff
==============================================================================
--- branches/upstream/libnet-smpp-perl/current/SMPP.pm (original)
+++ branches/upstream/libnet-smpp-perl/current/SMPP.pm Fri Dec 31 12:34:14 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: branches/upstream/libnet-smpp-perl/current/test.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-smpp-perl/current/test.pl?rev=66705&op=diff
==============================================================================
--- branches/upstream/libnet-smpp-perl/current/test.pl (original)
+++ branches/upstream/libnet-smpp-perl/current/test.pl Fri Dec 31 12:34:14 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