File Coverage

blib/lib/Net/SMPP.pm

Criterion	Covered	Total	%
statement	1443	1570	91.9
branch	787	948	83.0
condition	5	25	20.0
subroutine	206	222	92.7
pod	38	94	40.4
total	2479	2859	86.7

# Net::SMPP.pm  -  SMPP over TCP, pure perl implementation
# Copyright (c) 2001-2011 Sampo Kellomaki , 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)
# 12.3.2001, Sampo Kellomaki
# 7.7.2001,  added SMPP 4.0 support --Sampo                               #4
# 9.7.2001,  continued 4.0 hacking --Sampo                                #4
# 11.7.2001, added J-Phone specific extended options --Sampo              #4
# 12.7.2001, fixed eating options off @_ --Sampo
# 1.8.2001,  merged in fixes from Felix Gaehtgens , bumped
#            version to 0.90 to reflect successfully conducted tests --Sampo
# 25.9.2001, tagged all 4.0 specifics so that 3.4-only version can be     #4
#            extracted for public distribution --Sampo                    #4
# 11.12.2001, fixed encode_deliver_v4 to encode_deliver_sm_v4, bug reported
#            by Cristina Del Amo ([e-mail]), --Sampo
# 4.1.2002,  Fixed enquiry_link to enquire_link --Sampo
# 10.1.2002, applied big patch by Lars Thegler  to
#            make pack and unpack templates perl5.005_03 compatible. --Sampo
#            Caught bugs in decode_outbind_v34(), encode_query_sm(),
#            encode_query_sm_resp() and replace_sm() --Sampo
# 11.1.2002, 7bit pack and unpack --Sampo
# 3.4.2002,  command length check from Cris, rolled out 1.01 --Sampo
# 7.12.2002, applied some patched by Luis Munoz  --Sampo
# 8.12.2002, more patched from Luis, --Sampo
# 23.9.2004, applied bind ip patch from Igor Ivoilov  --Sampo
# 29.4.2005, applied patch from Kristian Nielsen  --Sampo
# 21.4.2006, applied sysread patch from Dziugas.Baltrunas@bite..lt. Similar
#            patch was also proposed by Felix Gaehtgens  --Sampo
# 20.7.2007, patch from Matthias Meyser to fix enquiry_link, document 7bit (1.11) --Sampo
# 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 ?
#
# $Id: SMPP.pm,v 1.31 2008-12-02 16:41:30 sampo Exp $

### The comments often refer to sections of the following document
###   Short Message Peer to Peer Protocol Specification v3.4,
###   12-Oct-1999, Issue 1.2 (from www.smpp.org)
###
### Reference document for version 4.0 support was                        #4
###   Short Message Peer to Peer (SMPP) V4 Protocol Specification,        #4
###   29-Apr-1997, Version 1.1 (from Aldiscon/Logica)                     #4

package Net::SMPP;

require 5.008;
use strict;
use Socket;
use Symbol;
use Carp;
use IO::Socket;
use Data::Dumper;  # for debugging

use vars qw(@ISA $VERSION %default %param_by_name $trace);
@ISA = qw(IO::Socket::INET);
$VERSION = '1.19';
$trace = 0;

use constant Transmitter => 1;  # SMPP transmitter mode of operation
use constant Receiver    => 2;  #      receiver mode of operation
use constant Transceiver => 3;  #      both

### command_status code (Error Codes) from sec 5.1.3, table 5-2, pp.112-114

use constant status_code => {
    0x00000000 => { code => 'ESME_ROK', msg => 'No error', },
    0x00000001 => { code => 'ESME_RINVMSGLEN', msg => 'Message Length is invalid', },
    0x00000002 => { code => 'ESME_RINVCMDLEN', msg => 'Command Length is invalid', },
    0x00000003 => { code => 'ESME_RINVCMDID',  msg => 'Invalid Command ID', },
    0x00000004 => { code => 'ESME_RINVBNDSTS', msg => 'Incorrect BIND Status for given command', },
    0x00000005 => { code => 'ESME_RALYBND',    msg => 'ESME Already in bound state', },
    0x00000006 => { code => 'ESME_RINVPRTFLG', msg => 'Invalid priority flag', },
    0x00000007 => { code => 'ESME_RINVREGDLVFLG', msg => 'Invalid registered delivery flag', },
    0x00000008 => { code => 'ESME_RSYSERR',    msg => 'System Error', },
#    0x00000009 => { code => 'ESME_', msg => '', },
    0x0000000a => { code => 'ESME_RINVSRCADR', msg => 'Invalid source address', },
    0x0000000b => { code => 'ESME_RINVDSTADR', msg => 'Invalid destination address', },
    0x0000000c => { code => 'ESME_RINVMSGID',  msg => 'Message ID is invalid', },
    0x0000000d => { code => 'ESME_RBINDFAIL',  msg => 'Bind failed', },
    0x0000000e => { code => 'ESME_RINVPASWD',  msg => 'Invalid password', },
    0x0000000f => { code => 'ESME_RINVSYSID',  msg => 'Invalid System ID', },
#   0x00000010 => { code => 'ESME_', msg => '', },
    0x00000011 => { code => 'ESME_RCANCELFAIL',  msg => 'Cancel SM Failed', },
#   0x00000012 => { code => 'ESME_', msg => '', },
    0x00000013 => { code => 'ESME_RREPLACEFAIL', msg => 'Replace SM Failed', },
    0x00000014 => { code => 'ESME_RMSGQFUL',     msg => 'Message queue full', },
    0x00000015 => { code => 'ESME_RINVSERTYP',   msg => 'Invalid service type', },
# 0x00000016 - 0x00000032 reserved
    0x00000033 => { code => 'ESME_RINVNUMDESTS', msg => 'Invalid number of destinations', },
    0x00000034 => { code => 'ESME_RINVDLNAME',   msg => 'Invalid distribution list name', },
# 0x00000035 - 0x0000003f reserved
    0x00000040 => { code => 'ESME_RINVDESTFLAG', msg => 'Destination flag is invalid (submit_multi)', },
#   0x00000041 => { code => 'ESME_', msg => '', },
    0x00000042 => { code => 'ESME_RINVSUBREP',   msg => "Invalid `submit with replace' request (i.e. submit_sm with replace_if_present_flag set)", },
    0x00000043 => { code => 'ESME_RINVESMCLASS', msg => 'Invalid esm_class field data', },
    0x00000044 => { code => 'ESME_RCNTSUBDL',    msg => 'Cannot submit to distribution list', },
    0x00000045 => { code => 'ESME_RSUBMITFAIL',  msg => 'submit_sm or submit_multi failed', },
#   0x00000046 => { code => 'ESME_', msg => '', },
#   0x00000047 => { code => 'ESME_', msg => '', },
    0x00000048 => { code => 'ESME_RINVSRCTON', msg => 'Invalid source address TON', },
    0x00000049 => { code => 'ESME_RINVSRCNPI', msg => 'Invalid source address NPI', },
# 0x0000004a - 0x0000004f undocumented
    0x00000050 => { code => 'ESME_RINVDSTTON', msg => 'Invalid destination address TON', },
    0x00000051 => { code => 'ESME_RINVDSTNPI', msg => 'Invalid destination address NPI', },
#   0x00000052 => { code => 'ESME_', msg => '', },
    0x00000053 => { code => 'ESME_RINVSYSTYP', msg => 'Invalid system_type field', },
    0x00000054 => { code => 'ESME_RINVREPFLAG', msg => 'Invalid replace_if_present flag', },
    0x00000055 => { code => 'ESME_RINVNUMMSGS', msg => 'Invalid number of messages', },
#   0x00000056 => { code => 'ESME_', msg => '', },
#   0x00000057 => { code => 'ESME_', msg => '', },
    0x00000058 => { code => 'ESME_RTHROTTLED', msg => 'Throttling error (ESME has exceeded allowed message limits)', },
# 0x00000059 - 0x00000060 reserved
    0x00000061 => { code => 'ESME_RINVSCHED', msg => 'Invalid scheduled delivery time', },
    0x00000062 => { code => 'ESME_RINVEXPIRY', msg => 'Invalid message validity period (expiry time)', },
    0x00000063 => { code => 'ESME_RINVDFTMSGID', msg => 'Predefined message invalid or not found', },
    0x00000064 => { code => 'ESME_RX_T_APPN', msg => 'ESME Receiver Temporary App Error Code', },
    0x00000065 => { code => 'ESME_RX_P_APPN', msg => 'ESME Receiver Permanent App Error Code', },
    0x00000066 => { code => 'ESME_RX_R_APPN', msg => 'ESME Receiver Reject Message Error Code', },
    0x00000067 => { code => 'ESME_RQUERYFAIL', msg => 'query_sm request failed', },
# 0x00000068 - 0x000000bf reserved
    0x000000c0 => { code => 'ESME_RINVOPTPARSTREAM', msg => 'Error in the optional part of the PDU Body', },
    0x000000c1 => { code => 'ESME_ROPTPARNOTALLWD', msg => 'Optional paramenter not allowed', },
    0x000000c2 => { code => 'ESME_RINVPARLEN', msg => 'Invalid parameter length', },
    0x000000c3 => { code => 'ESME_RMISSINGOPTPARAM', msg => 'Expected optional parameter missing', },
    0x000000c4 => { code => 'ESME_RINVOPTPARAMVAL', msg => 'Invalid optional parameter value', },
# 0x000000c5 - 0x000000fd reserved
    0x000000fe => { code => 'ESME_RDELIVERYFAILURE', msg => 'Delivery Failure (used for data_sm_resp)', },
    0x000000ff => { code => 'ESME_RUNKNOWNERR', msg => 'Unknown error', },
# 0x00000100 - 0x000003ff reserved for SMPP extension
# 0x00000400 - 0x000004ff reserved for SMSC vendor specific errors
# 0x00000500 - 0xffffffff reserved

### *** Dear reader: if you know more error codes, e.g. in the
###     vendor specific range, please let me know so we can teach
###     this module about them.

};

### Convert the status code table into constants

do {
    no strict "refs";
    for my $k (keys(%{&status_code}))
    {
	eval { *{status_code->{$k}->{code}}        = sub { return $k; } };
        eval { *{status_code->{$k}->{code}.'_msg'} = sub { return *{status_code->{$k}->{msg}}; } };
    }
};

### Command IDs, sec 5.1.2.1, table 5-1, pp. 110-111

use constant CMD_generic_nack          => 0x80000000;
use constant CMD_bind_receiver         => 0x00000001;
use constant CMD_bind_receiver_resp    => 0x80000001;
use constant CMD_bind_transmitter      => 0x00000002;
use constant CMD_bind_transmitter_resp => 0x80000002;
use constant CMD_query_sm              => 0x00000003;
use constant CMD_query_sm_resp         => 0x80000003;
use constant CMD_submit_sm             => 0x00000004;
use constant CMD_submit_sm_resp        => 0x80000004;
use constant CMD_deliver_sm            => 0x00000005;
use constant CMD_deliver_sm_resp       => 0x80000005;
use constant CMD_unbind                => 0x00000006;
use constant CMD_unbind_resp           => 0x80000006;
use constant CMD_replace_sm            => 0x00000007;
use constant CMD_replace_sm_resp       => 0x80000007;
use constant CMD_cancel_sm             => 0x00000008;
use constant CMD_cancel_sm_resp        => 0x80000008;
use constant CMD_bind_transceiver      => 0x00000009;  # v3.4
use constant CMD_bind_transceiver_resp => 0x80000009;  # v3.4
use constant CMD_delivery_receipt      => 0x00000009;  # v4     #4
use constant CMD_delivery_receipt_resp => 0x80000009;  # v4     #4
use constant CMD_enquire_link_v4       => 0x0000000a;  #4
use constant CMD_enquire_link_resp_v4  => 0x8000000a;  #4
use constant CMD_outbind               => 0x0000000b;
use constant CMD_enquire_link          => 0x00000015;
use constant CMD_enquire_link_resp     => 0x80000015;
use constant CMD_submit_multi          => 0x00000021;
use constant CMD_submit_multi_resp     => 0x80000021;
use constant CMD_alert_notification    => 0x00000102;
use constant CMD_data_sm               => 0x00000103;
use constant CMD_data_sm_resp          => 0x80000103;

### Type of Number constants, see section 5.2.5, p. 117

use constant TON_unknown           => 0x00;
use constant TON_international     => 0x01;
use constant TON_national          => 0x02;
use constant TON_network_specific  => 0x03;
use constant TON_subscriber_number => 0x04;
use constant TON_alphanumeric      => 0x05;
use constant TON_abbreviated       => 0x06;

### Number plan indicators, sec 5.2.6, p. 118

use constant NPI_unknown     => 0x00;
use constant NPI_isdn        => 0x01;  # E163/E164
use constant NPI_data        => 0x03;  # X.121
use constant NPI_telex       => 0x04;  # F.69
use constant NPI_land_mobile => 0x06;  # E.212
use constant NPI_national    => 0x08;
use constant NPI_private     => 0x09;
use constant NPI_ERMES       => 0x0a;
use constant NPI_internet    => 0x0e;  # IP
use constant NPI_wap         => 0x12;  # WAP client id

### ESM class constants, these are additive, use or (|) to combine them (5.2.12, p.121)

use constant ESM_mode_mask    => 0x03;
use constant ESM_type_mask    => 0x3c;
use constant ESM_feature_mask => 0xc0;

use constant ESM_mode_default  => 0x00;           # usually store and forward
use constant ESM_mode_datagram => 0x01;
use constant ESM_mode_forward  => 0x02;           # i.e. transaction mode
use constant ESM_mode_store_and_forward => 0x03;  # store and forward mode (even if not default)

use constant ESM_type_default      => 0x00;       # default message type (i.e. normal message)
use constant ESM_type_delivery_receipt => 0x04;   #  SMSC Delivery receipt (SMSC->ESME only)
use constant ESM_type_delivery_ack => 0x08;       # ESME delivery acknowledgement
use constant ESM_type_0011 => 0x0a;
use constant ESM_type_user_ack     => 0x10;       # ESME manual/user acknowledgement
use constant ESM_type_0101 => 0x14;
use constant ESM_type_conversation_abort => 0x18; # Korean CDMA (SMSC->ESME only)
use constant ESM_type_0111 => 0x1a;
use constant ESM_type_intermed_deliv_notif => 0x20;  # Intermediate delivery notification (SMSC->ESME)
use constant ESM_type_1001 => 0x24;
use constant ESM_type_1010 => 0x28;
use constant ESM_type_1011 => 0x2a;
use constant ESM_type_1100 => 0x30;
use constant ESM_type_1101 => 0x34;
use constant ESM_type_1110 => 0x38;
use constant ESM_type_1111 => 0x3a;

use constant ESM_feature_none => 0x00;
use constant ESM_feature_UDHI => 0x40;  # User Data Header Ind, only relevant for MT short messages
use constant ESM_feature_reply_path => 0x80;           # only relevant for GSM networks
use constant ESM_feature_UDHI_and_reply_path => 0xc0;  # only relevant for GSM networks

### Registered delivery bits (5.2.17, p. 124)

use constant REG_receipt_mask => 0x03;
use constant REG_ack_mask => 0x0c;
use constant REG_intermed_notif_mask => 0x80;

use constant REG_receipt_none    => 0x00;
use constant REG_receipt_always  => 0x01;  # receipt is returned for both success and failure
use constant REG_receipt_on_fail => 0x02;
use constant REG_receipt_res     => 0x03;

use constant REG_ack_none => 0x00;
use constant REG_ack_delivery => 0x04;
use constant REG_ack_user => 0x08;
use constant REG_ack_delivery_and_user => 0x0c;

use constant REG_intermed_notif_none => 0x00;
use constant REG_intermed_notif => 0x10;

### submit_multi dest_flag constants (5.2.25, p. 129)

use constant MULTIDESTFLAG_SME_Address => 1;
use constant MULTIDESTFLAG_dist_list => 2;

### message_state codes returned in query_sm_resp (5.2.28, table 5-6, p. 130)

use constant MSGSTATE_enroute   => 1;
use constant MSGSTATE_delivered => 2;
use constant MSGSTATE_expired   => 3;  # message validity period has expired
use constant MSGSTATE_deleted   => 4;
use constant MSGSTATE_undeliverable => 5;
use constant MSGSTATE_accepted  => 6;  # i.e. message has been manually read on behalf of
                                       # the subscriber by customer service
use constant MSGSTATE_unknown   => 7;  # message is in invalid state
use constant MSGSTATE_rejected  => 8;

### Facility codes for V4 (used as arguments to bind, or the bits together)   #4

use constant GF_PVCY    => 0x00000001; # V4 extended p.58  Privacy  #4
use constant GF_SUBADDR => 0x00000002; # V4 extended p.64           #4
use constant NF_CC      => 0x00080000; # V4 extended p.69  Call Control  *** N.B: Spec has bug *** #4
use constant NF_PDC     => 0x00010000; # V4 extended p.74           #4
use constant NF_IS136   => 0x00020000; # V4 extended p.80  (TDMA)   #4
use constant NF_IS95A   => 0x00040000; # V4 extended p.84  (CDMA) (TIA/EIA IS-637)   #4

### Default value table that gets incorporated into smpp object unless
### overridden in the constructor

use constant Default => {

  async => 0,
  port => 2255,        # TCP port
  timeout => 5,        # Connection establishment timeout
  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

  smpp_version => 0x34,  # Supported versions are 0x34 == 3.4 #4> and 0x40 == 4.0 <4#
  head_templ => 'NNNN',  # v3.4 'NNNN', #4> v4.0 'NNNNxxxx', must change in tandem with above <4#
  head_len => 16,        # v3.4 16, #4> v4.0 20, must change in tandem with smpp_version <4#
  cmd_version => 0x00000000, # v3.4 0x00000000, #4> v4 0x00010000; to be or'd with cmd <4#

### Default values for bind parameters
### For interpretation of these parameters refer to
### sections 4.1 (p.51) and 5.2 (p. 116).

  system_id => '',     # 5.2.1, usually needs to be supplied
  password => '',      # 5.2.2
  system_type => '',   # 5.2.3, often optional, leave empty
  interface_version => 0x34,  # 5.2.4
  addr_ton => 0x00,    # 5.2.5  type of number
  addr_npi => 0x00,    # 5.2.6  numbering plan indicator
  address_range => '', # 5.2.7  regular expression matching numbers
  facilities_mask => 0x00000000, # SMPP v4.0 extension   #4

### Default values for submit_sm and deliver_sm

  service_type => '',  # NULL: SMSC defaults, #4> on v4 this is message_class <4#
  message_class => 0xffff, # v4: 0xffff = not required, 0-0x0fff = non replace,           #4
                           #     0x8000-0x8fff = replace types, others reserved (v4 p.32) #4
  source_addr_ton => 0x00, #? not known, see sec 5.2.5
  source_addr_npi => 0x00, #? not known, see sec 5.2.6
  source_addr => '',       ## NULL: not known. You should set this for reply to work.
  dest_addr_ton => 0x00,  #??
  dest_addr_npi => 0x00,  #??
  destination_addr => '', ### Destination address must be supplied
  esm_class => 0x00,      # Default mode (store and forward) and type (5.2.12, p.121)
  messaging_mode => 0x00, # v4 Default mode (store and forward) (v4, table 6-8, p.33)    #4
  msg_reference => '',    # v4, either empty or 9 digits. For user messages 4 first digits must be 0 #4
  protocol_id => 0x00,    ### 0 works for TDMA & CDMA, for GSM set according to GSM 03.40
  telematic_interworking => 0xff, # v4 name for v34 protocol_id (SMPP V4 Telematic Interworking Identifiers, sec 7.11, p.68) #4
  priority_flag => 0,     # non-priority/bulk/normal
  priority_level => 0xff, # v4: 0=lowest, 1=lowmid, 2=himid, 3=highest, 4-254 reserved, 255 default #4
  schedule_delivery_time => '',  # NULL: immediate delivery
  validity_period => '',  # NULL: SMSC default validity period
  registered_delivery => 0x00,  # no receipt, no ack, no intermed notif
  registered_delivery_mode => 0x00,  # v4: 0=no receipt, 1=receipt required, 2=nondelivery receipt confirmation  #4
  replace_if_present_flag => 0, # no replacement
  data_coding => 0,       # SMSC default alphabet
  sm_default_msg_id => 0, # Do not use canned message

### default values for query_sm_resp
  final_date => '',  # NULL: message has not yet reached final state
  error_code => 0,   # no error
  network_error_code => 0, # v4 no error?  #4
### default values for alert_notification
  esme_addr_ton => 0x00,
  esme_addr_npi => 0x00,

### default values used by cancel_sm
  message_id => '', # NULL: other parameters specify message to be cancelled

### Table of PDU handlers. These PDUs are automatically
### handled during wait_pdu() (as opposed to being discarded).
### they are called as
###        $smpp->handler($pdu);
### N.B. because the command number is constant, a comma must be used as separator
###      to prevent interpretation as string. (Thanks Matthias Meyser for pointing this out.)

  handlers => {
	CMD_enquire_link, \&handle_enquire_link,
	CMD_enquire_link_v4, \&handle_enquire_link,  #4
    },
};

### Optional parameter tags, see sec 5.3.2, Table 5-7, pp.132-133
### See also Sec 4.8.1 "TLV Tag", Table 4-60 "TLV Tag Definitions", pp. 135-137

use constant param_tab => {
    0x0005 => { name => 'dest_addr_subunit',    technology => 'GSM', },
    0x0006 => { name => 'dest_network_type',    technology => 'Generic', },
    0x0007 => { name => 'dest_bearer_type',     technology => 'Generic', },
    0x0008 => { name => 'dest_telematics_id',   technology => 'GSM', },

    0x000d => { name => 'source_addr_subunit',  technology => 'GSM', },
    0x000e => { name => 'source_network_type',  technology => 'Generic', },
    0x000f => { name => 'source_bearer_type',   technology => 'Generic', },
    0x0010 => { name => 'source_telematics_id', technology => 'GSM', },

    0x0017 => { name => 'qos_time_to_live', technology => 'Generic', },
    0x0019 => { name => 'payload_type', technology => 'Generic', },
    0x001d => { name => 'additional_status_info_text', technology => 'Generic', },
    0x001e => { name => 'receipted_message_id',   technology => 'Generic', },
    0x0030 => { name => 'ms_msg_wait_facilities', technology => 'GSM', },

    0x0101 => { name => 'PVCY_AuthenticationStr', technology => '? (J-Phone)', },  # V4ext pp.58-62  #4
    # "\x01\x00\x00"  0x010000  no privacy option

    0x0201 => { name => 'privacy_indicator',  technology => 'CDMA,TDMA', },
    0x0202 => { name => 'source_subaddress',  technology => 'CDMA,TDMA', },  # V4ext pp. 65-67  #4
    # Aka PDC_Originator_Subaddr, "\x01\x00\x00" 0x010000 undefined #4> (J-Phone) <4#
    0x0203 => { name => 'dest_subaddress',    technology => 'CDMA,TDMA', },  # V4ext pp. 65-67  #4
    # Aka PDC_Destination_Subaddr, "\x01\x00\x00" 0x010000 undefined #4> (J-Phone) <4#
    0x0204 => { name => 'user_message_reference', technology => 'Generic', },
    0x0205 => { name => 'user_response_code', technology => 'CDMA,TDMA', },
    0x020a => { name => 'source_port',        technology => 'WAP', },
    0x020b => { name => 'destination_port',   technology => 'WAP', },
    0x020c => { name => 'sar_msg_ref_num',    technology => 'Generic', },
    0x020d => { name => 'language_indicator', technology => 'CDMA,TDMA', },
    0x020e => { name => 'sar_total_segments', technology => 'Generic', },
    0x020f => { name => 'sar_segment_seqnum', technology => 'Generic', },
    0x0210 => { name => 'sc_interface_version',  technology => 'Generic', },  # bind_*_resp

    0x0301 => { name => 'CC_CBN', technology => 'V4', }, # V4ext p.70  Call Back Number  #4
    0x0302 => { name => 'callback_num_pres_ind', technology => 'TDMA', },  # V4ext p.71  CC_CBNPresentation #4
    0x0303 => { name => 'callback_num_atag',  technology => 'TDMA', },  # V4ext p.71  CC_CBNAlphaTag #4
    0x0304 => { name => 'number_of_messages', technology => 'CDMA', },  # V4ext p.72  CC_NumberOfMessages #4
    0x0381 => { name => 'callback_num', technology => 'CDMA,TDMA,GSM,iDEN', },

    0x0420 => { name => 'dpf_result',   technology => 'Generic', },
    0x0421 => { name => 'set_dpf',      technology => 'Generic', },
    0x0422 => { name => 'ms_availability_status', technology => 'Generic', },
    0x0423 => { name => 'network_error_code', technology => 'Generic', },
    0x0424 => { name => 'message_payload',    technology => 'Generic', },
    0x0425 => { name => 'delivery_failure_reason', technology => 'Generic', },
    0x0426 => { name => 'more_messages_to_send',   technology => 'GSM', },
    0x0427 => { name => 'message_state',    technology => 'Generic', },
    0x0428 => { name => 'congestion_state', technology => 'Generic', },

    0x0501 => { name => 'ussd_service_op',  technology => 'GSM (USSD)', },

    0x0600 => { name => 'broadcast_channel_indicator',  technology => 'GSM', },
    0x0601 => { name => 'broadcast_content_type',       technology => 'CDMA, TDMA, GSM', },
    0x0602 => { name => 'broadcast_content_type_info',  technology => 'CDMA, TDMA', },
    0x0603 => { name => 'broadcast_message_class',      technology => 'GSM', },
    0x0604 => { name => 'broadcast_rep_num',            technology => 'GSM', },
    0x0605 => { name => 'broadcast_frequency_interval', technology => 'CDMA, TDMA, GSM', },
    0x0606 => { name => 'broadcast_area_identifier',    technology => 'CDMA, TDMA, GSM', },
    0x0607 => { name => 'broadcast_error_status',       technology => 'CDMA, TDMA, GSM', },
    0x0608 => { name => 'broadcast_area_success',       technology => 'GSM', },
    0x0609 => { name => 'broadcast_end_time',           technology => 'CDMA, TDMA, GSM', },
    0x060a => { name => 'broadcast_service_group',      technology => 'CDMA, TDMA', },
    0x060b => { name => 'billing_identification',       technology => 'Generic', },
    0x060d => { name => 'source_network_id',            technology => 'Generic', },
    0x060e => { name => 'dest_network_id',              technology => 'Generic', },
    0x060f => { name => 'source_node_id',               technology => 'Generic', },
    0x0610 => { name => 'dest_node_id',                 technology => 'Generic', },
    0x0611 => { name => 'dest_addr_np_resolution',      technology => 'CDMA, TDMA (US Only)', },
    0x0612 => { name => 'dest_addr_np_information',     technology => 'CDMA, TDMA (US Only)', },
    0x0613 => { name => 'dest_addr_np_country',         technology => 'CDMA, TDMA (US Only)', },

    0x1201 => { name => 'display_time',     technology => 'CDMA,TDMA', },  # IS136_DisplayTime
    0x1203 => { name => 'sms_signal',       technology => 'TDMA', },
    0x1204 => { name => 'ms_validity',      technology => 'CDMA,TDMA', },

    0x1304 => { name => 'IS95A_AlertOnDelivery', technology => 'CDMA', },    # V4ext p.85  #4
    0x1306 => { name => 'IS95A_LanguageIndicator', technology => 'CDMA', },  # V4ext p.86  #4
    # "\x00"  0x00 = Unknown, 0x01 = english, 0x02 = french, 0x03 = spanish
    0x130c => { name => 'alert_on_message_delivery', technology => 'CDMA', },
    0x1380 => { name => 'its_reply_type',   technology => 'CDMA', },
    0x1383 => { name => 'its_session_info', technology => 'CDMA Korean [KORITS]', },

    # from http://docs.roottori.fi/display/MSGAPI/SMPP+commands
    # On the other hand, http://sms-clearing.com/downloads/gateway/7_SMPP.pdf
    # lists tag 0x1403 as holding both MCC and MNC in format "MCC/MNC"
    0x1402 => { name => 'operator_id', technology => 'vendor extension', },
    0x1403 => { name => 'tariff', technology => 'Mobile Network Code vendor extension', },
    # [e-mail] reports that these should be
    #0x1402 => { name => 'mBlox_operator', technology => 'Generic', },
    #0x1403 => { name => 'mBlox_rate', technology => 'Generic', },
    0x1450 => { name => 'mcc', technology => 'Mobile Country Code vendor extension', },
    0x1451 => { name => 'mnc', technology => 'Mobile Network Code vendor extension', },

    0x1101 => { name => 'PDC_MessageClass', technology => '? (J-Phone)', },  # V4ext p.75  #4
    # "\x20\x00"  0x2000   Sky Mail (service name of J-Phone SMS)  #4
    # 0x2033 - 0x20fe      Vendor defined
    # 0x1001               Coordinator (sender is able to send msg to more than two users)
    # 0x1002               Hotline (two users communicate using private line)
    # 0x1003               Relay Mail (Message relays user to user in turn by sender is specified)
    # 0x1004               Greeting service (J-Phone original) (sender can spec. deiv. date and time) #4

    0x1102 => { name => 'PDC_PresentationOption', technology => '? (J-Phone)', }, # V4ext p.76  #4
    # "\x00\xff\xff\xff" 0x00ffffff  Receiver defined option
    # "\x01\xff\xff\xff" 0x01ffffff  MS

    0x1103 => { name => 'PDC_AlertMechanism', technology => '? (J-Phone)', }, # V4ext p.76  #4
    # "\x01" 0x01  Alert tones level 1, 0x00 = no detectable alert, 0x0f = emergency, 0xff = default

    0x1104 => { name => 'PDC_Teleservice', technology => '? (J-Phone)', },    # V4 p.77  #4
    # "\x01" 0x01  Generalized message, 0x00 reserved, 0x02 two way, 0x03 concateneated

    0x1105 => { name => 'PDC_MultiPartMessage', technology => '? (J-Phone)',  # V4 p.77  #4
		format => 'nCC',  # MessageNumber, current_Sequence_Number, Maximum_Sequence_Number
               },
    #  "\0\0\0\0" 0x00000000 undefined, i.e. no multipart

    0x1106 => { name => 'PDC_PredefinedMsg', technology => '? (J-Phone)', },  # V4 p.78  #4
    # "\x00" 0x00   Undefined. This can be used to indicate preformatted messages, possibly with Kanji
    #0x0101 => { name => '', technology => '? (J-Phone)', },

    ### Tags not specified in v3.4 specification
    # *** dear reader, please add here any old or nonstandard tags
    #     that you know to exist so that this module becomes more
    #     useful
};

### invert the param_tab so we can get from name to code

for my $tag (keys %{¶m_tab}) {
    $param_by_name{param_tab->{$tag}->{name}} = $tag;
}

sub format_a_line {
    my ($tt, $prefix) = shift;
    my $t=$tt;
    $t=~tr[\x20-\x7e][]c;
#    sprintf("$prefix%04x: " . '%02x ' x length($1) . "\t$t\n", $n+=16, map {ord} split('', $1));
}

sub hexdump {
    my ($data, $prefix) = @_;
    my $n = -16;
    $data =~ s/(.{1,16})/
	sprintf("$prefix%04x: " . '%02x ' x length($1) . "\n", $n+=16, map {ord} split('', $1))/ge;
#	sprintf("$prefix%04x: " . '%02x ' x length($1) . "\t$1\n", $n+=16, map {ord} split('', $1))/ge;
#	format_a_line($1, $prefix)/gsex;
    return $data;
}

### The optional values are encoded as TLV (tag, len, value) triplets where
### tag and length are 16 bit network byteorder and value is as much as
### the length says (length does not include tag or length of the length
### field itself).

sub decode_optional_params {
    my ($pdu, $offset) = @_;
    while ($offset < length($pdu->{data})) {
	my ($tag, $len) = unpack 'nn', substr($pdu->{data}, $offset);
	my ($val) = unpack "a$len", substr($pdu->{data}, $offset+4);
	$pdu->{$tag} = $val;   # value is always accessible via numeric tag
	if (defined param_tab->{$tag}) {
	    $pdu->{param_tab->{$tag}->{name}} = $val;  # assign symbolic name
	} else {
	    warn "Unknown tag (offset $offset): $tag, len=".length($val).", val=`$val'";
	}
	$offset += 4 + length($val);
    }
}

sub encode_optional_params {
    my $data = '';
    while (@_) {  # N.B. by using array instead of hash we can control order of items
	my $opt_param = shift;
	my $val = shift;
	next if !defined $opt_param;  # skip mandatory parameters that were taken
	if ($param_by_name{$opt_param}) {
	    $data .= pack 'nna*', $param_by_name{$opt_param}, length($val), $val;
	} elsif ($opt_param =~ /^\d+$/) {  # specification by numeric tag
	    if ($val > -128 && $val < 127) {
		$data .= pack 'nnc', $opt_param, 1, $val;
	    } elsif ($val > -32768 && $val < 32767) {
		$data .= pack 'nnn!', $opt_param, 2, $val;
	    } else {
		$data .= pack 'nnN!', $opt_param, 4, $val;
	    }
	} else {
	    warn "Unknown optional parameter `$opt_param', skipping";
	}
    }
    return $data;
}

### return $_[0]->req_backend($op, &encode, @_);

sub req_backend {
    my $me = shift;
    my $op = shift;
    my $data = shift;
    my ($async, $seq);
    shift; # skip over second copy of $me

    ### Extract operational parameters that should not make part of PDU

    for (my $i=0; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	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;
    if (!defined $seq) {
	$seq = ++(${*$me}{seq});
    }

    $data .= &encode_optional_params;  # will process remaining @_

    my $header = pack(${*$me}{head_templ}, ${*$me}{head_len}+length($data),
		      $op|${*$me}{cmd_version}, 0, $seq);

    warn "req Header:\n".hexdump($header,"\t") if $trace;
    warn "req Body:\n".hexdump($data,"\t") if $trace;
    $me->syswrite($header.$data);
    return $seq if $async;

    # Synchronous operation: wait for response

    warn "req sent, waiting response" if $trace;
    return $me->wait_pdu($op | ${*$me}{cmd_version} | 0x80000000, $seq);
}

### return $_[0]->resp_backend($op, &encode, @_);

sub resp_backend {
    my $me = shift;
    my $op = shift;
    my $data = shift;
    my ($async, $seq, $status);
    shift; # skip over second copy of $me

    ### Extract operational parameters that should not make part of PDU

    for (my $i=0; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	if ($_[$i] eq 'async')  { $async = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'seq')    { $seq = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'status') { $status = splice @_,$i,2,undef,undef; }
    }
    croak "seq must be supplied" if !defined $seq;
    $status = 0 if !defined $status;

    $data .= &encode_optional_params;  # will process remaining @_

    my $header = pack(${*$me}{head_templ}, ${*$me}{head_len}+length($data),
		      $op|${*$me}{cmd_version}, $status, $seq);
    #warn "$op,$seq==>".join(':',@_);

    warn "resp Header:\n".hexdump($header, "\t") if $trace;
    warn "resp Body:\n".hexdump($data, "\t") if $trace;
    $me->syswrite($header.$data);
    return $seq;
}

### These triplets occur often enough to warrant common function

sub decode_source_addr {
    my ($pdu, $data) = @_;
    ($pdu->{source_addr_ton},   # 2  C
     $pdu->{source_addr_npi},   # 3  C
     $pdu->{source_addr}) = unpack 'CCZ*', $data;
    return 1 + 1 + length($pdu->{source_addr}) + 1;
}

sub decode_destination_addr {
    my ($pdu, $data) = @_;
    ($pdu->{dest_addr_ton},   # 2  C
     $pdu->{dest_addr_npi},   # 3  C
     $pdu->{destination_addr}) = unpack 'CCZ*', $data;
    return 1 + 1 + length($pdu->{destination_addr}) + 1;
}

sub decode_source_and_destination {
    my ($pdu, $data) = @_;
    my $len = decode_source_addr($pdu, $data);
    $len += decode_destination_addr($pdu, substr($data, $len));
    return $len;
}

### Some PDUs do not have any body (mandatory parameters)

sub decode_empty {
    #my $pdu = shift;
    return 0;
}

###
### Public API functions for emitting trivial empty PDUs
###

sub unbind { $_[0]->req_backend(CMD_unbind, '', @_) }

sub enquire_link {
    my $me = $_[0];
    return $me->req_backend(${*$me}{smpp_version}==0x40?CMD_enquire_link_v4:CMD_enquire_link, '', @_); #4
    $me->req_backend(CMD_enquire_link, '', @_);
}

sub enquire_link_resp {
    my $me = $_[0];
    return $me->resp_backend(${*$me}{smpp_version}==0x40?CMD_enquire_link_resp_v4:CMD_enquire_link_resp, '', @_); #4
    $me->resp_backend(CMD_enquire_link_resp, '', @_);
}

sub generic_nack          { $_[0]->resp_backend(CMD_generic_nack, '', @_) }
sub unbind_resp           { $_[0]->resp_backend(CMD_unbind_resp, '', @_) }
sub replace_sm_resp       { $_[0]->resp_backend(CMD_replace_sm_resp, '', @_) }
sub cancel_sm_resp        { $_[0]->resp_backend(CMD_cancel_sm_resp, '', @_) }
sub delivery_receipt_resp { $_[0]->resp_backend(CMD_delivery_receipt_resp, '', @_) }

###
### All bind operations have same PDU format (4.1.1, p.46)
###

sub decode_bind {
    my $pdu = shift;
    my $me = shift;
    ($pdu->{system_id}) = unpack 'Z*', $pdu->{data};               # 1 Z
    my $len = length($pdu->{system_id}) + 1;
    ($pdu->{password}) = unpack 'Z*', substr($pdu->{data}, $len);  # 2 Z
    $len += length($pdu->{password}) + 1;
    ($pdu->{system_type}) = unpack 'Z*', substr($pdu->{data}, $len);  # 3 Z
    $len += length($pdu->{system_type}) + 1;
    ($pdu->{interface_version}, # 4
     $pdu->{addr_ton},          # 5
     $pdu->{addr_npi},          # 6
     $pdu->{address_range}) = unpack 'CCCZ*', substr($pdu->{data}, $len);
    $len += 3 + length($pdu->{address_range}) + 1;
    if (${*$me}{smpp_version}==0x40) {                                     #4
      ($pdu->{facilities_mask}) = unpack 'N', substr($pdu->{data}, $len);  #4
      $len += 4;                                                           #4
    }                                                                      #4
    return $len;
}

sub encode_bind {
    my $me = $_[0];
    my ($system_id, $password, $system_type, $interface_version,
	$addr_ton, $addr_npi, $address_range, $facilities_mask);

    ### Extract mandatory parameters from argument stream

    for (my $i=1; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	if ($_[$i] eq 'system_id') { $system_id = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'password')  { $password = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'system_type')   { $system_type = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'interface_version') { $interface_version = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'interface_type') { $interface_version = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'addr_ton')  { $addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'addr_npi')  { $addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'address_range') { $address_range = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'facilities_mask') { $facilities_mask = splice @_,$i,2,undef,undef; }  #4
    }

    ### Apply defaults for those mandatory arguments that were not specified

    $system_id = ${*$me}{system_id} if !defined $system_id;
    $password = ${*$me}{password} if !defined $password;
    $system_type = ${*$me}{system_type} if !defined $system_type;
    $interface_version = ${*$me}{interface_version} if !defined $interface_version;
    $addr_ton = ${*$me}{addr_ton} if !defined $addr_ton;
    $addr_npi = ${*$me}{addr_npi} if !defined $addr_npi;
    $address_range = ${*$me}{address_range} if !defined $address_range;
    $facilities_mask = ${*$me}{facilities_mask} if !defined $facilities_mask;  #4

    ### N.B. v3.4 last argument, $facilities_mask, will be ignored because     #4
    ###      template misses N, v4.0 it will be used because template has N    #4
    return pack(${*$me}{smpp_version}==0x40?'Z*Z*Z*CCCZ*N':'Z*Z*Z*CCCZ*',      #4
                $system_id, $password, $system_type,                           #4
		$interface_version, $addr_ton, $addr_npi,                      #4
		$address_range, $facilities_mask);                             #4
    return pack('Z*Z*Z*CCCZ*',
                $system_id, $password, $system_type,
		$interface_version, $addr_ton, $addr_npi,
		$address_range);
}

### All bind operations have same response format (4.1.2, p.47)

sub decode_bind_resp_v34 {
    my $pdu = shift;
    my $me = shift;
    ($pdu->{system_id}) = unpack 'Z*', $pdu->{data};
    return length($pdu->{system_id}) + 1;
}

#4#cut
sub decode_bind_resp_v4 {
    my $pdu = shift;
    my $me = shift;
    ($pdu->{system_id}) = unpack 'Z*', $pdu->{data};
    my $len = length($pdu->{system_id}) + 1;
    ($pdu->{facilities_mask}) = unpack 'N', substr($pdu->{data}, $len);
    return $len + 4;
}
#4#end

sub encode_bind_resp {
    my $me = $_[0];
    my ($system_id, $facilities_mask);

    for (my $i=1; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	if ($_[$i] eq 'system_id') { $system_id = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'facilities_mask') { $facilities_mask = splice @_,$i,2,undef,undef; }  #4
    }
    $system_id = ${*$me}{system_id} if !defined $system_id;
    $facilities_mask = ${*$me}{facilities_mask} if !defined $facilities_mask;           #4
    return pack(${*$me}{smpp_version}==0x40?'Z*N':'Z*', $system_id, $facilities_mask);  #4
    return pack('Z*', $system_id);
}

###
### Public API functions to emit binds and bind_resps.
###

sub bind_transceiver { $_[0]->req_backend(CMD_bind_transceiver, &encode_bind, @_) }
sub bind_transmitter { $_[0]->req_backend(CMD_bind_transmitter, &encode_bind, @_) }
sub bind_receiver    { $_[0]->req_backend(CMD_bind_receiver,    &encode_bind, @_) }

sub bind_transceiver_resp { $_[0]->resp_backend(CMD_bind_transceiver_resp, &encode_bind_resp, @_) }
sub bind_transmitter_resp { $_[0]->resp_backend(CMD_bind_transmitter_resp, &encode_bind_resp, @_) }
sub bind_receiver_resp    { $_[0]->resp_backend(CMD_bind_receiver_resp,    &encode_bind_resp, @_) }

### outbind (4.1.7.1)

sub decode_outbind_v34 {
    my $pdu = shift;
    my $me = shift;
    ($pdu->{system_id}) = unpack 'Z*', $pdu->{data};
    my $len = length($pdu->{system_id}) + 1;
    ($pdu->{password}) = unpack 'Z*', substr($pdu->{data}, $len);
    return $len + length($pdu->{password}) + 1;
}

#4#cut
sub decode_outbind_v4 {
    my $pdu = shift;
    my $me = shift;
    ($pdu->{password}) = unpack 'Z*', $pdu->{data};
    return length($pdu->{password}) + 1;
}
#4#end

sub encode_outbind {
    my $me = $_[0];
    my ($system_id, $password);

    for (my $i=1; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	if ($_[$i] eq 'system_id') { $system_id = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'password')  { $password = splice @_,$i,2,undef,undef; }
    }

    $system_id = ${*$me}{system_id} if !defined $system_id;
    $password = ${*$me}{password} if !defined $password;
    ### N.B. v4 does not have system_id. "CX" construct skips over this parameter   #4
    return pack(${*$me}{smpp_version}==0x40?'CXZ*':'Z*Z*', $system_id, $password);  #4
    return pack('Z*Z*', $system_id, $password);
}

sub outbind {
    my $me = $_[0];
    push @_, seq => ++(${*$me}{seq}) unless grep $_ eq 'seq', @_;
    return $me->resp_backend(CMD_outbind, &encode_outbind, @_);
}

### outbind does not have response

### submit (4.4.1), deliver (4.6.1) (both use same PDU format), p.59

sub decode_submit_v34 {
    my $pdu = shift;
    ($pdu->{service_type}) = unpack 'Z*', $pdu->{data};
    my $len = length($pdu->{service_type}) + 1;
    $len += decode_source_and_destination($pdu, substr($pdu->{data}, $len));

    ($pdu->{esm_class},         # 8
     $pdu->{protocol_id},       # 9
     $pdu->{priority_flag},     # 10
     $pdu->{schedule_delivery_time}) = unpack 'CCCZ*', substr($pdu->{data}, $len);
    $len += 1 + 1 + 1 + length($pdu->{schedule_delivery_time}) + 1;

    ($pdu->{validity_period}) = unpack 'Z*', substr($pdu->{data}, $len);
    $len += length($pdu->{validity_period}) + 1;

    my $sm_length;
    ($pdu->{registered_delivery}, # 13
     $pdu->{replace_if_present_flag}, # 14
     $pdu->{data_coding},       # 15
     $pdu->{sm_default_msg_id}, # 16
     $sm_length,                # 17
#                         1
#                12345678901234567 8
     ) = unpack 'CCCCC', substr($pdu->{data}, $len);
    $len += 1 + 1 + 1 + 1 + 1;
    ($pdu->{short_message}      # 18
     ) = unpack "a$sm_length", substr($pdu->{data}, $len);
    return $len + $sm_length;
}

sub encode_submit_v34 {
    my $me = $_[0];
    my ($service_type, $source_addr_ton, $source_addr_npi, $source_addr,
	$dest_addr_ton, $dest_addr_npi, $destination_addr,
	$esm_class, $protocol_id, $priority_flag,
	$schedule_delivery_time, $validity_period,
	$registered_delivery, $replace_if_present_flag, $data_coding,
	$sm_default_msg_id, $short_message);

    ### Extract mandatory parameters from argument stream

    for (my $i=1; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	if ($_[$i] eq 'service_type') { $service_type = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr_ton')  { $source_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr_npi')  { $source_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr')      { $source_addr = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'dest_addr_ton')    { $dest_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'dest_addr_npi')    { $dest_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'destination_addr') { $destination_addr = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'esm_class')     { $esm_class = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'protocol_id')   { $protocol_id = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'priority_flag') { $priority_flag = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'schedule_delivery_time') { $schedule_delivery_time = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'validity_period') { $validity_period = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'registered_delivery') { $registered_delivery = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'replace_if_present_flag') { $replace_if_present_flag = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'data_coding') { $data_coding = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'sm_default_msg_id') { $sm_default_msg_id = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'short_message') { $short_message = splice @_,$i,2,undef,undef; }
    }

    ### Apply defaults for those mandatory arguments that were not specified

    $service_type = ${*$me}{service_type} if !defined $service_type;
    $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton;
    $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi;
    $source_addr = ${*$me}{source_addr} if !defined $source_addr;
    $dest_addr_ton = ${*$me}{dest_addr_ton} if !defined $dest_addr_ton;
    $dest_addr_npi = ${*$me}{dest_addr_npi} if !defined $dest_addr_npi;
    croak "Must supply destination_addr to submit_sm or deliver_sm" if !defined $destination_addr;
    $esm_class = ${*$me}{esm_class} if !defined $esm_class;
    $protocol_id = ${*$me}{protocol_id} if !defined $protocol_id;
    $priority_flag = ${*$me}{priority_flag} if !defined $priority_flag;
    $schedule_delivery_time = ${*$me}{schedule_delivery_time} if !defined $schedule_delivery_time;
    $validity_period = ${*$me}{validity_period} if !defined $validity_period;
    $registered_delivery = ${*$me}{registered_delivery} if !defined $registered_delivery;
    $replace_if_present_flag = ${*$me}{replace_if_present_flag} if !defined $replace_if_present_flag;
    $data_coding = ${*$me}{data_coding} if !defined $data_coding;
    $sm_default_msg_id = ${*$me}{sm_default_msg_id} if !defined $sm_default_msg_id;
    $short_message = '' if !defined $short_message;

    return pack('Z*CCZ*CCZ*CCCZ*Z*CCCCCa*',
		$service_type, $source_addr_ton, $source_addr_npi, $source_addr,
		$dest_addr_ton, $dest_addr_npi, $destination_addr,
		$esm_class, $protocol_id, $priority_flag,
		$schedule_delivery_time, $validity_period,
		$registered_delivery, $replace_if_present_flag, $data_coding,
		$sm_default_msg_id, length($short_message), $short_message, );
}

#4#cut
### submit_sm_v4 (6.4.4.1), v4 p.32

sub decode_submit_v4 {
    my $pdu = shift;
    ($pdu->{message_class},     # 1 (2)
     $pdu->{source_addr_ton},   # 2 (1)
     $pdu->{source_addr_npi},   # 3 (1)
     $pdu->{source_addr},       # 4 (n+1)
     ) = unpack 'nCCZ*', $pdu->{data};
    my $len = 2	+ 1 + 1 + length($pdu->{source_addr}) + 1;

    ($pdu->{number_of_dests}) = unpack 'N', substr($pdu->{data}, $len);
    $len += 4;
    #warn "a decode_submit $len ($pdu->{number_of_dests}): ".hexdump(substr($pdu->{data}, $len));

    ### Walk down the variable length destination address list

    for (my $i = 0; $i < $pdu->{number_of_dests}; $i++) {
	($pdu->{dest_addr_ton}[$i],     # SME ton (v4 table 6-9, p. 36)
	 $pdu->{dest_addr_npi}[$i],     # SME npi
	 $pdu->{destination_addr}[$i])  # SME address
	    = unpack 'CCZ*', substr($pdu->{data}, $len);
	$len += 1 + 1 + length($pdu->{destination_addr}[$i]) + 1;
	#warn "b decode_submit $len: ".hexdump(substr($pdu->{data}, $len));
    }

    ### Now that we skipped over the variable length destinations
    ### we are ready to decode the rest of the packet.

    ($pdu->{messaging_mode},         # 7  C
     $pdu->{msg_reference}) = unpack 'CZ*', substr($pdu->{data}, $len);
    $len += 1 + length($pdu->{msg_reference}) + 1;
    #warn "c decode_submit $len: ".hexdump(substr($pdu->{data}, $len));

    ($pdu->{telematic_interworking}, # 9  C
     $pdu->{priority_level},         # 10 C
     $pdu->{schedule_delivery_time}) = unpack 'CCZ*', substr($pdu->{data}, $len);
    $len += 1 + 1 + length($pdu->{schedule_delivery_time}) + 1;
    warn "d decode_submit $len: ".hexdump(substr($pdu->{data}, $len)) if $trace;

    my $sm_length;
    ($pdu->{validity_period},        # 12 n  v4: n.b. this is now short instead of Cstr
     $pdu->{registered_delivery},    # 13 C
     $pdu->{data_coding},            # 14 C
     $pdu->{sm_default_msg_id},      # 15 C
     $sm_length,                     # 16 n

#                   1
#                7890123456 7
     ) = unpack 'nCCCn', substr($pdu->{data}, $len);
    $len += 2 + 1 + 1 + 1 + 2;
    ($pdu->{short_message}           # 17 a
     ) = unpack "a$sm_length", substr($pdu->{data}, $len);
    $len += $sm_length;
    warn "e decode_submit ($pdu->{short_message}) $len: ".hexdump(substr($pdu->{data}, $len)) if $trace;

    $pdu->{service_type} = $pdu->{message_class};   # compat v34
    $pdu->{esm_class} = $pdu->{messaging_mode};     # compat v34
    $pdu->{protocol_id} = $pdu->{telematic_interworking}; # compat v34
    $pdu->{priority_flag} = $pdu->{priority_level}; # compat v34

    return $len;
}

sub encode_submit_v4 {
    my $me = $_[0];
    my ($message_class, $source_addr_ton, $source_addr_npi, $source_addr,
	@dest_addr_ton, @dest_addr_npi, @destination_addr,
	$messaging_mode, $msg_reference, $telematic_interworking, $priority_level,
	$schedule_delivery_time, $validity_period,
	$registered_delivery_mode, $data_coding,
	$sm_default_msg_id, $short_message, $addr_data);

    ### Extract mandatory parameters from argument stream

    for (my $i=1; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	#warn "iter $i: >$_[$i]<";
	if ($_[$i] eq 'message_class')   { $message_class = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'service_type')    { $message_class = splice @_,$i,2,undef,undef; } # v34
	elsif ($_[$i] eq 'source_addr_ton') { $source_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr_npi') { $source_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr')     { $source_addr = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'dest_addr_ton')   {
	    @dest_addr_ton = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)}
	                                   : (scalar(splice @_,$i,2,undef,undef));
	}
	elsif ($_[$i] eq 'dest_addr_npi')   {
	    @dest_addr_npi = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)}
	                                   : (scalar(splice @_,$i,2,undef,undef));
	}
	elsif ($_[$i] eq 'destination_addr') {
	    @destination_addr = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)}
	                                      : (scalar(splice @_,$i,2,undef,undef));
	}
	elsif ($_[$i] eq 'messaging_mode') { $messaging_mode = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'esm_class')      { $messaging_mode = splice @_,$i,2,undef,undef; } # v34
	elsif ($_[$i] eq 'msg_reference')  { $msg_reference = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'telematic_interworking') { $telematic_interworking = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'protocol_id') { $telematic_interworking = splice @_,$i,2,undef,undef; } # v34
	elsif ($_[$i] eq 'priority_level') { $priority_level = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'priority_flag')  { $priority_level = splice @_,$i,2,undef,undef; } # v34
	elsif ($_[$i] eq 'schedule_delivery_time') { $schedule_delivery_time = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'validity_period') { $validity_period = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'registered_delivery_mode') { $registered_delivery_mode = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'registered_delivery') { $registered_delivery_mode = splice @_,$i,2,undef,undef; } # v34
	elsif ($_[$i] eq 'data_coding') { $data_coding = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'sm_default_msg_id') { $sm_default_msg_id = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'short_message') { $short_message = splice @_,$i,2,undef,undef; }

	### Following kludge was added by Felix as PTF when integrating.
	### Basically this should be handled correctly by the generic
	### optional parameter code but didn't work right for Felix at the
	### time. Lets hope this is fixed now. --Sampo
	#elsif ($_[$i] eq 'PDC_MultiPartMessage') { my $tmp_mpm = splice @_,$i,2, undef,undef;
	#					    $pdc_multipartmessage = pack("CCCC",
	#                                                                        0x11, 0x05, 0x00, 0x04)
        #                                                 . $tmp_mpm
	#					       unless (length ($tmp_mpm) != 4);
	#				       }

    }

    ### Apply defaults for those mandatory arguments that were not specified

    $message_class = ${*$me}{message_class} if !defined $message_class;
    $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton;
    $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi;
    $source_addr = ${*$me}{source_addr} if !defined $source_addr;

    croak "Must supply destination_addr to submit_sm v4" if !@destination_addr;

    $messaging_mode = ${*$me}{messaging_mode} if !defined $messaging_mode;
    $msg_reference = ${*$me}{msg_reference} if !defined $msg_reference;
    $telematic_interworking = ${*$me}{telematic_interworking} if !defined $telematic_interworking;
    $priority_level = ${*$me}{priority_level} if !defined $priority_level;
    $schedule_delivery_time = ${*$me}{schedule_delivery_time} if !defined $schedule_delivery_time;
    $validity_period = ${*$me}{validity_period} if !defined $validity_period;
    $registered_delivery_mode = ${*$me}{registered_delivery_mode} if !defined $registered_delivery_mode;
    $data_coding = ${*$me}{data_coding} if !defined $data_coding;
    $sm_default_msg_id = ${*$me}{sm_default_msg_id} if !defined $sm_default_msg_id;
    $short_message = '' if !defined $short_message;

    ### destination address encoding is pretty messy with variable
    ### number of variable length records.

    for (my $i = 0; $i <= $#destination_addr; $i++) {
	my $ton = !defined($dest_addr_ton[$i]) ? ${*$me}{dest_addr_ton} : $dest_addr_ton[$i];
	my $npi = !defined($dest_addr_npi[$i]) ? ${*$me}{dest_addr_npi} : $dest_addr_npi[$i];
	$addr_data .= pack 'CCZ*', $ton, $npi, $destination_addr[$i];
    }

    return pack('nCCZ*N',
		$message_class, $source_addr_ton, $source_addr_npi, $source_addr,
		scalar(@destination_addr)) . $addr_data
		    . pack('CZ*CCZ*nCCCna*',
			   $messaging_mode, $msg_reference, $telematic_interworking,
			   $priority_level, $schedule_delivery_time, $validity_period,
			   $registered_delivery_mode, $data_coding,
			   $sm_default_msg_id, length($short_message), $short_message, )
    # . $pdc_multipartmessage  # *** Felix
    ;
}

### v4 submit_sm response encoding and decoding is equal to submit_multi_resp v3.4
#4#end

sub submit_sm {
    my $me = $_[0];
    return $me->req_backend(CMD_submit_sm,                            #4
			    (${*$me}{smpp_version} == 0x40)           #4
	                    ? &encode_submit_v4 : &encode_submit_v34, #4
	                    @_);                                      #4
    return $me->req_backend(CMD_submit_sm, &encode_submit_v34, @_);
}

#4#cut
### deliver_sm_v4 (v4 6.4.5.1), p.38
### N.B v34 deliver is decoded as v34 submit

sub decode_deliver_sm_v4 {
    my $pdu = shift;
    my $len = decode_source_and_destination($pdu, $pdu->{data});

    ### *** WARNING: if this section of code bombs you should
    ###     check carefully that Z9 and Z17 are working correctly.
    ###     Although the spec says that these are fixed length, one
    ###     should not blindly take this for granted. If fixed length
    ###     interpreatation is chosen then the $len has to be updated
    ###     by the fixed length irrespective of what the C string
    ###     length is. If however the variable length interpretation
    ###     is chosen then Z* should be used to decode and C string
    ###     length should be used to update the length. Using Z9 to
    ###     decode but C string length to update $len is inconsistent
    ###     although I believe it amounts to the variable length
    ###     interpretation in the end. --Sampo

    ($pdu->{msg_reference}) = unpack 'Z9', substr($pdu->{data}, $len);   # Felix: its always fixed len
    $len += 9;
    #($pdu->{msg_reference}) = unpack 'Z*', substr($pdu->{data}, $len);
    #$len += length($pdu->{msg_reference}) + 1;

    ($pdu->{message_class},     # 8  n
     $pdu->{telematic_interworking},  # 9  C
     $pdu->{priority_level},          # 10 C
     $pdu->{submit_time_stamp}) = unpack 'nCCZ17', substr($pdu->{data}, $len);  # Felix: fixed len
    $len += 2 + 1 + 1 + 17;
    # $pdu->{submit_time_stamp}) = unpack 'nCCZ*', substr($pdu->{data}, $len);
    #$len += 2 + 1 + 1 + length($pdu->{submit_time_stamp}) + 1;

    my $sm_length;
    ($pdu->{data_coding},       # 15 C
     $sm_length,                # 17 n
     ) = unpack 'Cn', substr($pdu->{data}, $len);
    $len += 1 + 2;
    ($pdu->{short_message}
     ) = unpack "a$sm_length", substr($pdu->{data}, $len);
    $len += $sm_length;

    $pdu->{esm_class} = $pdu->{message_class};
    $pdu->{protocol_id} = $pdu->{telematic_interworking};
    $pdu->{priority_flag} = $pdu->{priority_level};
    $pdu->{schedule_delivery_time} = $pdu->{submit_time_stamp};

    return $len;
}

sub encode_deliver_sm_v4 {
    my $me = $_[0];
    my ($source_addr_ton, $source_addr_npi, $source_addr,
	$dest_addr_ton, $dest_addr_npi, $destination_addr,
	$msg_reference, $message_class, $telematic_interworking, $priority_level,
	$schedule_delivery_time, $data_coding, $short_message);

    ### Extract mandatory parameters from argument stream

    for (my $i=1; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	if ($_[$i] eq 'source_addr_ton')  { $source_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr_npi')  { $source_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr')      { $source_addr = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'dest_addr_ton')    { $dest_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'dest_addr_npi')    { $dest_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'destination_addr') { $destination_addr = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'msg_reference')    { $msg_reference = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'message_class')    { $message_class = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'esm_class')        { $message_class = splice @_,$i,2,undef,undef; }  # v34
	elsif ($_[$i] eq 'telematic_interworking')   { $telematic_interworking = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'protocol_id')    { $telematic_interworking = splice @_,$i,2,undef,undef; } # v34
	elsif ($_[$i] eq 'priority_level') { $priority_level = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'priority_flag')  { $priority_level = splice @_,$i,2,undef,undef; } # v34
	elsif ($_[$i] eq 'schedule_delivery_time') { $schedule_delivery_time = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'data_coding')    { $data_coding = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'short_message')  { $short_message = splice @_,$i,2,undef,undef; }
    }

    ### Apply defaults for those mandatory arguments that were not specified

    $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton;
    $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi;
    $source_addr = ${*$me}{source_addr} if !defined $source_addr;
    $dest_addr_ton = ${*$me}{dest_addr_ton} if !defined $dest_addr_ton;
    $dest_addr_npi = ${*$me}{dest_addr_npi} if !defined $dest_addr_npi;
    die "Must supply destination_addr to deliver_sm v4" if !defined $destination_addr;
    $msg_reference = ${*$me}{msg_reference} if !defined $msg_reference;
    $message_class = ${*$me}{message_class} if !defined $message_class;
    $telematic_interworking = ${*$me}{telematic_interworking} if !defined $telematic_interworking;
    $priority_level = ${*$me}{priority_level} if !defined $priority_level;
    $schedule_delivery_time = ${*$me}{schedule_delivery_time} if !defined $schedule_delivery_time;
    $data_coding = ${*$me}{data_coding} if !defined $data_coding;
    $short_message = '' if !defined $short_message;

    return pack('CCZ*CCZ*Z*nCCZ*Cna*',
		$source_addr_ton, $source_addr_npi, $source_addr,
		$dest_addr_ton, $dest_addr_npi, $destination_addr,
		$msg_reference, $message_class, $telematic_interworking, $priority_level,
		$schedule_delivery_time, $data_coding, length($short_message),$short_message, );
}
#4#end

sub deliver_sm {
    my $me = $_[0];
    # N.B. deliver_sm v34 == submit_sm v34
    return $me->req_backend(CMD_deliver_sm,                             #4
			    (${*$me}{smpp_version} == 0x40)             #4
			    ? &encode_deliver_sm_v4 : &encode_submit_v34,  #4
			    @_);                                        #4
    return $me->req_backend(CMD_deliver_sm, &encode_submit_v34, @_);
}

###

sub decode_submit_resp_v34 {
    my $pdu = shift;
    ($pdu->{message_id}) = unpack 'Z*', $pdu->{data};
    return length($pdu->{message_id}) + 1;
}

sub encode_submit_resp_v34 {
    my $me = $_[0];
    my ($message_id);

    for (my $i=1; $i <= $#_; $i+=2) {
	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);
}

sub submit_sm_resp {
    my $me = $_[0];

    # N.B. submit_sm_resp v4 == submit_multi_resp v34   #4
    #      data_sm_resp v34 == submit_sm_resp v34
    return $me->resp_backend(CMD_submit_sm_resp,              #4
			     (${*$me}{smpp_version} == 0x40)  #4
				 ? &encode_submit_sm_resp_v4  #4
				 : &encode_submit_resp_v34,   #4
				 @_);                         #4
    return $me->resp_backend(CMD_submit_sm_resp, &encode_submit_resp_v34, @_);
}
sub data_sm_resp    { $_[0]->resp_backend(CMD_data_sm_resp, &encode_submit_resp_v34, @_) } # pubAPI

sub deliver_sm_resp {  # public API
    my $me = $_[0];
    # N.B. submit_sm_resp v34 == deliver_sm_resp v34
    return $me->resp_backend(CMD_deliver_sm_resp,                                #4
			     (${*$me}{smpp_version} == 0x40)                     #4
			     ? ''  # v4 deliver_resp is empty v4 6.4.5.2, p.40   #4
			     : &encode_submit_resp_v34,                          #4
			     @_);                                                #4
    return $me->resp_backend(CMD_deliver_sm_resp, &encode_submit_resp_v34, @_);
}

### submit_multi (4.5.1), p.59

sub decode_submit_multi {
    my $pdu = shift;
    ($pdu->{service_type}) = unpack 'Z*', $pdu->{data};
    my $len = length($pdu->{service_type}) + 1;

    $len += decode_source_addr($pdu, substr($pdu->{data}, $len));

    ($pdu->{number_of_dests}) = unpack 'C', substr($pdu->{data}, $len);
    $len += 1;

    ### To make life difficult, the multi destination addresses
    ### are a hotch potch of variable length, variable type
    ### records. Only way to do it is to walk the list.

    for (my $i = 0; $i < $pdu->{number_of_dests}; $i++) {
	($pdu->{dest_flag}[$i]) = unpack 'C', substr($pdu->{data}, $len++);
	if ($pdu->{dest_flag}[$i] == MULTIDESTFLAG_SME_Address) {
	    ($pdu->{dest_addr_ton}[$i],
	     $pdu->{dest_addr_npi}[$i],
	     $pdu->{destination_addr}[$i])
		= unpack 'CCZ*', substr($pdu->{data}, $len);
	    $len += 1 + 1 + length($pdu->{destination_addr}[$i]) + 1;
	} elsif ($pdu->{dest_flag}[$i] == MULTIDESTFLAG_dist_list) {
	    $pdu->{dest_addr_ton}[$i] = 0;
	    $pdu->{dest_addr_npi}[$i] = 0;
	    ($pdu->{destination_addr}[$i])
		= unpack 'Z*', substr($pdu->{data}, $len);
	    $len += length($pdu->{destination_addr}[$i]) + 1;
	} else {
	    warn "Unknown multidest flag: $pdu->{dest_flag} (4.5.1.1, p. 75)";
	}
    }

    ### Now that we skipped over the variable length destinations
    ### we are ready to decode the rest of the packet.

    ($pdu->{esm_class},         # 8
     $pdu->{protocol_id},       # 9
     $pdu->{priority_flag},     # 10
     $pdu->{schedule_delivery_time}) = unpack 'CCCZ*', substr($pdu->{data}, $len);
    $len += 1 + 1 + 1 + length($pdu->{schedule_delivery_time}) + 1;

    ($pdu->{validity_period}) = unpack 'Z*', substr($pdu->{data}, $len);
    $len += length($pdu->{validity_period}) + 1;

    my $sm_length;
    ($pdu->{registered_delivery}, # 13
     $pdu->{replace_if_present_flag}, # 14
     $pdu->{data_coding},       # 15
     $pdu->{sm_default_msg_id}, # 16
     $sm_length,                # 17
#                  1
#                8901234567 8
     ) = unpack 'CCCCC', substr($pdu->{data}, $len);
    $len += 1 + 1 + 1 + 1 + 1;
    ($pdu->{short_message}      # 18
     ) = unpack "a$sm_length", substr($pdu->{data}, $len);

    return $len + $sm_length;
}

sub encode_submit_multi {
    my $me = $_[0];
    my ($service_type, $source_addr_ton, $source_addr_npi, $source_addr,
	@dest_flag, @dest_addr_ton, @dest_addr_npi, @destination_addr,
	$esm_class, $protocol_id, $priority_flag,
	$schedule_delivery_time, $validity_period,
	$registered_delivery, $replace_if_present_flag, $data_coding,
	$sm_default_msg_id, $short_message, $addr_data);

    ### Extract mandatory parameters from argument stream

    for (my $i=1; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	if ($_[$i] eq 'service_type') { $service_type = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr_ton') { $source_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr_npi') { $source_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr')     { $source_addr = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'dest_flag')       {
	    @dest_flag = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)}
	                               : (scalar(splice @_,$i,2,undef,undef));
	}
	elsif ($_[$i] eq 'dest_addr_ton')   {
	    @dest_addr_ton = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)}
	                                   : (scalar(splice @_,$i,2,undef,undef));
	}
	elsif ($_[$i] eq 'dest_addr_npi')   {
	    @dest_addr_npi = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)}
	                                   : (scalar(splice @_,$i,2,undef,undef));
	}
	elsif ($_[$i] eq 'destination_addr') {
	    @destination_addr = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)}
	                                      : (scalar(splice @_,$i,2,undef,undef));
	}
	elsif ($_[$i] eq 'esm_class')     { $esm_class = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'protocol_id')   { $protocol_id = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'priority_flag') { $priority_flag = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'schedule_delivery_time') { $schedule_delivery_time = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'validity_period') { $validity_period = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'registered_delivery') { $registered_delivery = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'replace_if_present_flag') { $replace_if_present_flag = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'data_coding') { $data_coding = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'sm_default_msg_id') { $sm_default_msg_id = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'short_message') { $short_message = splice @_,$i,2,undef,undef; }
    }

    ### Apply defaults for those mandatory arguments that were not specified

    $service_type = ${*$me}{service_type} if !defined $service_type;
    $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton;
    $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi;
    $source_addr = ${*$me}{source_addr} if !defined $source_addr;
    croak "Must supply destination_addr to submit_multi" if !@destination_addr;
    $esm_class = ${*$me}{esm_class} if !defined $esm_class;
    $protocol_id = ${*$me}{protocol_id} if !defined $protocol_id;
    $priority_flag = ${*$me}{priority_flag} if !defined $priority_flag;
    $schedule_delivery_time = ${*$me}{schedule_delivery_time} if !defined $schedule_delivery_time;
    $validity_period = ${*$me}{validity_period} if !defined $validity_period;
    $registered_delivery = ${*$me}{registered_delivery} if !defined $registered_delivery;
    $replace_if_present_flag = ${*$me}{replace_if_present_flag} if !defined $replace_if_present_flag;
    $data_coding = ${*$me}{data_coding} if !defined $data_coding;
    $sm_default_msg_id = ${*$me}{sm_default_msg_id} if !defined $sm_default_msg_id;
    $short_message = '' if !defined $short_message;

    ### destination address encoding is pretty messy with variable
    ### number of variable length variable type records.

    for (my $i = 0; $i <= $#destination_addr; $i++) {
	if (!defined($dest_flag[$i])
	    || $dest_flag[$i] == MULTIDESTFLAG_SME_Address) {
	    my $ton = !defined($dest_addr_ton[$i]) ? ${*$me}{dest_addr_ton} : $dest_addr_ton[$i];
	    my $npi = !defined($dest_addr_npi[$i]) ? ${*$me}{dest_addr_npi} : $dest_addr_npi[$i];
	    $addr_data .= pack 'CCCZ*', MULTIDESTFLAG_SME_Address, $ton, $npi, $destination_addr[$i];
	} elsif ($dest_flag[$i] == MULTIDESTFLAG_dist_list) {
	    $addr_data .= pack 'CZ*', MULTIDESTFLAG_dist_list, $destination_addr[$i];
	} else {
	    warn "Unknown dest_flag: $dest_flag[$i] (4.5.1, p. 70)";
	}
    }

    return pack('Z*CCZ*C',
		$service_type, $source_addr_ton, $source_addr_npi, $source_addr,
		scalar(@destination_addr)) . $addr_data
		    . pack('CCCZ*Z*CCCCCa*',
			   $esm_class, $protocol_id, $priority_flag,
			   $schedule_delivery_time, $validity_period,
			   $registered_delivery, $replace_if_present_flag, $data_coding,
			   $sm_default_msg_id, length($short_message), $short_message, );
}

sub submit_multi { $_[0]->req_backend(CMD_submit_multi, &encode_submit_multi, @_) } # public API

#4#cut

sub decode_submit_sm_resp_v4 {
    my $pdu = shift;
    ($pdu->{message_id}) = unpack 'Z*', $pdu->{data};
    my $len = length($pdu->{message_id}) + 1;
    ($pdu->{no_unsuccess}) = unpack 'n', substr($pdu->{data}, $len);
    $pdu->{num_unsuccess} = $pdu->{no_unsuccess};  # Compat
    $len += 2;

    ### process the unsuccess_sme(s) field into meaningful arrays

    for (my $i = 0; $i < $pdu->{no_unsuccess}; $i++) {
	($pdu->{dest_addr_ton}[$i], $pdu->{dest_addr_npi}[$i],
	 $pdu->{destination_addr}[$i]) = unpack 'CCZ*', substr($pdu->{data}, $len);
	$len += 1 + 1 + length($pdu->{destination_addr}[$i]) + 1;
	($pdu->{error_status_code}[$i]) = unpack 'N', substr($pdu->{data}, $len);
	$len += 4;
    }

    return $len;
}
#4#end

sub decode_submit_multi_resp {
    my $pdu = shift;
    ($pdu->{message_id}) = unpack 'Z*', $pdu->{data};
    my $len = length($pdu->{message_id}) + 1;
    ($pdu->{no_unsuccess}) = unpack 'C', substr($pdu->{data}, $len);
    $pdu->{num_unsuccess} = $pdu->{no_unsuccess};  # Compat
    $len += 1;

    ### process the unsuccess_sme(s) field into meaningful arrays

    for (my $i = 0; $i < $pdu->{no_unsuccess}; $i++) {
	($pdu->{dest_addr_ton}[$i], $pdu->{dest_addr_npi}[$i],
	 $pdu->{destination_addr}[$i]) = unpack 'CCZ*', substr($pdu->{data}, $len);
	$len += 1 + 1 + length($pdu->{destination_addr}[$i]) + 1;
	($pdu->{error_status_code}[$i]) = unpack 'N', substr($pdu->{data}, $len);
	$len += 4;
    }

    return $len;
}

sub encode_submit_multi_resp {
    my $me = $_[0];
    my ($message_id, @dest_addr_ton, @dest_addr_npi, @destination_addr,
	@error_status_code, $addr_data);

    for (my $i=1; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	if ($_[$i] eq 'message_id') { $message_id = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'dest_addr_ton')   {
	    @dest_addr_ton = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)}
	                                   : (scalar(splice @_,$i,2,undef,undef));
	}
	elsif ($_[$i] eq 'dest_addr_npi')   {
	    @dest_addr_npi = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)}
	                                   : (scalar(splice @_,$i,2,undef,undef));
	}
	elsif ($_[$i] eq 'destination_addr') {
	    @destination_addr = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)}
	                                      : (scalar(splice @_,$i,2,undef,undef));
	}
	elsif ($_[$i] eq 'error_status_code') {
	    @error_status_code = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)}
	                                       : (scalar(splice @_,$i,2,undef,undef));
	}
    }

    croak "message_id must be supplied" if !defined $message_id;
    #croak "destination_addr must be supplied" if !@destination_addr;
    croak "error_status_code must be supplied" if !@error_status_code;

    for (my $i = 0; $i <= $#destination_addr; $i++) {
	my $ton = !defined($dest_addr_ton[$i]) ? ${*$me}{dest_addr_ton} : $dest_addr_ton[$i];
	my $npi = !defined($dest_addr_npi[$i]) ? ${*$me}{dest_addr_npi} : $dest_addr_npi[$i];
	$addr_data .= pack 'CCZ*N', $ton, $npi, $destination_addr[$i], $error_status_code[$i];
    }

    return pack('Z*C', $message_id, scalar(@destination_addr)) . $addr_data;
}

#4#cut
sub encode_submit_sm_resp_v4 {
    my $me = $_[0];
    my ($message_id, @dest_addr_ton, @dest_addr_npi, @destination_addr,
	@error_status_code);
    my $addr_data = '';  # May be empty if all addresses were successful

    for (my $i=1; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	if ($_[$i] eq 'message_id') { $message_id = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'sc_msg_reference') { $message_id = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'dest_addr_ton')   {
	    @dest_addr_ton = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)}
	                                   : (scalar(splice @_,$i,2,undef,undef));
	}
	elsif ($_[$i] eq 'dest_addr_npi')   {
	    @dest_addr_npi = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)}
	                                   : (scalar(splice @_,$i,2,undef,undef));
	}
	elsif ($_[$i] eq 'destination_addr') {
	    @destination_addr = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)}
	                                      : (scalar(splice @_,$i,2,undef,undef));
	}
	elsif ($_[$i] eq 'error_status_code') {
	    @error_status_code = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)}
	                                       : (scalar(splice @_,$i,2,undef,undef));
	}
    }

    croak "message_id must be supplied" if !defined $message_id;
    #croak "destination_addr must be supplied" if !@destination_addr;
    croak "error_status_code must be supplied" if !@error_status_code;

    for (my $i = 0; $i <= $#destination_addr; $i++) {
	my $ton = !defined($dest_addr_ton[$i]) ? ${*$me}{dest_addr_ton} : $dest_addr_ton[$i];
	my $npi = !defined($dest_addr_npi[$i]) ? ${*$me}{dest_addr_npi} : $dest_addr_npi[$i];
	$addr_data .= pack 'CCZ*N', $ton, $npi, $destination_addr[$i], $error_status_code[$i];
    }

    return pack('Z*n', $message_id, scalar(@destination_addr)) . $addr_data;
}
#4#end

sub submit_multi_resp { $_[0]->resp_backend(CMD_submit_multi_resp, &encode_submit_multi_resp, @_) }

### query (4.8.1), p.95

sub decode_query_v34 {
    my $pdu = shift;
    ($pdu->{message_id}) = unpack 'Z*', $pdu->{data};
    my $len = length($pdu->{message_id}) + 1;
    $len += decode_source_addr($pdu, substr($pdu->{data}, $len));
    return $len;
}

#4#cut
sub decode_query_v4 {
    my $pdu = shift;
    ($pdu->{message_id}) = unpack 'Z*', $pdu->{data};
    my $len = length($pdu->{message_id}) + 1;
    $len += decode_source_and_destination($pdu, substr($pdu->{data}, $len));
    return $len;
}
#4#end

sub encode_query_sm_v34 {
    my $me = $_[0];
    my ($message_id, $source_addr_ton, $source_addr_npi, $source_addr);

    ### Extract mandatory parameters from argument stream

    for (my $i=1; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	if ($_[$i] eq 'message_id') { $message_id = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr_ton')  { $source_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr_npi')  { $source_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr') { $source_addr = splice @_,$i,2,undef,undef; }
    }

    ### Apply defaults for those mandatory arguments that were not specified

    croak "Must supply message_id to query_sm" if !defined $message_id;
    $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton;
    $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi;
    $source_addr = ${*$me}{source_addr} if !defined $source_addr;

    return pack('Z*CCZ*', $message_id, $source_addr_ton, $source_addr_npi, $source_addr);
}

#4#cut
sub encode_query_sm_v4 {
    my $me = $_[0];
    my ($message_id, $source_addr_ton, $source_addr_npi, $source_addr,
	$dest_addr_ton, $dest_addr_npi, $destination_addr);

    ### Extract mandatory parameters from argument stream

    for (my $i=1; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	if ($_[$i] eq 'message_id') { $message_id = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr_ton')  { $source_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr_npi')  { $source_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr') { $source_addr = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'dest_addr_ton')  { $dest_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'dest_addr_npi')  { $dest_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'destination_addr') { $destination_addr = splice @_,$i,2,undef,undef; }
    }

    ### Apply defaults for those mandatory arguments that were not specified

    croak "Must supply message_id to query_sm" if !defined $message_id;

    $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton;
    $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi;
    $source_addr = ${*$me}{source_addr} if !defined $source_addr;

    $dest_addr_ton = ${*$me}{dest_addr_ton} if !defined $dest_addr_ton;
    $dest_addr_npi = ${*$me}{dest_addr_npi} if !defined $dest_addr_npi;
    $destination_addr = ${*$me}{destination_addr} if !defined $destination_addr;

    return pack('Z*CCZ*CCZ*',
		$message_id, $source_addr_ton, $source_addr_npi, $source_addr,
		$dest_addr_ton, $dest_addr_npi, $destination_addr);
}
#4#end

sub query_sm {
    my $me = $_[0];
    return $me->req_backend(CMD_query_sm, ${*$me}{smpp_version} == 0x40  #4
	? &encode_query_sm_v4 : &encode_query_sm_v34, @_);               #4
    return $me->req_backend(CMD_query_sm, &encode_query_sm_v34, @_);
}

sub decode_query_resp_v34 {
    my $pdu = shift;
    ($pdu->{message_id}) = unpack 'Z*', $pdu->{data};
    my $len = length($pdu->{message_id}) + 1;

    ($pdu->{final_date}) = unpack 'Z*', substr($pdu->{data}, $len);
    $len += length($pdu->{final_date}) + 1;

    ($pdu->{message_state}, $pdu->{error_code}) = unpack 'CC', substr($pdu->{data}, $len);
    return $len + 1 + 1;
}

#4#cut
sub decode_query_resp_v4 {
    my $pdu = shift;
    ($pdu->{sc_msg_reference}) = unpack 'Z*', $pdu->{data};
    my $len = length($pdu->{sc_msg_reference}) + 1;

    ($pdu->{final_date}) = unpack 'Z*', substr($pdu->{data}, $len);
    $len += length($pdu->{final_date}) + 1;

    ($pdu->{message_status}, $pdu->{network_error_code}) = unpack 'CN', substr($pdu->{data}, $len);

    $pdu->{message_id} = $pdu->{sc_msg_reference};   # v34 compat
    $pdu->{message_state} = $pdu->{message_status};  # v34 compat
    $pdu->{error_code} = $pdu->{network_error_code}; # v34 compat
    return $len + 1 + 4;
}
#4#end

sub encode_query_sm_resp_v34 {
    my $me = $_[0];
    my ($message_id, $final_date, $message_state, $error_code);
    $message_id = '2';

    for (my $i=1; $i < $#_; $i+=2) {
	next if !defined $_[$i];
	if ($_[$i] eq 'message_id')       { $message_id    = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'final_date')    { $final_date    = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'message_state') { $message_state = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'error_code')    { $error_code    = splice @_,$i,2,undef,undef; }
    }

    croak "message_id must be supplied" if !defined $message_id;
    $final_date = ${*$me}{final_date} if !defined $final_date;
    croak "message_state must be supplied" if !defined $message_state;
    $error_code = ${*$me}{error_code} if !defined $error_code;
    return pack('Z*Z*CC', $message_id, $final_date, $message_state, $error_code);
}

#4#cut
sub encode_query_sm_resp_v4 {
    my $me = $_[0];
    my ($sc_msg_reference, $final_date, $message_status, $network_error_code);

    for (my $i=1; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	if ($_[$i] eq 'sc_msg_reference')     { $sc_msg_reference = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'message_id')        { $sc_msg_reference = splice @_,$i,2,undef,undef; } # v34
	elsif ($_[$i] eq 'final_date')        { $final_date = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'message_status')    { $message_status = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'message_state')     { $message_status = splice @_,$i,2,undef,undef; } # v34
	elsif ($_[$i] eq 'networkerror_code') { $network_error_code = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'error_code')        { $network_error_code = splice @_,$i,2,undef,undef; } # v34
    }

    croak "sc_msg_reference or message_id must be supplied" if !defined $sc_msg_reference;
    $final_date = ${*$me}{final_date} if !defined $final_date;
    croak "message_status or message_state must be supplied" if !defined $message_status;
    $network_error_code = ${*$me}{network_error_code} if !defined $network_error_code;
    return pack('Z*Z*CN', $sc_msg_reference, $final_date, $message_status, $network_error_code);
}
#4#end

sub query_sm_resp {
    my $me = $_[0];
    return $me->resp_backend(CMD_query_sm_resp, ${*$me}{smpp_version} == 0x40    #4
    ? &encode_query_sm_resp_v4 : &encode_query_sm_resp_v34, @_);      #4
    return $me->resp_backend(CMD_query_sm_resp, &encode_query_sm_resp_v34, @_);
}

### alert_notification (4.12.1), p.108

sub decode_alert_notification {
    my $pdu = shift;
    my $len = decode_source_addr($pdu, $pdu->{data});

    ($pdu->{esme_addr_ton},     # 4
     $pdu->{esme_addr_npi},     # 5
     $pdu->{esme_addr}) = unpack 'CCZ*', substr($pdu->{data}, $len);

    return $len + 1 + 1 + length($pdu->{esme_addr}) + 1;
}

sub encode_alert_notification {
    my $me = $_[0];
    my ($source_addr_ton, $source_addr_npi, $source_addr,
	$esme_addr_ton, $esme_addr_npi, $esme_addr);

    ### Extract mandatory parameters from argument stream

    for (my $i=1; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	if ($_[$i] eq 'source_addr_ton')  { $source_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr_npi')  { $source_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr')      { $source_addr = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'esme_addr_ton')  { $esme_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'esme_addr_npi')  { $esme_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'esme_addr')      { $esme_addr = splice @_,$i,2,undef,undef; }
    }

    ### Apply defaults for those mandatory arguments that were not specified

    $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton;
    $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi;
    $source_addr = ${*$me}{source_addr}     if !defined $source_addr;
    $esme_addr_ton = ${*$me}{esme_addr_ton} if !defined $esme_addr_ton;
    $esme_addr_npi = ${*$me}{esme_addr_npi} if !defined $esme_addr_npi;
    croak "Must supply esme_addr to alert_notification" if !defined $esme_addr;

    return pack('CCZ*CCZ*',
		$source_addr_ton, $source_addr_npi, $source_addr,
		$esme_addr_ton, $esme_addr_npi, $esme_addr, );
}

sub alert_notification { $_[0]->req_backend(CMD_alert_notification,
					    &encode_alert_notification, @_) }

### replace (4.10.1), p.102

sub decode_replace_sm_v34 {
    my $pdu = shift;
    ($pdu->{message_id}) = unpack 'Z*', $pdu->{data};
    my $len = length($pdu->{message_id}) + 1;
    $len += decode_source_addr($pdu, substr($pdu->{data}, $len));

    ($pdu->{schedule_delivery_time}) = unpack 'Z*', substr($pdu->{data}, $len);
    $len += length($pdu->{schedule_delivery_time}) + 1;

    ($pdu->{validity_period}) = unpack 'Z*', substr($pdu->{data}, $len);
    $len += length($pdu->{validity_period}) + 1;

    my $sm_length;
    ($pdu->{registered_delivery}, # 7
     $pdu->{sm_default_msg_id}, # 8
     $sm_length,                # 9
#                123456789 0
     ) = unpack 'CCC', substr($pdu->{data}, $len);
    $len += 1 + 1 + 1;
    ($pdu->{short_message}      # 10
     ) = unpack "a$sm_length", substr($pdu->{data}, $len);

    return $len + $sm_length;
}

#4#cut
sub decode_replace_sm_v4 {
    my $pdu = shift;
    ($pdu->{msg_reference}) = unpack 'Z*', $pdu->{data};
    my $len = length($pdu->{msg_reference}) + 1;
    $len += decode_source_and_destination($pdu, substr($pdu->{data}, $len));

    ($pdu->{schedule_delivery_time}, # Z
     ) = unpack 'Z*', substr($pdu->{data}, $len);
    $len += length($pdu->{schedule_delivery_time}) + 1;

    my $sm_length;
    ($pdu->{validity_period},   # 6    n
     $pdu->{registered_delivery_mode}, # C
     $pdu->{data_coding},       # 8  C
     $pdu->{sm_default_msg_id}, # 8  C
     $sm_length,                # 9  n
     ) = unpack 'nCCCn', substr($pdu->{data}, $len);
    $len += 2 + 1 + 1 + 1 + 2;
    ($pdu->{short_message}      # 10 a
     ) = unpack "a$sm_length", substr($pdu->{data}, $len);

    $pdu->{message_id} = $pdu->{msg_reference}; # v34 compat
    $pdu->{registered_delivery} = $pdu->{registered_delivery_mode}; # v34 compat

    return $len + $sm_length;
}
#4#end

sub encode_replace_sm_v34 {
    my $me = $_[0];
    my ($message_id, $source_addr_ton, $source_addr_npi, $source_addr,
	$schedule_delivery_time, $validity_period,
	$registered_delivery, $sm_default_msg_id, $short_message);

    ### Extract mandatory parameters from argument stream

    for (my $i=1; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	if ($_[$i] eq 'message_id') { $message_id = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr_ton')  { $source_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr_npi')  { $source_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr') { $source_addr = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'schedule_delivery_time') { $schedule_delivery_time = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'validity_period') { $validity_period = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'registered_delivery') { $registered_delivery = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'sm_default_msg_id') { $sm_default_msg_id = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'short_message') { $short_message = splice @_,$i,2,undef,undef; }
    }

    ### Apply defaults for those mandatory arguments that were not specified

    croak "Must supply message_id to replace_sm" if !defined $message_id;
    $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton;
    $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi;
    $source_addr = ${*$me}{source_addr} if !defined $source_addr;
    $schedule_delivery_time = ${*$me}{schedule_delivery_time} if !defined $schedule_delivery_time;
    $validity_period = ${*$me}{validity_period} if !defined $validity_period;
    $registered_delivery = ${*$me}{registered_delivery} if !defined $registered_delivery;
    $sm_default_msg_id = ${*$me}{sm_default_msg_id} if !defined $sm_default_msg_id;
    $short_message = ${*$me}{short_message} if !defined $short_message;

    return pack('Z*CCZ*Z*Z*CCCa*',
		$message_id, $source_addr_ton, $source_addr_npi, $source_addr,
		$schedule_delivery_time, $validity_period,
		$registered_delivery, $sm_default_msg_id, length($short_message), $short_message, );
}

#4#cut
sub encode_replace_sm_v4 {
    my $me = $_[0];
    my ($msg_reference, $source_addr_ton, $source_addr_npi, $source_addr,
	$dest_addr_ton, $dest_addr_npi, $destination_addr,
	$schedule_delivery_time, $validity_period,
	$registered_delivery_mode, $data_coding, $sm_default_msg_id, $short_message);

    ### Extract mandatory parameters from argument stream

    for (my $i=1; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	if ($_[$i] eq 'msg_reference') { $msg_reference = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'message_id') { $msg_reference = splice @_,$i,2,undef,undef; } # v34
	elsif ($_[$i] eq 'source_addr_ton')  { $source_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr_npi')  { $source_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr') { $source_addr = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'dest_addr_ton')  { $dest_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'dest_addr_npi')  { $dest_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'destination_addr') { $destination_addr = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'schedule_delivery_time') { $schedule_delivery_time = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'validity_period') { $validity_period = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'registered_delivery_mode') { $registered_delivery_mode = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'registered_delivery') { $registered_delivery_mode = splice @_,$i,2,undef,undef; } # v34
	elsif ($_[$i] eq 'data_coding') { $data_coding = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'sm_default_msg_id') { $sm_default_msg_id = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'short_message') { $short_message = splice @_,$i,2,undef,undef; }
    }

    ### Apply defaults for those mandatory arguments that were not specified

    croak "Must supply msg_reference or message_id to replace_sm" if !defined $msg_reference;
    $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton;
    $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi;
    $source_addr = ${*$me}{source_addr} if !defined $source_addr;
    $dest_addr_ton = ${*$me}{dest_addr_ton} if !defined $dest_addr_ton;
    $dest_addr_npi = ${*$me}{dest_addr_npi} if !defined $dest_addr_npi;
    $destination_addr = ${*$me}{destination_addr} if !defined $destination_addr;
    $schedule_delivery_time = ${*$me}{schedule_delivery_time} if !defined $schedule_delivery_time;
    $validity_period = ${*$me}{validity_period} if !defined $validity_period;
    $registered_delivery_mode = ${*$me}{registered_delivery_mode} if !defined $registered_delivery_mode;
    $data_coding = ${*$me}{data_coding} if !defined $data_coding;
    $sm_default_msg_id = ${*$me}{sm_default_msg_id} if !defined $sm_default_msg_id;
    $short_message = ${*$me}{short_message} if !defined $short_message;

    return pack('Z*CCZ*CCZ*Z*nCCCna*',
		$msg_reference, $source_addr_ton, $source_addr_npi, $source_addr,
		$dest_addr_ton, $dest_addr_npi, $destination_addr,
		$schedule_delivery_time, $validity_period,
		$registered_delivery_mode, $data_coding, $sm_default_msg_id, length($short_message), $short_message, );
}
#4#end

sub replace_sm {
    my $me = $_[0];
    return $me->req_backend(CMD_replace_sm, ${*$me}{smpp_version} == 0x40                 #4
				? &encode_replace_sm_v4 : &encode_replace_sm_v34,  #4
				@_);                                               #4
    return $me->req_backend(CMD_replace_sm, &encode_replace_sm_v34, @_);
}

### cancel (4.9.1), p.98

sub decode_cancel {
    my $pdu = shift;
    my $me = shift;
    my $len = 0;
    if (${*$me}{smpp_version}==0x40) {                       #4
        ($pdu->{service_type}) = unpack 'n', $pdu->{data};   #4
        $len += 2;                                           #4
    } else {                                                 #4
        ($pdu->{service_type}) = unpack 'Z*', $pdu->{data};
        $len += length($pdu->{service_type}) + 1;
    }                                                        #4
    ($pdu->{message_id}) = unpack 'Z*', substr($pdu->{data}, $len);
    $len += length($pdu->{message_id}) + 1;

    $len += decode_source_and_destination($pdu, substr($pdu->{data}, $len));

    $pdu->{message_class} = $pdu->{service_type};  # v4      #4
    return $len;
}

sub encode_cancel_sm {
    my $me = $_[0];
    my ($service_type, $message_id, $source_addr_ton, $source_addr_npi, $source_addr,
	$dest_addr_ton, $dest_addr_npi, $destination_addr);

    ### Extract mandatory parameters from argument stream

    for (my $i=1; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	if ($_[$i] eq 'service_type') { $service_type = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'message_class') { $service_type = splice @_,$i,2,undef,undef; }  # v4  #4
	elsif ($_[$i] eq 'message_id') { $message_id = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr_ton')  { $source_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr_npi')  { $source_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr') { $source_addr = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'dest_addr_ton')  { $dest_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'dest_addr_npi')  { $dest_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'destination_addr') { $destination_addr = splice @_,$i,2,undef,undef; }
    }

    ### Apply defaults for those mandatory arguments that were not specified

    $service_type = ${*$me}{service_type} if !defined $service_type;
    $message_id = ${*$me}{message_id} if !defined $message_id;
    $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton;
    $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi;
    $source_addr = ${*$me}{source_addr} if !defined $source_addr;
    $dest_addr_ton = ${*$me}{dest_addr_ton} if !defined $dest_addr_ton;
    $dest_addr_npi = ${*$me}{dest_addr_npi} if !defined $dest_addr_npi;
    $destination_addr = ${*$me}{destination_addr} if !defined $destination_addr;

    return pack(${*$me}{smpp_version}==0x40 ? 'nZ*CCZ*CCZ*' : 'Z*Z*CCZ*CCZ*',  #4
		$service_type, $message_id,                                    #4
		$source_addr_ton, $source_addr_npi, $source_addr,              #4
		$dest_addr_ton, $dest_addr_npi, $destination_addr, );          #4
    return pack('Z*Z*CCZ*CCZ*',
		$service_type, $message_id,
		$source_addr_ton, $source_addr_npi, $source_addr,
		$dest_addr_ton, $dest_addr_npi, $destination_addr, );
}

sub cancel_sm { $_[0]->req_backend(CMD_cancel_sm, &encode_cancel_sm, @_) }  # public API

### data_sm (4.7.1), p.87

sub decode_data_sm {
    my $pdu = shift;

    ($pdu->{service_type}) = unpack 'Z*', $pdu->{data};
    my $len = length($pdu->{service_type}) + 1;

    $len += decode_source_and_destination($pdu, substr($pdu->{data}, $len));

    ($pdu->{esm_class},         # 8
     $pdu->{registered_delivery}, # 9
     $pdu->{data_coding},       # 10
#                890
     ) = unpack 'CCC', substr($pdu->{data}, $len);

    return $len + 1 + 1 + 1;
}

sub encode_data_sm {
    my $me = $_[0];
    my ($service_type, $source_addr_ton, $source_addr_npi, $source_addr,
	$dest_addr_ton, $dest_addr_npi, $destination_addr,
	$esm_class, $registered_delivery, $data_coding);

    ### Extract mandatory parameters from argument stream

    for (my $i=1; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	if ($_[$i] eq 'service_type') { $service_type = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr_ton')  { $source_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr_npi')  { $source_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr') { $source_addr = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'dest_addr_ton')  { $dest_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'dest_addr_npi')  { $dest_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'destination_addr') { $destination_addr = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'esm_class') { $esm_class = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'registered_delivery') { $registered_delivery = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'data_coding') { $data_coding = splice @_,$i,2,undef,undef; }
    }

    ### Apply defaults for those mandatory arguments that were not specified

    $service_type = ${*$me}{service_type} if !defined $service_type;
    $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton;
    $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi;
    $source_addr = ${*$me}{source_addr} if !defined $source_addr;
    $dest_addr_ton = ${*$me}{dest_addr_ton} if !defined $dest_addr_ton;
    $dest_addr_npi = ${*$me}{dest_addr_npi} if !defined $dest_addr_npi;

    croak "Must supply destination_addr to data_sm" if !defined $destination_addr;

    $esm_class = ${*$me}{esm_class} if !defined $esm_class;
    $registered_delivery = ${*$me}{registered_delivery} if !defined $registered_delivery;
    $data_coding = ${*$me}{data_coding} if !defined $data_coding;

    return pack('Z*CCZ*CCZ*CCC',
		$service_type, $source_addr_ton, $source_addr_npi, $source_addr,
		$dest_addr_ton, $dest_addr_npi, $destination_addr,
		$esm_class, $registered_delivery, $data_coding, );
}

sub data_sm { $_[0]->req_backend(CMD_data_sm, &encode_data_sm, @_) }

#4#cut
### delivery_receipt: v4 6.4.6.1, p.41

sub decode_delivery_receipt {
    my $pdu = shift;
    my $len = decode_source_and_destination($pdu, $pdu->{data});

    ($pdu->{msg_reference}) = unpack 'Z*', substr($pdu->{data}, $len);
    $len += length($pdu->{msg_reference}) + 1;

    ($pdu->{num_msgs_submitted}, # 9  N
     $pdu->{num_msgs_delivered}, # 10 N
     $pdu->{submit_date},        # 11 Z
     ) = unpack 'NNZ*', substr($pdu->{data}, $len);
    $len += 4 + 4 + length($pdu->{submit_date}) + 1;

    ($pdu->{done_date}) = unpack 'Z*', substr($pdu->{data}, $len);
    $len += length($pdu->{done_date}) + 1;

    my $sm_length;
    ($pdu->{message_state},      # 13 N
     $pdu->{network_error_code}, # 14 N
     $pdu->{data_coding},        # 15 C
     $sm_length,                 # 16 n
#                234567890123456 7
     ) = unpack 'NNCn', substr($pdu->{data}, $len);
    $len += 4 + 4 + 1 + 2;
    ($pdu->{short_message},      # 17 a
     ) = unpack "a$sm_length", substr($pdu->{data}, $len);
    return $len + $sm_length;
}

sub encode_delivery_receipt {
    my $me = $_[0];
    my ($source_addr_ton, $source_addr_npi, $source_addr,
	$dest_addr_ton, $dest_addr_npi, $destination_addr,
	$msg_reference, $num_msgs_submitted, $num_msgs_delivered,
	$submit_date, $done_date, $message_state, $network_error_code,
	$data_coding, $short_message);

    ### Extract mandatory parameters from argument stream

    for (my $i=1; $i <= $#_; $i+=2) {
	next if !defined $_[$i];
	if ($_[$i] eq 'source_addr_ton')  { $source_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr_npi')  { $source_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'source_addr') { $source_addr = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'dest_addr_ton')  { $dest_addr_ton = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'dest_addr_npi')  { $dest_addr_npi = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'destination_addr') { $destination_addr = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'msg_reference') { $msg_reference = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'num_msgs_submitted') { $num_msgs_submitted = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'num_msgs_delivered') { $num_msgs_delivered = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'submit_date') { $submit_date = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'done_date') { $done_date = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'message_state') { $message_state = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'network_error_code') { $network_error_code = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'data_coding') { $data_coding = splice @_,$i,2,undef,undef; }
	elsif ($_[$i] eq 'short_message') { $short_message = splice @_,$i,2,undef,undef; }
    }

    ### Apply defaults for those mandatory arguments that were not specified

    $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton;
    $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi;
    $source_addr = ${*$me}{source_addr} if !defined $source_addr;
    $dest_addr_ton = ${*$me}{dest_addr_ton} if !defined $dest_addr_ton;
    $dest_addr_npi = ${*$me}{dest_addr_npi} if !defined $dest_addr_npi;

    croak "Must supply destination_addr to delivery_receipt" if !defined $destination_addr;

    $msg_reference = ${*$me}{msg_reference} if !defined $msg_reference;
    $num_msgs_submitted = ${*$me}{num_msgs_submitted} if !defined $num_msgs_submitted;
    $num_msgs_delivered = ${*$me}{num_msgs_delivered} if !defined $num_msgs_delivered;
    $submit_date = ${*$me}{submit_date} if !defined $submit_date;
    $done_date = ${*$me}{done_date} if !defined $done_date;
    $message_state = ${*$me}{message_state} if !defined $message_state;
    $network_error_code = ${*$me}{network_error_code} if !defined $network_error_code;
    $data_coding = ${*$me}{data_coding} if !defined $data_coding;
    $short_message = ${*$me}{short_message} if !defined $short_message;

    return pack('CCZ*CCZ*Z*NNZ*Z*NNCna*',
		$source_addr_ton, $source_addr_npi, $source_addr,
		$dest_addr_ton, $dest_addr_npi, $destination_addr,
		$msg_reference, $num_msgs_submitted, $num_msgs_delivered,
		$submit_date, $done_date, $message_state,
		$network_error_code, $data_coding, length($short_message), $short_message);
}

sub delivery_receipt { $_[0]->req_backend(CMD_delivery_receipt, &encode_delivery_receipt, @_) }
#4#end

###

sub set_version {
    my $me = shift;
    my $version = shift;

    if ($version == 0x40) {                  #4
	${*$me}{smpp_version} = 0x40;        #4
	${*$me}{head_templ} = 'NNNNxxxx';    #4
	${*$me}{head_len} = 20;              #4
	${*$me}{cmd_version} = 0x00010000;   #4
    } else {                                 #4
	${*$me}{smpp_version} = $version;
	${*$me}{head_templ} = 'NNNN';
	${*$me}{head_len} = 16;
	${*$me}{cmd_version} = 0x00000000;
    }                                        #4
}

### Accept a new server child, i.e. accepted socket. This
### constructor gets called internally just after accept system
### call when listening socket does accept. See also "new_listen"
### which gets called when socket is created and put listening.
### DO NOT USE THIS CONSTRUCTOR FOR CLIENT SIDE CONNECTIONS.
###
### The way this code works is that somewhere deep in guts of
### IO::Socket module the constructor name is hardwired to
### "new" and there is no way to pass any arguments to this
### constructor, hence I have to copy the arguments from
### the parent when constructing. Let's hope this aspect
### of IO::Socket does not change.

sub new {
    my $accept = shift;
    my $type = ref($accept) || $accept;
    my $me = gensym;
    for my $k (keys %{*$accept}) {
	${*$me}{$k} = ${*$accept}{$k};
    }
    return bless $me, $type;
}

### Create client connection (do not use "new")

sub new_connect {
    my $me = shift;
    my $type = ref($me) || $me;
    my $host = shift if @_ % 2;  # host need not be tagged
    my %arg = @_;

    my $s = $type->SUPER::new(
         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;

    for my $a (keys %{&Default}) {
	${*$s}{$a} = exists $arg{$a} ? $arg{$a} : Default->{$a};
    }
    $s->set_version(${*$s}{smpp_version});
    #warn Dumper $s;

    $s->autoflush(1);
    #$s->debug(exists $arg{debug} ? $arg{debug} : undef);
    return $s;
}

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;
}

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;
    return ($me, $resp) if wantarray;
    return $me;
}

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;
}

### Create new server connection, i.e. listening socket. See
### also "new" which gets called when connection is accepted
### from the listening socket.

sub new_listen {
    my $me = shift;
    my $type = ref($me) || $me;
    my $host = shift if @_ % 2;  # host need not be tagged
    my %arg = @_;

    my $s = $type->SUPER::new(
      LocalAddr => $host,
      LocalPort => exists $arg{port} ? $arg{port} : Default->{port},
      Proto    => 'tcp',
      ReuseAddr => 'true',
      Listen   => exists $arg{listen} ? $arg{listen} : Default->{listen},
      Timeout  => exists $arg{timeout} ? $arg{timeout} : Default->{timeout})
	or return undef;
    for my $a (keys %{&Default}) {
	${*$s}{$a} = exists $arg{$a} ? $arg{$a} : Default->{$a};
    }
    $s->set_version(${*$s}{smpp_version});
    $s->sockopt(SO_REUSEADDR => 1);
    $s->autoflush(1);
    #$s->debug(exists $arg{debug} ? $arg{debug} : undef);
    return $s;
}

### This table drives the decoding process

use constant pdu_tab => {
    0x80000000 => { cmd => 'generic_nack', decode => \&decode_empty, }, # i
    0x00000001 => { cmd => 'bind_receiver', decode => \&decode_bind, }, # i
    0x80000001 => { cmd => 'bind_receiver_resp', decode => \&decode_bind_resp_v34, }, # i
    0x00000002 => { cmd => 'bind_transmitter', decode => \&decode_bind, },        # i
    0x80000002 => { cmd => 'bind_transmitter_resp', decode => \&decode_bind_resp_v34, }, # i
    0x00000003 => { cmd => 'query_sm', decode => \&decode_query_v34, },               # i
    0x80000003 => { cmd => 'query_sm_resp', decode => \&decode_query_resp_v34, },     # i
    0x00000004 => { cmd => 'submit_sm', decode => \&decode_submit_v34, },             # i
    0x80000004 => { cmd => 'submit_sm_resp', decode => \&decode_submit_resp_v34, },   # i
    0x00000005 => { cmd => 'deliver_sm', decode => \&decode_submit_v34, },            # i
    0x80000005 => { cmd => 'deliver_sm_resp', decode => \&decode_submit_resp_v34, },  # i
    0x00000006 => { cmd => 'unbind', decode => \&decode_empty, },       # i
    0x80000006 => { cmd => 'unbind_resp', decode => \&decode_empty, },  # i
    0x00000007 => { cmd => 'replace_sm', decode => \&decode_replace_sm_v34, }, # i
    0x80000007 => { cmd => 'replace_sm_resp', decode => \&decode_empty, }, # i
    0x00000008 => { cmd => 'cancel_sm', decode => \&decode_cancel, },      # i
    0x80000008 => { cmd => 'cancel_sm_resp', decode => \&decode_empty, },  # i
    0x00000009 => { cmd => 'bind_transceiver', decode => \&decode_bind, }, # i
    0x80000009 => { cmd => 'bind_transceiver_resp', decode => \&decode_bind_resp_v34, }, # i
    0x0000000b => { cmd => 'outbind', decode => \&decode_outbind_v34, },         # i
    0x00000015 => { cmd => 'enquire_link', decode => \&decode_empty, },      # i
    0x80000015 => { cmd => 'enquire_link_resp', decode => \&decode_empty, }, # i
    0x00000021 => { cmd => 'submit_multi', decode => \&decode_submit_multi, }, # i
    0x80000021 => { cmd => 'submit_multi_resp', decode => \&decode_submit_multi_resp, }, # i
    0x00000102 => { cmd => 'alert_notification', decode => \&decode_alert_notification, }, # i
    0x00000103 => { cmd => 'data_sm', decode => \&decode_data_sm, },          # i
    0x80000103 => { cmd => 'data_sm_resp', decode => \&decode_submit_resp_v34, }, # i

#4#cut
    # v4 codes

    0x80010000 => { cmd => 'generic_nack_v4', decode => \&decode_empty, }, # i
    0x00010001 => { cmd => 'bind_receiver_v4', decode => \&decode_bind, }, # i
    0x80010001 => { cmd => 'bind_receiver_resp_v4', decode => \&decode_bind_resp_v4, }, # i
    0x00010002 => { cmd => 'bind_transmitter_v4', decode => \&decode_bind, },        # i
    0x80010002 => { cmd => 'bind_transmitter_resp_v4', decode => \&decode_bind_resp_v4, }, # i
    0x00010003 => { cmd => 'query_sm_v4', decode => \&decode_query_v4, },               # i
    0x80010003 => { cmd => 'query_sm_resp_v4', decode => \&decode_query_resp_v4, },     # i
    0x00010004 => { cmd => 'submit_sm_v4', decode => \&decode_submit_v4, },             # i
    0x80010004 => { cmd => 'submit_sm_resp_v4', decode => \&decode_submit_sm_resp_v4, },   # i
    0x00010005 => { cmd => 'deliver_sm_v4', decode => \&decode_deliver_sm_v4, },            # i
    0x80010005 => { cmd => 'deliver_sm_resp_v4', decode => \&decode_empty, },  # i
    0x00010006 => { cmd => 'unbind_v4', decode => \&decode_empty, },       # i
    0x80010006 => { cmd => 'unbind_resp_v4', decode => \&decode_empty, },  # i
    0x00010007 => { cmd => 'replace_sm_v4', decode => \&decode_replace_sm_v4, }, # i
    0x80010007 => { cmd => 'replace_sm_resp_v4', decode => \&decode_empty, }, # i
    0x00010008 => { cmd => 'cancel_sm_v4', decode => \&decode_cancel, },      # i
    0x80010008 => { cmd => 'cancel_sm_resp_v4', decode => \&decode_empty, },  # i
    0x00010009 => { cmd => 'delivery_receipt_v4', decode => \&decode_delivery_receipt, }, # ***
    0x80010009 => { cmd => 'delivery_receipt_resp_v4', decode => \&decode_empty, },  # i
    0x0001000a => { cmd => 'enquire_link_v4', decode => \&decode_empty, },      # i  v4
    0x8001000a => { cmd => 'enquire_link_resp_v4', decode => \&decode_empty, }, # i  v4
    0x0001000b => { cmd => 'outbind_v4', decode => \&decode_outbind_v4, },         # i
#4#end
};

package Net::SMPP::PDU;

sub message_id {
    my $me = shift;
    return $me->{message_id};
}

sub status {
    my $me = shift;
    return $me->{status};
    #return ${$me}{status};
    #return ${*$me}{status};
}

sub seq {
    my $me = shift;
    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});
}

sub cmd {
    my $me = shift;
    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}) };
    return $cmd->{cmd};
}

package Net::SMPP;

### Try real hard to read something, i.e. block until the thing has
### been entirely read.

sub read_hard {
    my ($me, $len, $dr, $offset) = @_;
    while (length($$dr) < $len+$offset) {
	my $n = length($$dr) - $offset;
	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;
	    while (1) {
		$n = $me->sysread($$dr, $len-$n, $n+$offset);
		next if $! =~ /^Interrupted/;
		last;
	    }
	    alarm 0;
	};
	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";
    return 1;
}

### read pdu from wire and decode it, if PDU is understood

sub read_pdu {
    my $me = shift;
    my $header = '';
    my $len;
    my $head_len = ${*$me}{head_len};
    $me->read_hard($head_len, \$header, 0) or return undef;
    my $pdu = { cmd => 0, status => 0, seq => 0, data => '', };
    ($len,
     $pdu->{cmd},
     $pdu->{status},
     $pdu->{seq},
     $pdu->{reserved}) = unpack ${*$me}{head_templ}, $header;
    if ($len < $head_len) {
	warn "Too short length $len < ${*$me}{head_len}, cmd=$pdu->{cmd}, status=$pdu->{status}, seq=$pdu->{seq}";
        ${*$me}{smpperror} = "read_pdu: Too short length $len < ${*$me}{head_len}, cmd=$pdu->{cmd}, status=$pdu->{status}, seq=$pdu->{seq}";
        ${*$me}{smpperrorcode} = 3;
	return undef;
    }
    warn "read Header:\n".hexdump($header, "\t") if $trace;

    $len -= $head_len;
    $me->read_hard($len, \$pdu->{data}, 0) or do {
        ${*$me}{smpperror} = "read_pdu: invalid length cmd=$pdu->{cmd},status=$pdu->{status}, seq=$pdu->{seq}";
        ${*$me}{smpperrorcode} = 3;
        return undef;
    };
    warn "read Body:\n".hexdump($pdu->{data}, "\t") if $trace;

    ### Check if we know this PDU and decode it

    if (defined pdu_tab->{$pdu->{cmd}}) {
	$pdu->{known_pdu} = 1;
	my $pdu_templ = pdu_tab->{$pdu->{cmd}};
	my $mandat_len = &{$pdu_templ->{decode}}($pdu, $me);
	decode_optional_params($pdu, $mandat_len) if $mandat_len < $len;
    }

    return bless $pdu => 'Net::SMPP::PDU';
}

sub wait_pdu {
    my ($me, $look_for_me, $seq) = @_;
    while (1) {
	my $pdu = $me->read_pdu() || return undef;
	return $pdu if $pdu->{cmd} == $look_for_me && $pdu->{seq} == $seq;

	### Check if PDU has a handlers (e.g. its enquire_link)

	if (exists ${*$me}{handlers}->{$pdu->{cmd}}) {
	    &{${*$me}{handlers}->{$pdu->{cmd}}}($me, $pdu);
	}

	### *** effectively all other PDUs get ignored
	warn "looking for $look_for_me seq=$seq, skipping cmd=$pdu->{cmd} seq=$pdu->{seq}" if $trace;
    }
}

### Send a response to enquire_link

sub handle_enquire_link {
    my ($me, $pdu) = @_;
    $me->enquire_link_resp(seq => $pdu->{seq});
}

### GSM often uses 7bit encoding to squeeze 160 7bit characters
### in 140 octets. This encoding is not automatically done by
### this module, but following routines allow one to do it
### manually.
###
### In general we can fit 8 7bit characters in 7 octets.
###
### Packing method:
###
### BIT:  76543210 76543210 76543210 76543210 76543210 76543210 76543210
### BYTE: 0        1        2        3        4        5        6
### CHAR: BAAAAAAA CCBBBBBB DDDCCCCC EEEEDDDD FFFFFEEE GGGGGGFF HHHHHHHG
###
### So as can be seen, the characters are encoded lowest bit to lowest
### available bit position, just wrapping around. Another possiblity
### would be as follows
###
### BIT:  76543210 76543210 76543210 76543210 76543210 76543210 76543210
### BYTE: 0        1        2        3        4        5        6
### CHAR: HAAAAAAA HBBBBBBB HCCCCCCC HDDDDDDD HEEEEEEE HFFFFFFF HGGGGGGG
###
### In this scheme the last character is distributed over the high bits
### of the other bytes. while bytes A-G would just be normal.
###
### These routines still have some issues in handling the padding. Especially
### unpack_7bit may leave some artifacts in the end.

sub pack_7bit {
    my ($s) = @_;
    $s = unpack 'b*', $s;
    $s =~ s/(.{7})./$1/g;    # Zap the high order (8th) bits
    return pack 'b*', $s;
}

sub unpack_7bit {
    my ($s) = @_;
    $s = unpack 'b*', $s;
    $s =~ s/(.{7})/${1}0/g;  # Stuff in high order (8th) bits
    $s = pack 'b*', $s;
    chop $s if substr($s, -1, 1) eq "\x00";
    return $s;
#    return pack 'b*', $s;
}

# "Gema niskazhu"

1;
__END__