File Coverage

blib/lib/Net/UCP.pm

Criterion	Covered	Total	%
statement	104	725	14.3
branch	58	610	9.5
condition	5	195	2.5
subroutine	21	63	33.3
pod	12	45	26.6
total	200	1638	12.2

#########################################################################
# - Net::UCP 0.41 -
#
# Version : 0.41
# Date    : 06/04/2010
#
# Library based on EMI - UCP INTERFACE Specification
# Version 3.5 of December 1999
# Spcification Copyright (C) CMG telecommunication & Utilities BV Division
# Advanced Technology
#
# Library Copyright (C) 2004-2009 Marco Romano
#
# This library is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself, either Perl version 5.8.4 or,
# at your option, any later version of Perl 5 you may have available.
#
#########################################################################
package Net::UCP;

use strict;
use warnings;
use Carp;
use IO::Socket;
use IO::Select;
use Time::HiRes qw(setitimer ITIMER_REAL);

use Net::UCP::Common qw(:all);
use Net::UCP::IntTimeout;
use Net::UCP::TransactionManager;

require Exporter;

use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);

@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = ();

$VERSION = '0.41';

$VERSION = eval $VERSION;

use constant TRUE => 1;

BEGIN { *logout = *close_link; }

sub new { bless({}, shift())->_init(@_); }

# login to SMSC
sub login {
    my $self = shift();

    my %args = (
		SMSC_ID    => '',
		SMSC_PW    => '',
		SHORT_CODE => undef,
		ONPI       => '',
		OTON       => '',
		STYP       => 1,       #def 1 (open session)
		VERS       => '0100',  #def 0100
		@_);

    # Conditionally open the socket unless already opened.
    $self->open_link() unless(defined($self->{SOCK}));
    unless(defined($self->{SOCK})) {
        return(defined(wantarray)?wantarray?(undef,0,''):undef:undef);
    }

    defined($args{SMSC_ID})&&length($args{SMSC_ID})||do {
	$self->{WARN}&&warn("Missing mandatory parameter 'SMSC_ID' when trying to login. Login failed");
	return(defined(wantarray)?wantarray?(undef,0,''):undef:undef);
    };

    defined($args{SMSC_PW})&&length($args{SMSC_PW})||do {
	$self->{WARN}&&warn("Missing mandatory parameter 'SMSC_PW' when trying to login. Login failed");
	return(defined(wantarray)?wantarray?(undef,0,''):undef:undef);
    };

    my $message_string = $self->make_message(
					     op        => '60',
					     operation => 1,
					     oadc      => $args{SMSC_ID},
					     oton      => $args{OTON},
					     onpi      => $args{ONPI},
					     styp      => $args{STYP},
					     pwd       => $args{SMSC_PW},
					     vers      => $args{VERS}
					     );

    if ( defined $message_string ) {
	my $timeout = $self->{TIMEOUT_OBJ}->get();
	$self->transmit_msg($message_string, $timeout, 1);
    } else {
	return(defined(wantarray)?wantarray?(undef,0,''):undef:undef);
    }
}

# This method will also conditionally be called from the login() method.
sub open_link {
    my $self = shift;

    $self->{SOCK} = IO::Socket::INET->new(
					  PeerAddr  => $self->{SMSC_HOST},
					  PeerPort  => $self->{SMSC_PORT},
					  Proto     => 'tcp',
					  LocalAddr => defined($self->{SRC_HOST}) ? $self->{SRC_HOST} : undef,
					  LocalPort => defined($self->{SRC_PORT}) ? $self->{SRC_PORT} : undef
					  );

    defined($self->{SOCK})||do {
	$self->{WARN}&&warn("Failed to establish a socket connection with host $self->{SMSC_HOST} on port $self->{SMSC_PORT} : $!");
        return;
    };
    TRUE;
}


# To avoid keeping the socket open if not used any more.
sub close_link {
    my $self = shift;

    defined($self->{SOCK})||return;

    close($self->{SOCK});
    $self->{SOCK}=undef;
    $self->{TRN_OBJ}->reset_trn();
    TRUE;
}

# send SMS
sub send_sms {
    my $self = shift();
    my %args = (
		RECIPIENT      => '',
		MESSAGE_TEXT   => '',
		SENDER_TEXT    => '',
		UDH            => '',
		MESSAGE_BINARY => undef,
		FLASH          => undef,
		TIMEOUT        => undef,
		@_);

    my $timeout;

    if(defined($args{TIMEOUT})) {
        my $tv   = Net::UCP::IntTimeout->new( TIMEOUT => $args{TIMEOUT} );
        $timeout = $tv->get();
    }
    else {
        $timeout = $self->{TIMEOUT_OBJ}->get();
    }

    defined($args{RECIPIENT})&&length($args{RECIPIENT})||do {
        $self->{WARN}&&warn("Missing mandatory parameter 'RECIPIENT' when trying to send message. Transmission failed");
        return(defined(wantarray)?wantarray?(undef,0,''):undef:undef);
    };

    $args{RECIPIENT}=~s/^\+/00/;
    $args{RECIPIENT}=~/^\d+$/||do{
      $self->{WARN}&&warn("The recipient address contains illegal (non-numerical) characters: $args{RECIPIENT}\nMessage not sent ");
        return(defined(wantarray)?wantarray?(undef,0,''):undef:undef);
    };

    # It's OK to send an empty message, but not to use undef.
    defined($args{MESSAGE_TEXT})||($args{MESSAGE_TEXT}=' ');

    my $oadcTmp = '';
    my $otoaTmp = '';

    ($oadcTmp, $otoaTmp) = $self->_get_info_from($args{SENDER_TEXT}) if ((defined($args{SENDER_TEXT})
									    and
									    length($args{SENDER_TEXT})));

    my $mclsTmp  = (defined($args{FLASH}) and ($args{FLASH} == 1)) ? 1 : '';
    my $class    = ($mclsTmp) ? 0 : 1;

    my %param_tmp = (
		     op        => '51',
		     operation => 1,
		     adc       => $args{RECIPIENT},
		     oadc      => $oadcTmp,
		     ac        => $self->{SHORT_CODE},
		     mt        => (defined($args{MESSAGE_BINARY}) ? '4' : '3'),
		     nb        => (defined($args{MESSAGE_BINARY}) ?
				   (length($args{MESSAGE_BINARY})/2)*8 : ''),
		     dcs       => (defined($args{MESSAGE_BINARY}) ? '1' : ''),
		     mcls      => $mclsTmp,
		     otoa      => $otoaTmp,
		     xser      => (defined($args{MESSAGE_BINARY})
				   &&
				   defined($args{MESSAGE_BINARY})
				   ?
				   make_xser("B", $args{UDH}, $class) : make_xser("T", $args{UDH}, $class)
				   )
		     );

    if (defined $args{MESSAGE_BINARY}) {
	$param_tmp{tmsg} = $args{MESSAGE_BINARY};
    } else {
	$param_tmp{amsg} = $args{MESSAGE_TEXT};
    }

    my $message_string = $self->make_message(%param_tmp);

    $self->transmit_msg($message_string, $timeout, 1);
}


sub send_sms_multipart {
    my $self = shift;
    my %argsLong =(RECIPIENT      => '',
		   MESSAGE_TEXT   => '',
		   SENDER_TEXT    => '',
		   UDH            => undef,
		   MESSAGE_BINARY => undef,
		   FLASH          => undef,
		   TIMEOUT        => undef,
		   @_);

    my $messageId  = random_int(1,255);
    my $multiHash;
    my $countPart = 0;

    foreach my $chunk ($argsLong{MESSAGE_TEXT}=~m/(.{1,134})/sg){
        $multiHash->{++$countPart} = $chunk;
    }
    while (my ($k, $textChunk) = each %{$multiHash}) {
        my $udh=sprintf('%s%02X%02X%02X',"0106050003",$messageId,$countPart,$k);
        my $ret = $self->send_sms(
			       RECIPIENT      => $argsLong{RECIPIENT},
			       MESSAGE_TEXT   => $textChunk,
			       SENDER_TEXT    => $argsLong{SENDER_TEXT},
			       UDH            => $udh
			       );

	return $ret if (!$ret || !defined($ret)); #it could be better

    }

    return TRUE;

}

sub random_int ($$) {
    my($min, $max) = @_;

    return $min if $min == $max;

    ($min, $max) = ($max, $min)  if  $min > $max;
    return $min + int rand(1 + $max - $min);

}


sub _get_info_from {
    my ($self, $from) = @_;

    my ($oadc_tmp, $otoa_tmp);

    if ($from =~ /^([0-9]+)$/) {
	$otoa_tmp = '';
	if (length ($from) > 22) {substr($from,22) = ''}
	$oadc_tmp = $from;
    } elsif ($from =~ /^\+([0-9]+)$/) {
	$from =~ s/^.//;
	$otoa_tmp = '1139';
	if (length ($from) > 22) {substr($from,22) = ''}
	$oadc_tmp = $from;
    } else {
	$otoa_tmp = '5039';
	if (length ($from) > 11) {substr($from,11) = ''}
	$oadc_tmp = $from;
    }

    return ($oadc_tmp,$otoa_tmp);
}


#make_xser() subfunction.
#
#Parameters:
#1)Message Type   (it can be "T" -> Text or "B" -> Binary messages)
#2)UserDataHeader (in hexadecimal without octet length)
#3)Message Class  (optional)
##################################
sub make_xser {
    my $type=shift;
    my $udh=shift;
    my $class=shift;

    my $xser_ret = '';

    $class = 1 if ($class eq '');

#count UDH octest numbers
    my $udh_len = sprintf("%02X",length($udh)/2);

#count octets numbers of DD field
#numero totale di ottetti
    my $udh_oct = sprintf("%02X",(length($udh)/2)+1);

    if (not $class) {

        $type eq "T" and $xser_ret='020110';

        if ($udh =~ m/\d+/ and $type eq "T") {
            $xser_ret = $udh;
        }

    } else {

        if ($udh =~ m/\d+/ and $type eq "T") {
            $xser_ret = $udh;
        } else {
            $xser_ret='';
        }

    }

#XSER for binary message with udh
#XSER multipart
#TT 02 -> Xser per DCS
#LL 01 -> ottetti DD
#DD 00 -> imposta data coding scheme a 8 bit
#TT 01 -> Xser per UDH
#LL $udh_oct -> otetti UDH information field
#DD -> contiene UDH field specificato dall'utente

    $type eq "B" and $xser_ret='02011501'.$udh_oct.$udh_len.$udh;

    return $xser_ret;

}

sub _init {
    my $self = shift;

    $self->{OBJ_EMI_COMMON} = new Net::UCP::Common;
    $self->{TRN_OBJ}        = new Net::UCP::TransactionManager;
    $self->{TIMEOUT_OBJ}    = new Net::UCP::IntTimeout;

    return $self if @_ == 0;

    my %args = (
		FAKE        => 0,
		SMSC_HOST   => '',
		SMSC_PORT   => DEF_SMSC_PORT,
		SENDER_TEXT => '',
		WARN        => 0,
		TIMEOUT     => undef,
		SRC_HOST    => undef,
		SRC_PORT    => undef,
		@_);

    if ($args{FAKE} == 0) {

	$self->{WARN} = defined($args{WARN}) ? $args{WARN} ? 1 : 0 : 0;
	$self->{TIMEOUT_OBJ}->set($args{TIMEOUT});

	defined($args{SMSC_HOST}) && length($args{SMSC_HOST}) || do {
	    $self->{WARN}&&warn("Mandatory entity 'SMSC_HOST' was missing when creating an object of class ".
				__PACKAGE__.
				". Object not created");
	    return;       # Failed to instantiate this object.
	};
	defined($args{SMSC_PORT})&&length($args{SMSC_PORT})||do{
	    $self->{WARN}&&warn("Mandatory entity 'SMSC_PORT' was missing when creating an object of class ".
				__PACKAGE__.
				". Object not created");
	    return;       # Failed to instantiate this object.
	};
	$args{SMSC_PORT}=~/^\d+$/||do{
	    $self->{WARN}&&warn("Non-numerical data found in entity 'SMSC_PORT' when creating an object of class ".
				__PACKAGE__.
				". Object not created");
	    return;       # Failed to instantiate this object.
	};

	$self->{SMSC_HOST}   = $args{SMSC_HOST};
	$self->{SMSC_PORT}   = $args{SMSC_PORT};
	$self->{SENDER_TEXT} = defined($args{SENDER_TEXT})&&length($args{SENDER_TEXT})?$args{SENDER_TEXT}:__PACKAGE__;

	$self->{SRC_HOST} = $args{SRC_HOST};
	$self->{SRC_PORT} = $args{SRC_PORT};
        # itguru fix
	$self->{SHORT_CODE} = defined($args{SHORT_CODE})&&length($args{SHORT_CODE})?$args{SHORT_CODE}:undef;

	$self->{SOCK} = undef;

	# Some systems have not implemented alarm().
	# On such systems, calling alarm() will create a run-time error.
	# Determine if we dare calling alarm() or not.

	#I must work on it...

	eval{alarm(0)};
	$self->{CAN_ALARM} = $@ ? 0 : 1;
    }

    $self;
}



##RAW MODE

#timeout, action
#clear = 0,1
#################
sub wait_in_loop {
    my ($self) = shift;
    my %arg = @_;
    my ($retval, $bits);

    my $socket = $self->{SOCK};

    if (exists($arg{timeout}) and $arg{timeout} > 0) {
	$SIG{ALRM} = (exists($arg{action}) and ref($arg{action}) eq 'CODE') ? $arg{action} : \&_sig_alarm;
	setitimer(ITIMER_REAL, $arg{timeout}, 0);
    }

    while ($socket) {
	$bits = '';
        vec($bits,fileno($socket),1) = 1;
        $retval = 0;
        $retval = select($bits,undef,undef,undef);

	if ($retval) {
	    my ($buffer,$response);
	    do {
                read($socket,$buffer,1);
                $response.=$buffer;
            } until ($buffer eq ETX);

	    if (exists $arg{clear}) {
		$self->remove_ucp_enclosure(\$response) if ($arg{clear});
	    }

	    setitimer(ITIMER_REAL, $arg{timeout}, 0);
	    return $response;
	}
    }

    setitimer(ITIMER_REAL, $arg{timeout}, 0);
    return undef;
}

sub remove_ucp_enclosure {
    my ($self, $msg) = @_;
    $$msg =~ s/@{[ETX]}|@{[STX]}//g;
}

sub add_ucp_enclosure {
    my ($self, $msg) = @_;
    $$msg = STX . $$msg . ETX;
}

sub _sig_alarm { croak "No response from SMSC\n"; }

#RAW functions
###########################
sub make_message {
    my $self = shift;
    my %arg = @_;

    my $op = $arg{op};
    my $string = undef;

    if ($op eq "01") { $string = $self->make_01(%arg) }
    elsif ($op eq "02") { $string = $self->make_02(%arg) }
    elsif ($op eq "03") { $string = $self->make_03(%arg) }
    elsif ($op eq "30") { $string = $self->make_30(%arg) }
    elsif ($op eq "31") { $string = $self->make_31(%arg) }
    elsif ($op eq "51") { $string = $self->make_51(%arg) }
    elsif ($op eq "52") { $string = $self->make_52(%arg) }
    elsif ($op eq "53") { $string = $self->make_53(%arg) }
    elsif ($op eq "54") { $string = $self->make_54(%arg) }
    elsif ($op eq "55") { $string = $self->make_55(%arg) }
    elsif ($op eq "56") { $string = $self->make_56(%arg) }
    elsif ($op eq "57") { $string = $self->make_57(%arg) }
    elsif ($op eq "58") { $string = $self->make_58(%arg) }
    elsif ($op eq "60") { $string = $self->make_60(%arg) }
    elsif ($op eq "61") { $string = $self->make_61(%arg) }

    return $string;
}

sub parse_message {
    my ($self, $resp) = @_;

    my $ref_mess = undef;

    if (my($optype) = $resp =~ m{^\d{2}/\d{5}/.*?/(01|02|03|30|51|52|53|54|55|56|57|58|60|61)/.*}) {
	my $parse_method = "parse_$optype";
	$ref_mess = $self->$parse_method($resp);
    }

    return $ref_mess;
}

# OPERATION TYPE 01
sub parse_01 {
    my ($self, $response)=@_;
    my %mess;

    my $resp_tmp = $response;
    $resp_tmp =~ s/..$//;
    $mess{my_checksum} = $self->{OBJ_EMI_COMMON}->checksum($resp_tmp);

    my (@ucp) = split(UCP_DELIMITER,$response);

    $mess{trn} = $ucp[0];
    $mess{len} = $ucp[1];
    $mess{type} = $ucp[2];
    $mess{ot} = $ucp[3];

    if ($mess{type} eq "O") {
	$mess{adc} = $ucp[4];
	$mess{oadc} = $ucp[5];
	$mess{ac} = $ucp[6];
	$mess{mt} = $ucp[7];
	$mess{nmsg} = $mess{mt} == 2 ? $ucp[8] : '';
	$mess{amsg} = $mess{mt} == 3 ? $self->{OBJ_EMI_COMMON}->ia5_decode($ucp[8]) : '';
	$mess{checksum} = $ucp[9];
    } else {
	if ($ucp[4] eq ACK) {
	    $mess{ack} = $ucp[4];
	    $mess{sm} = $ucp[5];
	    $mess{checksum} = $ucp[6];
	} else {
	    $mess{nack} = $ucp[4];
	    $mess{ec} = $ucp[5];
	    $mess{sm} = $ucp[6];
	    $mess{checksum} = $ucp[7];
	}
    }

    return \%mess;
}

sub make_01 {
    my ($self) = shift;
    my %arg = @_;

    my $message_string = undef;

    if (exists $arg{operation} and $arg{operation} == 1) {

	my $text = (exists $arg{nmsg} && !exists $arg{amsg})
	    ? $arg{nmsg}
	: $self->{OBJ_EMI_COMMON}->ia5_encode($arg{amsg});

	my $string =
	    (exists $arg{adc} ? $arg{adc} : '') .
	    UCP_DELIMITER .
	    (exists $arg{oadc} ? $arg{oadc} : '') .
	    UCP_DELIMITER .
	    (exists $arg{ac} ? $arg{ac} : '') .
	    UCP_DELIMITER .
	    (exists $arg{mt} ? $arg{mt} : '') .
	    UCP_DELIMITER .
	    $text;

	my $header = sprintf("%02d",$self->{TRN_OBJ}->next_trn()) .
	    UCP_DELIMITER .
	    $self->{OBJ_EMI_COMMON}->data_len($string) .
	    UCP_DELIMITER .
	    'O'.
	    UCP_DELIMITER .
	    '01';

	$message_string = $header.
	    UCP_DELIMITER .
	    $string .
	    UCP_DELIMITER .
	    $self->{OBJ_EMI_COMMON}->checksum($header .
					      UCP_DELIMITER .
					      $string .
					      UCP_DELIMITER);

    } elsif (exists($arg{result}) and $arg{result} == 1) {

	if (exists $arg{ack} and $arg{ack} ne '') {

	    my $string =
		$arg{ack} .
		UCP_DELIMITER .
		(exists $arg{sm} ? $arg{sm} : '');

	    my $header = sprintf("%02d",$arg{trn}) .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->data_len($string) .
		UCP_DELIMITER .
		'R'.
		UCP_DELIMITER .
		'01';

	    $message_string = $header.
		UCP_DELIMITER .
		$string .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->checksum($header .
						  UCP_DELIMITER .
						  $string .
						  UCP_DELIMITER);

	} elsif (exists $arg{nack} and $arg{nack} ne '') {

	    my $string =
		$arg{nack} .
		UCP_DELIMITER .
		(exists $arg{ec} ? $arg{ec} : '') .
	        UCP_DELIMITER .
		(exists $arg{sm} ? $arg{sm} : '');

	    my $header = sprintf("%02d",$arg{trn}) .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->data_len($string) .
		UCP_DELIMITER.
		'R'.
		UCP_DELIMITER.
		'01';

	    $message_string = $header.
		UCP_DELIMITER .
		$string .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->checksum($header .
						  UCP_DELIMITER .
						  $string .
						  UCP_DELIMITER);
	}
    }

    return $message_string;
}

#OP 02
sub parse_02 {
    my ($self, $response)=@_;
    my %mess;

    my $resp_tmp = $response;
    $resp_tmp =~ s/..$//;
    $mess{my_checksum} = $self->{OBJ_EMI_COMMON}->checksum($resp_tmp);

    my (@ucp) = split(UCP_DELIMITER,$response);
    #header...
    $mess{trn} = $ucp[0];
    $mess{len} = $ucp[1];
    $mess{type} = $ucp[2];
    $mess{ot} = $ucp[3];

    if ($mess{type} eq "O") {
	$mess{npl} = $ucp[4];
	$mess{rads} = $ucp[5];
	$mess{oadc} = $ucp[6];
	$mess{ac} = $ucp[7];
	$mess{mt} = $ucp[8];
	$mess{nmsg} = $mess{mt} == 2 ? $ucp[9] : '';
	$mess{amsg} = $mess{mt} == 3 ? $self->{OBJ_EMI_COMMON}->ia5_decode($ucp[9]) : '';
	$mess{checksum} = $ucp[10];
    } else {
	if ($ucp[4] eq ACK) {
	    $mess{ack} = $ucp[4];
	    $mess{sm} = $ucp[5];
	    $mess{checksum} = $ucp[6];
	} else {
	    $mess{nack} = $ucp[4];
	    $mess{ec} = $ucp[5];
	    $mess{sm} = $ucp[6];
	    $mess{checksum} = $ucp[7];
	}
    }

    return \%mess;
}


sub make_02 {
    my ($self) = shift;
    my %arg = @_;

    my $message_string = undef;

    if (exists $arg{operation} and $arg{operation} == 1) {

	my $text = (exists $arg{nmsg} && !exists $arg{amsg})
	    ? $arg{nmsg}
	: $self->{OBJ_EMI_COMMON}->ia5_encode($arg{amsg});

	my $string =
	    (exists $arg{npl} ? $arg{npl} : '') .
	    UCP_DELIMITER .
	    (exists $arg{rads} ? $arg{rads} : '') .
	    UCP_DELIMITER .
	    (exists $arg{oadc} ? $arg{oadc} : '') .
	    UCP_DELIMITER .
	    (exists $arg{ac} ? $arg{ac} : '') .
	    UCP_DELIMITER .
	    (exists $arg{mt} ? $arg{mt} : '') .
	    UCP_DELIMITER .
	    $text;

	my $header = sprintf("%02d",$self->{TRN_OBJ}->next_trn()) .
	    UCP_DELIMITER .
	    $self->{OBJ_EMI_COMMON}->data_len($string) .
	    UCP_DELIMITER.
	    'O'.
	    UCP_DELIMITER.
	    '02';

	$message_string = $header.
	    UCP_DELIMITER .
	    $string .
	    UCP_DELIMITER .
	    $self->{OBJ_EMI_COMMON}->checksum($header .
					      UCP_DELIMITER .
					      $string .
					      UCP_DELIMITER);

    } elsif (exists($arg{result}) and $arg{result} == 1) {

	if (exists $arg{ack} and $arg{ack} ne '') {

	    my $string =
		$arg{ack} .
		UCP_DELIMITER .
		(exists $arg{sm} ? $arg{sm} : '') ;

	    my $header = sprintf("%02d",$arg{trn}) .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->data_len($string) .
		UCP_DELIMITER.
		'R'.
		UCP_DELIMITER.
		'02';

	    $message_string = $header.
		UCP_DELIMITER .
		$string .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->checksum($header .
						  UCP_DELIMITER .
						  $string .
						  UCP_DELIMITER);

	} elsif (exists $arg{nack} and $arg{nack} ne '') {

	    my $string =
		$arg{nack} .
		UCP_DELIMITER .
		(exists $arg{ec} ? $arg{ec} : '') .
		UCP_DELIMITER .
		(exists $arg{sm} ? $arg{sm} : '') ;

	    my $header = sprintf("%02d",$arg{trn}) .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->data_len($string) .
		UCP_DELIMITER.
		'R'.
		UCP_DELIMITER.
		'02';

	    $message_string = $header.
		UCP_DELIMITER .
		$string .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->checksum($header .
						  UCP_DELIMITER .
						  $string .
						  UCP_DELIMITER);
	}
    }

    return $message_string;
}


#OP 03
sub parse_03 {
    my ($self, $response)=@_;
    my %mess ;

    my $resp_tmp = $response;
    $resp_tmp =~ s/..$//;
    $mess{my_checksum} = $self->{OBJ_EMI_COMMON}->checksum($resp_tmp);

    my (@ucp) = split(UCP_DELIMITER,$response);
    #header...
    $mess{trn} = $ucp[0];
    $mess{len} = $ucp[1];
    $mess{type} = $ucp[2];
    $mess{ot} = $ucp[3];

    if ($mess{type} eq "O") {
	$mess{rad} = $ucp[4];
	$mess{oadc} = $ucp[5];
	$mess{ac} = $ucp[6];
	$mess{npl} = $ucp[7]; #must be 0
	$mess{gas} = $ucp[8]; #empty if npl 0
	$mess{rp} = $ucp[9];
	$mess{pr} = $ucp[10];
	$mess{lpr} = $ucp[11];
	$mess{ur} = $ucp[12];
	$mess{lur} = $ucp[13];
	$mess{rc} = $ucp[14];
	$mess{lrc} = $ucp[15];
	$mess{dd} = $ucp[16];
	$mess{ddt} = $ucp[17];
	$mess{mt} = $ucp[18];
	$mess{nmsg} = $mess{mt} == 2 ? $ucp[19] : '';
	$mess{amsg} = $mess{mt} == 3 ? $self->{OBJ_EMI_COMMON}->ia5_decode($ucp[19]) : '';
	$mess{checksum} = $ucp[20];
    } else {
	if ($ucp[4] eq ACK) {
	    $mess{ack} = $ucp[4];
	    $mess{sm} = $ucp[5];
	    $mess{checksum} = $ucp[6];
	} else {
	    $mess{nack} = $ucp[4];
	    $mess{ec} = $ucp[5];
	    $mess{sm} = $ucp[6];
	    $mess{checksum} = $ucp[7];
	}
    }

    return \%mess;
}


sub make_03 {
    my ($self) = shift;
    my %arg = @_;

    my $message_string = undef;

    if (exists $arg{operation} and $arg{operation} == 1) {

	my $text = (exists $arg{nmsg} && !exists $arg{amsg})
	    ? $arg{nmsg}
	: $self->{OBJ_EMI_COMMON}->ia5_encode($arg{amsg});

	my $string =
	    (exists $arg{rad} ? $arg{rad} : '') .
	    UCP_DELIMITER .
	    (exists $arg{oadc} ? $arg{oadc} : '') .
	    UCP_DELIMITER .
	    (exists $arg{ac} ? $arg{ac} : '') .
	    UCP_DELIMITER .
	    (exists $arg{npl} ? $arg{npl} : '') .
	    UCP_DELIMITER .
	    (exists $arg{gas} ? $arg{gas} : '') .
	    UCP_DELIMITER .
	    (exists $arg{rp} ? $arg{rp} : '') .
	    UCP_DELIMITER .
	    (exists $arg{pr} ? $arg{pr} : '') .
	    UCP_DELIMITER .
	    (exists $arg{lpr} ? $arg{lpr} : '') .
	    UCP_DELIMITER .
	    (exists $arg{ur} ? $arg{ur} : '') .
	    UCP_DELIMITER .
	    (exists $arg{lur} ? $arg{lur} : '') .
	    UCP_DELIMITER .
	    (exists $arg{rc} ? $arg{rc} : '') .
	    UCP_DELIMITER .
	    (exists $arg{lrc} ? $arg{lrc} : '') .
	    UCP_DELIMITER .
	    (exists $arg{dd} ? $arg{dd} : '') .
	    UCP_DELIMITER .
	    (exists $arg{ddt} ? $arg{ddt} : '') .
	    UCP_DELIMITER .
	    (exists $arg{mt} ? $arg{mt} : '') .
	    UCP_DELIMITER .
	    $text;

	my $header = sprintf("%02d",$self->{TRN_OBJ}->next_trn()) .
	    UCP_DELIMITER .
	    $self->{OBJ_EMI_COMMON}->data_len($string) .
	    UCP_DELIMITER.
	    'O'.
	    UCP_DELIMITER.
	    '03';

	$message_string = $header.
	    UCP_DELIMITER .
	    $string .
	    UCP_DELIMITER .
	    $self->{OBJ_EMI_COMMON}->checksum($header .
					      UCP_DELIMITER .
					      $string .
					      UCP_DELIMITER);

    } elsif (exists($arg{result}) and $arg{result} == 1) {

	if (exists $arg{ack} and $arg{ack} ne '') {

	    my $string =
		$arg{ack} .
		UCP_DELIMITER .
		(exists $arg{sm} ? $arg{sm} : '');

	    my $header = sprintf("%02d",$arg{trn}) .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->data_len($string) .
		UCP_DELIMITER.
		'R'.
		UCP_DELIMITER.
		'03';

	    $message_string = $header.
		UCP_DELIMITER .
		$string .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->checksum($header .
						  UCP_DELIMITER .
						  $string .
						  UCP_DELIMITER);

	} elsif (exists $arg{nack} and $arg{nack} ne '') {

	    my $string =
		$arg{nack} .
		UCP_DELIMITER .
		(exists $arg{ec} ? $arg{ec} : '') .
		UCP_DELIMITER .
		(exists $arg{sm} ? $arg{sm} : '');

	    my $header = sprintf("%02d",$arg{trn}) .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->data_len($string) .
		UCP_DELIMITER.
		'R'.
		UCP_DELIMITER.
		'03';

	    $message_string = $header.
		UCP_DELIMITER .
		$string .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->checksum($header .
						  UCP_DELIMITER .
						  $string .
						  UCP_DELIMITER);
	}
    }

    return $message_string;
}


#OP 30
sub parse_30 {
    my ($self, $response)=@_;
    my %mess;

    my $resp_tmp = $response;
    $resp_tmp =~ s/..$//;
    $mess{my_checksum} = $self->{OBJ_EMI_COMMON}->checksum($resp_tmp);

    my (@ucp) = split(UCP_DELIMITER,$response);
    #header...
    $mess{trn} = $ucp[0];
    $mess{len} = $ucp[1];
    $mess{type} = $ucp[2];
    $mess{ot} = $ucp[3];

    if ($mess{type} eq "O") {
	$mess{adc} = $ucp[4];
	$mess{oadc} = $ucp[5];
	$mess{ac} = $ucp[6];
	$mess{nrq} = $ucp[7];
	$mess{nad} = $ucp[8];
	$mess{npid} = $ucp[9];
	$mess{dd} = $ucp[10];
	$mess{ddt} = $ucp[11];
	$mess{vp} = $ucp[12];
	$mess{amsg} = $self->{OBJ_EMI_COMMON}->ia5_decode($ucp[13]);
	$mess{checksum} = $ucp[14];
    } else {
	if ($ucp[4] eq ACK) {
	    $mess{ack} = $ucp[4];
	    $mess{mvp} = $ucp[5];
	    $mess{sm} = $ucp[6];
	    $mess{checksum} = $ucp[7];
	} else {
	    $mess{nack} = $ucp[4];
	    $mess{ec} = $ucp[5];
	    $mess{sm} = $ucp[6];
	    $mess{checksum} = $ucp[7];
	}
    }

    return \%mess;
}


sub make_30 {
    my ($self) = shift;
    my %arg = @_;

    my $message_string = undef;

    if (exists $arg{operation} and $arg{operation} == 1) {

	my $text = $self->{OBJ_EMI_COMMON}->ia5_encode($arg{amsg});

	my $string =
	    (exists $arg{adc} ? $arg{adc} : '') .
	    UCP_DELIMITER .
	    (exists $arg{oadc} ? $arg{oadc} : '') .
	    UCP_DELIMITER .
	    (exists $arg{ac} ? $arg{ac} : '') .
	    UCP_DELIMITER .
	    (exists $arg{nrq} ? $arg{nrq} : '') .
	    UCP_DELIMITER .
	    (exists $arg{nad} ? $arg{nad} : '') .
	    UCP_DELIMITER .
	    (exists $arg{npid} ? $arg{npid} : '') .
	    UCP_DELIMITER .
	    (exists $arg{dd} ? $arg{dd} : '') .
	    UCP_DELIMITER .
	    (exists $arg{ddt} ? $arg{ddt} : '') .
	    UCP_DELIMITER .
	    (exists $arg{vp} ? $arg{vp} : '') .
	    UCP_DELIMITER .
	    $text;

	my $header = sprintf("%02d",$self->{TRN_OBJ}->next_trn()) .
	    UCP_DELIMITER .
	    $self->{OBJ_EMI_COMMON}->data_len($string) .
	    UCP_DELIMITER.
	    'O'.
	    UCP_DELIMITER.
	    '30';

	$message_string = $header.
	    UCP_DELIMITER .
	    $string .
	    UCP_DELIMITER .
	    $self->{OBJ_EMI_COMMON}->checksum($header .
					      UCP_DELIMITER .
					      $string .
					      UCP_DELIMITER);

    } elsif (exists($arg{result}) and $arg{result} == 1) {

	if (exists $arg{ack} and $arg{ack} ne '') {

	    my $string =
		$arg{ack} .
		UCP_DELIMITER .
		(exists $arg{mvp} ? $arg{mvp} : '') .
		UCP_DELIMITER .
		(exists $arg{sm} ? $arg{sm} : '') ;

	    my $header = sprintf("%02d",$arg{trn}) .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->data_len($string) .
		UCP_DELIMITER.
		'R'.
		UCP_DELIMITER.
		'30';

	    $message_string = $header.
		UCP_DELIMITER .
		$string .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->checksum($header .
						  UCP_DELIMITER .
						  $string .
						  UCP_DELIMITER);

	} elsif (exists $arg{nack} and $arg{nack} ne '') {

	    my $string =
		$arg{nack} .
		UCP_DELIMITER .
		(exists $arg{ec} ? $arg{ec} : '') .
		UCP_DELIMITER .
		(exists $arg{sm} ? $arg{sm} : '');

	    my $header = sprintf("%02d",$arg{trn}) .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->data_len($string) .
		UCP_DELIMITER.
		'R'.
		UCP_DELIMITER.
		'30';

	    $message_string = $header.
		UCP_DELIMITER .
		$string .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->checksum($header .
						  UCP_DELIMITER .
						  $string .
						  UCP_DELIMITER);
	}
    }

    return $message_string;
}


#OP 31
sub parse_31 {
    my ($self, $response)=@_;
    my %mess;

    my $resp_tmp = $response;
    $resp_tmp =~ s/..$//;
    $mess{my_checksum} = $self->{OBJ_EMI_COMMON}->checksum($resp_tmp);

    my (@ucp) = split(UCP_DELIMITER,$response);
    #header...
    $mess{trn} = $ucp[0];
    $mess{len} = $ucp[1];
    $mess{type} = $ucp[2];
    $mess{ot} = $ucp[3];

    if ($mess{type} eq "O") {
	$mess{adc} = $ucp[4];
	$mess{pid} = $ucp[5];
	$mess{checksum} = $ucp[6];
    } else {
	if ($ucp[4] eq ACK) {
	    $mess{ack} = $ucp[4];
	    $mess{sm} = $ucp[5];
	    $mess{checksum} = $ucp[6];
	} else {
	    $mess{nack} = $ucp[4];
	    $mess{ec} = $ucp[5];
	    $mess{sm} = $ucp[6];
	    $mess{checksum} = $ucp[7];
	}
    }

    return \%mess;
}


sub make_31 {
    my ($self) = shift;
    my %arg = @_;

    my $message_string = undef;

    if (exists $arg{operation} and $arg{operation} == 1) {

	my $string =
	    (exists $arg{adc} ? $arg{adc} : '') .
	    UCP_DELIMITER .
	    (exists $arg{pid} ? $arg{pid} : '') ;

	my $header = sprintf("%02d",$self->{TRN_OBJ}->next_trn()) .
	    UCP_DELIMITER .
	    $self->{OBJ_EMI_COMMON}->data_len($string) .
	    UCP_DELIMITER.
	    'O'.
	    UCP_DELIMITER.
	    '31';

	$message_string = $header.
	    UCP_DELIMITER .
	    $string .
	    UCP_DELIMITER .
	    $self->{OBJ_EMI_COMMON}->checksum($header .
					      UCP_DELIMITER .
					      $string .
					      UCP_DELIMITER);

    } elsif (exists($arg{result}) and $arg{result} == 1) {

	if (exists $arg{ack} and $arg{ack} ne '') {

	    my $string =
		$arg{ack} .
		UCP_DELIMITER .
		(exists $arg{sm} ? $arg{sm} : '') ;

	    my $header = sprintf("%02d",$arg{trn}) .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->data_len($string) .
		UCP_DELIMITER.
		'R'.
		UCP_DELIMITER.
		'31';

	    $message_string = $header.
		UCP_DELIMITER .
		$string .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->checksum($header .
						  UCP_DELIMITER .
						  $string .
						  UCP_DELIMITER);

	} elsif (exists $arg{nack} and $arg{nack} ne '') {

	    my $string =
		$arg{nack} .
		UCP_DELIMITER .
		(exists $arg{ec} ? $arg{ec} : '') .
		UCP_DELIMITER .
		(exists $arg{sm} ? $arg{sm} : '');

	    my $header = sprintf("%02d",$arg{trn}) .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->data_len($string) .
		UCP_DELIMITER.
		'R'.
		UCP_DELIMITER.
		'31';

	    $message_string = $header.
		UCP_DELIMITER .
		$string .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->checksum($header .
						  UCP_DELIMITER .
						  $string .
						  UCP_DELIMITER);
	}
    }

    return $message_string;
}


#OP 5x abstract
sub _parse_5x {
    my ($self, $response)=@_;
    my %mess;

    my $resp_tmp = $response;
    $resp_tmp =~ s/..$//;
    $mess{my_checksum} = $self->{OBJ_EMI_COMMON}->checksum($resp_tmp);

    my (@ucp) = split(UCP_DELIMITER,$response);
    #header...
    $mess{trn} = $ucp[0];
    $mess{len} = $ucp[1];
    $mess{type} = $ucp[2];
    $mess{ot} = $ucp[3];

    if ($mess{type} eq "O") {
	$mess{adc} = $ucp[4];
	$mess{otoa} = $ucp[32];
	$mess{oadc} = ($mess{otoa} eq "5039") ? $self->{OBJ_EMI_COMMON}->decode_7bit(substr($ucp[5],2)) : $ucp[5];
	$mess{ac} = $ucp[6];
	$mess{nrq} = $ucp[7];
	$mess{nadc} = $ucp[8];
	$mess{nt} = $ucp[9];
	$mess{npid} = $ucp[10];
	$mess{lrq} = $ucp[11];
	$mess{lrad} = $ucp[12];
	$mess{lpid} = $ucp[13];
	$mess{dd} = $ucp[14];
	$mess{ddt} = $ucp[15];
	$mess{vp} = $ucp[16];
	$mess{rpid} = $ucp[17];
	$mess{scts} = $ucp[18];
        $mess{dst} = $ucp[19];
	$mess{rsn} = $ucp[20];
	$mess{dscts} = $ucp[21];
	$mess{mt} = $ucp[22];
	$mess{nb} = $ucp[23];
        $mess{nmsg} = $ucp[24] if ($mess{mt} && $mess{mt} == 2);
        $mess{amsg} = $self->{OBJ_EMI_COMMON}->ia5_decode($ucp[24]) if ($mess{mt} && $mess{mt} == 3);
	$mess{tmsg} = $ucp[24] if ($mess{mt} && $mess{mt} == 4);
	$mess{mms} = $ucp[25];
	$mess{pr} = $ucp[26];
	$mess{dcs} = $ucp[27];
	$mess{mcls} = $ucp[28];
	$mess{rpi} = $ucp[29];
	$mess{cpg} = $ucp[30];
	$mess{rply} = $ucp[31];
	$mess{hplmn} = $ucp[33];
	$mess{xser} = $ucp[34];
	$mess{res4} = $ucp[35];
	$mess{res5} = $ucp[36];
	$mess{checksum} = $ucp[37];
    } else {
	if ($ucp[4] eq ACK) {
	    $mess{ack} = $ucp[4];
	    $mess{mvp} = $ucp[5];
	    $mess{sm} = $ucp[6];
	    $mess{checksum} = $ucp[7];
	} else {
	    $mess{nack} = $ucp[4];
	    $mess{ec} = $ucp[5];
	    $mess{sm} = $ucp[6];
	    $mess{checksum} = $ucp[7];
	}
    }

    return \%mess;

}

sub _make_5x {
    my ($self) = shift;
    my $arg = shift;
    my $op_type = shift;

    my $message_string = undef;

    if (exists $arg->{operation} and $arg->{operation} == 1) {

	my $text = '';
	my $from = '';

	if (exists $arg->{amsg}) {
	    $text = $self->{OBJ_EMI_COMMON}->ia5_encode($arg->{amsg});
	} else {
	    $text = exists $arg->{nmsg} && !exists $arg->{tmsg} ? $arg->{nmsg} : $arg->{tmsg};
	}

	$from = $arg->{otoa} eq '5039'
	    ? $self->{OBJ_EMI_COMMON}->encode_7bit($arg->{oadc})
	    : $arg->{oadc}
	if exists $arg->{otoa} ;

	my $string =
	    (exists $arg->{adc} ? $arg->{adc} : '') .
	    UCP_DELIMITER .
	    $from .
	    UCP_DELIMITER .
	    (exists $arg->{ac} ? $arg->{ac} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{nrq} ? $arg->{nrq} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{nadc} ? $arg->{nadc} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{nt} ? $arg->{nt} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{npid} ? $arg->{npid} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{lrq} ? $arg->{lrq} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{lrad} ? $arg->{lrad} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{lpid} ? $arg->{lpid} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{dd} ? $arg->{dd} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{ddt} ? $arg->{ddt} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{vp} ? $arg->{vp} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{rpid} ? $arg->{rpid} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{scts} ? $arg->{scts} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{dst} ? $arg->{dst} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{rsn} ? $arg->{rsn} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{dscts} ? $arg->{dscts} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{mt} ? $arg->{mt} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{nb} ? $arg->{nb} : '') .
	    UCP_DELIMITER .
	    $text .
	    UCP_DELIMITER .
	    (exists $arg->{mms} ? $arg->{mms} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{pr} ? $arg->{pr} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{dcs} ? $arg->{dcs} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{mcls} ? $arg->{mcls} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{rpi} ? $arg->{rpi} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{cpg} ? $arg->{cpg} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{rply} ? $arg->{rply} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{otoa} ? $arg->{otoa} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{hplmn} ? $arg->{hplmn} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{xser} ? $arg->{xser} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{res4} ? $arg->{res4} : '') .
	    UCP_DELIMITER .
	    (exists $arg->{res5} ? $arg->{res5} : '')
	    ;

	my $header = sprintf("%02d",$self->{TRN_OBJ}->next_trn()) .
	    UCP_DELIMITER .
	    $self->{OBJ_EMI_COMMON}->data_len($string) .
	    UCP_DELIMITER.
	    'O'.
	    UCP_DELIMITER.
	    $op_type;

	$message_string = $header.
	    UCP_DELIMITER .
	    $string .
	    UCP_DELIMITER .
	    $self->{OBJ_EMI_COMMON}->checksum($header .
					      UCP_DELIMITER .
					      $string .
					      UCP_DELIMITER);

    } elsif (exists($arg->{result}) and $arg->{result} == 1) {

	if (exists $arg->{ack} and $arg->{ack} ne '') {

	    my $string =
		$arg->{ack} .
		UCP_DELIMITER .
		(exists $arg->{mvp} ? $arg->{mvp} : '') .
	        UCP_DELIMITER .
		(exists $arg->{sm} ? $arg->{sm} : '') ;

	    my $header = sprintf("%02d",$arg->{trn}) .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->data_len($string) .
		UCP_DELIMITER.
		'R'.
		UCP_DELIMITER.
		$op_type;

	    $message_string = $header.
		UCP_DELIMITER .
		$string .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->checksum($header .
						  UCP_DELIMITER .
						  $string .
						  UCP_DELIMITER);

	} elsif (exists $arg->{nack} and $arg->{nack} ne '') {

	    my $string =
		$arg->{nack} .
		UCP_DELIMITER .
		(exists $arg->{ec} ? $arg->{ec} : '') .
		UCP_DELIMITER .
		(exists $arg->{sm} ? $arg->{sm} : '') ;

	    my $header = sprintf("%02d",$arg->{trn}) .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->data_len($string) .
		UCP_DELIMITER.
		'R'.
		UCP_DELIMITER.
		$op_type;

	    $message_string = $header.
		UCP_DELIMITER .
		$string .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->checksum($header .
						  UCP_DELIMITER .
						  $string .
						  UCP_DELIMITER);
	}
    }

    return $message_string;
}

#submit
sub parse_51 {
    my ($self, $response)=@_;
    return $self->_parse_5x($response);
}

#OP 52 delivery short message
sub parse_52 {
    my ($self, $response)=@_;
    return $self->_parse_5x($response);
}

sub parse_53 {
    my ($self, $response)=@_;
    return $self->_parse_5x($response);
}

sub parse_54 {
    my ($self, $response)=@_;
    return $self->_parse_5x($response);
}

sub parse_55 {
    my ($self, $response)=@_;
    return $self->_parse_5x($response);
}

sub parse_56 {
    my ($self, $response)=@_;
    return $self->_parse_5x($response);
}

sub parse_57 {
    my ($self, $response)=@_;
    return $self->_parse_5x($response);
}

sub parse_58 {
    my ($self, $response)=@_;
    return $self->_parse_5x($response);
}

sub make_51 {
    my ($self) = shift;
    my %arg = @_;
    return $self->_make_5x(\%arg,'51');
}

sub make_52 {
    my ($self) = shift;
    my %arg = @_;
    return $self->_make_5x(\%arg,'52');
}

sub make_53 {
    my ($self) = shift;
    my %arg = @_;
    return $self->_make_5x(\%arg,'53');
}

sub make_54 {
    my ($self) = shift;
    my %arg = @_;
    return $self->_make_5x(\%arg,'54');
}

sub make_55 {
    my ($self) = shift;
    my %arg = @_;
    return $self->_make_5x(\%arg,'55');
}

sub make_56 {
    my ($self) = shift;
    my %arg = @_;
    return $self->_make_5x(\%arg,'56');
}

sub make_57 {
    my ($self) = shift;
    my %arg = @_;
    return $self->_make_5x(\%arg,'57');
}

sub make_58 {
    my ($self) = shift;
    my %arg = @_;
    return $self->_make_5x(\%arg,'58');
}


#OP 60 abstract
sub parse_60 {
    my ($self, $response)=@_;
    my %mess;

    my $resp_tmp = $response;
    $resp_tmp =~ s/..$//;
    $mess{my_checksum} = $self->{OBJ_EMI_COMMON}->checksum($resp_tmp);

    my (@ucp) = split(UCP_DELIMITER,$response);
    #header...
    $mess{trn}  = $ucp[0];
    $mess{len}  = $ucp[1];
    $mess{type} = $ucp[2];
    $mess{ot}   = $ucp[3];

    if ($mess{type} eq "O") {
	$mess{oadc} = $ucp[4];
	$mess{oton} = $ucp[5];
	$mess{onpi} = $ucp[6];
	$mess{styp} = $ucp[7];
	$mess{pwd} = $self->{OBJ_EMI_COMMON}->ia5_decode($ucp[8]);
	$mess{npwd} = $self->{OBJ_EMI_COMMON}->ia5_decode($ucp[9]);
	$mess{vers} = $ucp[10];
	$mess{ladc} = $ucp[11];
	$mess{lton} = $ucp[12];
	$mess{lnpi} = $ucp[13];
	$mess{opid} = $ucp[14];
	$mess{res1} = $ucp[15];
	$mess{checksum} = $ucp[16];
    } else {
	if ($ucp[4] eq ACK) {
	    $mess{ack} = $ucp[4];
	    $mess{sm} = $ucp[5];
	    $mess{checksum} = $ucp[6];
	} else {
	    $mess{nack} = $ucp[4];
	    $mess{ec} = $ucp[5];
	    $mess{sm} = $ucp[6];
	    $mess{checksum} = $ucp[7];
	}
    }

    return \%mess;
}

sub parse_61 {
    my ($self, $response)=@_;
    return $self->parse_60($response);
}


sub make_60 {
    my ($self) = shift;
    my %arg = @_;

    my $message_string = undef;

    if (exists $arg{operation} and $arg{operation} == 1) {

	my $string =
	    (exists $arg{oadc} ? $arg{oadc} : '') .
	    UCP_DELIMITER .
	    (exists $arg{oton} ? $arg{oton} : '') .
	    UCP_DELIMITER .
	    (exists $arg{onpi} ? $arg{onpi} : '') .
	    UCP_DELIMITER .
	    (exists $arg{styp} ? $arg{styp} : '') .
	    UCP_DELIMITER .
	    (exists $arg{pwd} ? $self->{OBJ_EMI_COMMON}->ia5_encode($arg{pwd}) : '') .
	    UCP_DELIMITER .
	    (exists $arg{npwd} ? $self->{OBJ_EMI_COMMON}->ia5_encode($arg{npwd}) : '') .
	    UCP_DELIMITER .
	    (exists $arg{vers} ? $arg{vers} : '') .
	    UCP_DELIMITER .
	    (exists $arg{ladc} ? $arg{ladc} : '') .
	    UCP_DELIMITER .
	    (exists $arg{lton} ? $arg{lton} : '') .
	    UCP_DELIMITER .
	    (exists $arg{lnpi} ? $arg{lnpi} : '') .
	    UCP_DELIMITER .
	    (exists $arg{opid} ? $arg{opid} : '') .
	    UCP_DELIMITER .
	    (exists $arg{res1} ? $arg{res1} : '') ;

	my $header = sprintf("%02d",$self->{TRN_OBJ}->next_trn()) .
	    UCP_DELIMITER .
	    $self->{OBJ_EMI_COMMON}->data_len($string) .
	    UCP_DELIMITER.
	    'O'.
	    UCP_DELIMITER.
	    '60';

	$message_string = $header.
	    UCP_DELIMITER .
	    $string .
	    UCP_DELIMITER .
	    $self->{OBJ_EMI_COMMON}->checksum($header .
					      UCP_DELIMITER .
					      $string .
					      UCP_DELIMITER);

    } elsif (exists($arg{result}) and $arg{result} == 1) {

	if (exists $arg{ack} and $arg{ack} ne '') {

	    my $string =
		$arg{ack} .
		UCP_DELIMITER .
		(exists $arg{sm} ? $arg{sm} : '') ;

	    my $header = sprintf("%02d",$arg{trn}) .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->data_len($string) .
		UCP_DELIMITER.
		'R'.
		UCP_DELIMITER.
		'60';

	    $message_string = $header.
		UCP_DELIMITER .
		$string .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->checksum($header .
						  UCP_DELIMITER .
						  $string .
						  UCP_DELIMITER);

	} elsif (exists $arg{nack} and $arg{nack} ne '') {

	    my $string =
		$arg{nack} .
		UCP_DELIMITER .
		(exists $arg{ec} ? $arg{ec} : '') .
		UCP_DELIMITER .
		(exists $arg{sm} ? $arg{sm} : '') ;

	    my $header = sprintf("%02d",$arg{trn}) .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->data_len($string) .
		UCP_DELIMITER.
		'R'.
		UCP_DELIMITER.
		'60';

	    $message_string = $header.
		UCP_DELIMITER .
		$string .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->checksum($header .
						  UCP_DELIMITER .
						  $string .
						  UCP_DELIMITER);
	}
    }

    return $message_string;
}


sub make_61 {
    my ($self) = shift;
    my %arg = @_;

    my $message_string = undef;

    if (exists $arg{operation} and $arg{operation} == 1) {

	my $string =
	    (exists $arg{oadc} ? $arg{oadc} : '') .
	    UCP_DELIMITER .
	    (exists $arg{oton} ? $arg{oton} : '') .
	    UCP_DELIMITER .
	    (exists $arg{onpi} ? $arg{onpi} : '') .
	    UCP_DELIMITER .
	    (exists $arg{styp} ? $arg{styp} : '') .
	    UCP_DELIMITER .
	    (exists $arg{pwd} ? $self->{OBJ_EMI_COMMON}->ia5_encode($arg{pwd}) : '') .
	    UCP_DELIMITER .
	    (exists $arg{npwd} ? $self->{OBJ_EMI_COMMON}->ia5_encode($arg{npwd}) : '') .
	    UCP_DELIMITER .
	    (exists $arg{vers} ? $arg{vers} : '') .
	    UCP_DELIMITER .
	    (exists $arg{ladc} ? $arg{ladc} : '') .
	    UCP_DELIMITER .
	    (exists $arg{lton} ? $arg{lton} : '') .
	    UCP_DELIMITER .
	    (exists $arg{lnpi} ? $arg{lnpi} : '') .
	    UCP_DELIMITER .
	    (exists $arg{opid} ? $arg{opid} : '') .
	    UCP_DELIMITER .
	    (exists $arg{res1} ? $arg{res1} : '') .
	    UCP_DELIMITER .
	    (exists $arg{res2} ? $arg{res2} : '') ;

	my $header = sprintf("%02d",$self->{TRN_OBJ}->next_trn()) .
	    UCP_DELIMITER .
	    $self->{OBJ_EMI_COMMON}->data_len($string) .
	    UCP_DELIMITER.
	    'O'.
	    UCP_DELIMITER.
	    '61';

	$message_string = $header.
	    UCP_DELIMITER .
	    $string .
	    UCP_DELIMITER .
	    $self->{OBJ_EMI_COMMON}->checksum($header .
					      UCP_DELIMITER .
					      $string .
					      UCP_DELIMITER);

    } elsif (exists($arg{result}) and $arg{result} == 1) {

	if (exists $arg{ack} and $arg{ack} ne '') {

	    my $string =
		$arg{ack} .
		UCP_DELIMITER .
		(exists $arg{sm} ? $arg{sm} : '') ;

	    my $header = sprintf("%02d",$arg{trn}) .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->data_len($string) .
		UCP_DELIMITER.
		'R'.
		UCP_DELIMITER.
		'61';

	    $message_string = $header.
		UCP_DELIMITER .
		$string .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->checksum($header .
						  UCP_DELIMITER .
						  $string .
						  UCP_DELIMITER);

	} elsif (exists $arg{nack} and $arg{nack} ne '') {

	    my $string =
		$arg{nack} .
		UCP_DELIMITER .
		(exists $arg{ec} ? $arg{ec} : '') .
		UCP_DELIMITER .
		(exists $arg{sm} ? $arg{sm} : '') ;

	    my $header = sprintf("%02d",$arg{trn}) .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->data_len($string) .
		UCP_DELIMITER.
		'R'.
		UCP_DELIMITER.
		'61';

	    $message_string = $header.
		UCP_DELIMITER .
		$string .
		UCP_DELIMITER .
		$self->{OBJ_EMI_COMMON}->checksum($header .
						  UCP_DELIMITER .
						  $string .
						  UCP_DELIMITER);
	}
    }

    return $message_string;
}

#it doesn't get response!
#param : host, port, listen
#param : output, action, sending
#param : reading_mode  (0 = line feed at the end, 1 = reading defined message length - default 1Kb)
#param  : max_len (for reading_mode = 1)
##################################
sub create_fake_smsc {
    my $self = shift;
    my %opt = @_;

    my $remote_socket = undef;

    my $main_socket = new IO::Socket::INET (LocalHost => exists $opt{host} && $opt{host} ne '' ? $opt{host} : '127.0.0.1',
					    LocalPort => exists $opt{port} && $opt{port} ne '' ? $opt{port} : 6666,
					    Listen => exists $opt{listen} ? $opt{listen} : 5,
					    Proto => 'tcp',
					    Reuse => 1,
					    );
    croak "Fake SMSC could not be created, [$!]\n" unless ($main_socket);


    my $debug = (exists $opt{output} and $opt{output} == 1) ? 1 : 0;

    my $reading_mode = 0;
    if (exists $opt{reading_mode}) {
	if ($opt{reading_mode} != 0 && $opt{reading_mode} != 1) {
	    $reading_mode = 0;
	} else {
	    $reading_mode = $opt{reading_mode};
	}
    }

    my $max_len = (exists $opt{max_len} and $opt{max_len} >= 1) ? $opt{max_len} : 1024;

    my $readable_handles = new IO::Select();
    $readable_handles->add($main_socket);

    my ($sock, $new_sock);

    while (1) {
	my ($new_readable) = IO::Select->select($readable_handles, undef, undef, undef);
	foreach $sock (@$new_readable) {
	    if ($sock == $main_socket) {
		$new_sock = $sock->accept();
		$readable_handles->add($new_sock);
	    } else {

		print "[*] Reading on socket [$sock]\n" if $debug;
		my $message = 0;

		$message = <$sock> if (!$reading_mode);
		$sock->recv($message, $max_len) if ($reading_mode == 1);

		if ($message) {
		    $message =~ s/[\n\r]//g;
		    if ($debug) {
			print "\n\n[*] UCP string -\n";
			print "-"x30;
			print "\n" . $message . "\n";
			print "-"x30;
			print "\n";
		    }

		    if (exists $opt{action} and ref($opt{action}) eq "CODE") {
			my $resp_be = $opt{action}($message);
			print $sock $resp_be if (defined($resp_be) && ($resp_be ne ''));

			if (exists $opt{sending} and ref($opt{sending}) eq "CODE") {
			    my $next_ucp_message = $opt{sending}();
			    print $sock $next_ucp_message if (defined($next_ucp_message) && ($next_ucp_message ne ''));
                        }

		    } else {
			my $response = $self->parse_message($message);
			if (ref($response) eq "HASH") {
			    foreach my $k (keys %{$response}) {
				print "\nP.Name: [$k] - Value:\t$response->{$k}" if $debug;
			    }
			} else {
			    print "Error while parsing message\n";
			}
		    }
		} else {

		    print "[*] Closing socket [$sock]\n" if $debug;
		    $readable_handles->remove($sock);
		    close($sock);

		}
	    }
	}
    }

    return;
}

sub transmit_msg {
    my($self, $message_string, $timeout, $need_resp) = @_;

    my($rd,$buffer,$response,$acknack,$errcode,$errtxt,$ack);

    defined($timeout) || do{ $timeout = 0 };

    if (!defined($self->{SOCK})) {
	die "Unable to send message : smsc socket is not initialized, maybe u are using it in FAKE mode... ";
    }
    my $enclosed = STX . $message_string . ETX;

    print {$self->{SOCK}} $enclosed || do {
        $errtxt = "Failed to print to SMSC socket. Remote end closed?";
        $self->{WARN} && warn($errtxt);
        return(defined(wantarray) ? wantarray?(undef,0,$errtxt) : undef : undef);
    };

    $self->{SOCK}->flush();

    if ($need_resp == 1) {
	do  {
	    # If this system implements alarm(), we will do a non-blocking read.
	    if($self->{CAN_ALARM}) {
		eval {
		    $rd=undef;
		    local($SIG{ALRM})=sub{die("alarm\n")}; # NB: \n required
		    alarm($timeout);
		    $rd=read($self->{SOCK},$buffer,1);
		    alarm(0);
		};
		# Propagate unexpected errors.
		$@&&$@ne"alarm\n"&&die($@);
	    }
	    else {
		# No alarm() implemented. Must do a (potentially) blocking call to read().
		$rd=read($self->{SOCK},$buffer,1);
	    }
	    defined($rd)||do{ # undef, read error.
		$errtxt="Failed to read from SMSC socket. Never received ETX. Remote end closed?";
		$self->{WARN}&&warn($errtxt);
		return(defined(wantarray)?wantarray?(undef,0,$errtxt):undef:undef);
	    };
	    $rd||do{ # Zero, end of 'file'.
		$errtxt="Never received ETX from SMSC. Remote end closed?";
		$self->{WARN}&&warn($errtxt);
		return(defined(wantarray)?wantarray?(undef,0,$errtxt):undef:undef);
	    };
	    $response.=$buffer;
	}   until($buffer eq ETX);

	(undef,undef,undef,undef,$acknack,$errcode,$errtxt,undef)=split(UCP_DELIMITER, $response);
	if($acknack eq ACK) {
	    ($ack,$errcode,$errtxt)=(TRUE,0,'');
	}
	else {
	    $ack    = 0;
	    $errtxt =~ s/^\s+//;
	    $errtxt =~ s/\s+$//;
	}

	$errtxt .= "\nSent : " . $message_string . "\nReceive : " . $response . "\n";
	defined(wantarray) ? wantarray ? ($ack, $errcode, $errtxt) : $ack : undef;

    } else {
	defined(wantarray) ? wantarray ? (undef, undef, undef) : undef : undef;
    }

}

1;

__END__