File Coverage

blib/lib/Net/EMI/Client.pm

Criterion	Covered	Total	%
statement	43	167	25.7
branch	0	116	0.0
condition	0	27	0.0
subroutine	15	30	50.0
pod	5	5	100.0
total	63	345	18.2

package Net::EMI::Client;
use strict;
use Carp;

use vars qw($VERSION);
$VERSION='1.02';

use IO::Socket;
use Net::EMI::Common;

use constant ACK=>'A';
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=>'',
      @_);

   # 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 $data=$args{SMSC_ID}.                                       # OAdC
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         '6'.                                                  # OTON (short number alias)
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         '5'.                                                  # ONPI (private)
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         '1'.                                                  # STYP (open session)
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         $self->{OBJ_EMI_COMMON}->ia5_encode($args{SMSC_PW}).  # PWD
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                                   # NPWD
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         '0100'.                                               # VERS (version)
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                                   # LAdC
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                                   # LTON
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                                   # LNPI
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                                   # OPID
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         '';                                                   # RES1

	my $header=sprintf("%02d",$self->{TRN_OBJ}->next_trn()).       # Transaction counter.
	           $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	           $self->{OBJ_EMI_COMMON}->data_len($data).           # Length.
	           $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	           'O'.                                                # Type (operation).
	           $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	           '60';                                               # OT (Session management).

	my $checksum=$self->{OBJ_EMI_COMMON}->checksum($header.
	                                               $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	                                               $data.
	                                               $self->{OBJ_EMI_COMMON}->UCP_DELIMITER);
	$self->_transmit_msg($header.
	                     $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	                     $data.
	                     $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	                     $checksum,
	                     $self->{TIMEOUT_OBJ}->timeout());
}

#############################################################################################
# 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');
   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 the SMS
sub send_sms {
   my$self=shift();
   my%args=(
      RECIPIENT=>'',
      MESSAGE_TEXT=>'',
      SENDER_TEXT=>'',
      TIMEOUT=>undef,
      @_);
   my$timeout;

   if(defined($args{TIMEOUT})) {
      my$tv=TimeoutValue->new(TIMEOUT=>$args{TIMEOUT});
      $timeout=$tv->timeout();
   }
   else {
      $timeout=$self->{TIMEOUT_OBJ}->timeout();
   }

   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 $data=$args{RECIPIENT}.                               # AdC (Address Code)
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	                                                         # OAdC (Originators Adress Code)
	         # If given, use it. Otherwise use the one given to the constructor.
	         (defined($args{SENDER_TEXT})&&length($args{SENDER_TEXT})?
	            $self->{OBJ_EMI_COMMON}->encode_7bit($args{SENDER_TEXT}):
	            $self->{OBJ_EMI_COMMON}->encode_7bit($self->{SENDER_TEXT})).
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $AC.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # NRq (Notfication Request 1).
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $NAdC.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # NT (Notification Type 3).
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $NPID.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $LRq.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # LRAd (Last Resort Address).
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $LPID.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $DD.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $DDT.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $VP.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $RPID.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $SCTS.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $Dst.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $Rsn.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $DSCTS.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         '3'.                                            # MT (message type, alphanumeric).
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $NB.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         $self->{OBJ_EMI_COMMON}->ia5_encode($args{MESSAGE_TEXT}).
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $MMS.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $PR.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $DCs.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $MCLs.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $RPI.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $CPg.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $RPLy.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         '5039'.                                         # OTOA (Originator Type of Address).
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $HPLMN.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $XSer.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         ''.                                             # $RES4.
	         $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	         '';                                             # $RES5;

	my $header=sprintf("%02d",$self->{TRN_OBJ}->next_trn()). # Transaction counter.
	           $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	           $self->{OBJ_EMI_COMMON}->data_len($data).
	           $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	           'O'.                                          # Type.
	           $self->{OBJ_EMI_COMMON}->UCP_DELIMITER.
	           '51';                                         # OT (submit message)

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

	$self->_transmit_msg($message_string,$timeout);
}

###########################################################################################################
###########################################################################################################
#
# 'Internal' subs. Don't call these since they may, and will, change without notice.
#
###########################################################################################################
###########################################################################################################

###########################################################################################################
sub _init {
   my$self=shift();
   $self->{OBJ_EMI_COMMON}=Net::EMI::Common->new();
   my%args=(
      SMSC_HOST=>'',
      SMSC_PORT=>$self->{OBJ_EMI_COMMON}->DEF_SMSC_PORT,
      SENDER_TEXT=>'',
      WARN=>0,
      TIMEOUT=>undef,
      @_);

   $self->{WARN}=defined($args{WARN})?$args{WARN}?1:0:0;
   $self->{TIMEOUT_OBJ}=TimeoutValue->new(TIMEOUT=>$args{TIMEOUT},
                                          WARN=>$self->{WARN});
   $self->{TRN_OBJ}=TranNbr->new();

   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->{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.
   eval{alarm(0)};
   $self->{CAN_ALARM}=$@?0:1;

   $self;
}

###########################################################################################################
# one step in UCP communication
sub _transmit_msg {
   my($self,$message_string,$timeout)=@_;
	my($rd,$buffer,$response,$acknack,$errcode,$errtxt,$ack);

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

	print {$self->{SOCK}} ($self->{OBJ_EMI_COMMON}->STX.$message_string.$self->{OBJ_EMI_COMMON}->ETX) ||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();

	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 $self->{OBJ_EMI_COMMON}->ETX);

	(undef,undef,undef,undef,$acknack,$errcode,$errtxt,undef)=split($self->{OBJ_EMI_COMMON}->UCP_DELIMITER,$response);
	if($acknack eq ACK) {
	   ($ack,$errcode,$errtxt)=(TRUE,0,'');
	}
	else {
	   $ack=0;
	   $errtxt=~s/^\s+//;
	   $errtxt=~s/\s+$//;
	}
	defined(wantarray)?wantarray?($ack,$errcode,$errtxt):$ack:undef;
}

###########################################################################################################
package TimeoutValue;
use strict;
use Carp;

use constant MIN_TIMEOUT=>0;           # No timeout at all!
use constant DEFAULT_TIMEOUT=>15;
use constant MAX_TIMEOUT=>60;

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

###########################################################################################################
sub timeout {$_[0]->{TIMEOUT};}

###########################################################################################################
sub _init {
   my$self=shift();
   my%args=(
      TIMEOUT=>undef,
      WARN=>0,
      @_);

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

   if(defined($args{TIMEOUT})) {
      if($args{TIMEOUT}=~/\D/) {
         $self->{WARN}&&warn("Non-numerical data found in entity 'TIMEOUT' when creating an object of class ".
                             __PACKAGE__.
                             '. '.
                             'Input data: >'.
                             $args{TIMEOUT}.
                             '< Given TIMEOUT value ignored and default value '.DEFAULT_TIMEOUT.' used instead');
         }
# The commented code will never be executed until we let the MIN_TIMEOUT be greater than zero (since the '-' is non-numeric).
#      elsif($args{TIMEOUT}
#         $self->{WARN}&&warn("Entity 'TIMEOUT' contains a value smaller than the smallest value allowed (".
#                             MIN_TIMEOUT.
#                             ") when creating an object of class ".
#                             __PACKAGE__.
#                             '. Given TIMEOUT value ignored and default value '.DEFAULT_TIMEOUT.' used instead');
#      }
      elsif($args{TIMEOUT}>MAX_TIMEOUT) {
         $self->{WARN}&&warn("Entity 'TIMEOUT' contains a value greater than the largest value allowed (".
                             MAX_TIMEOUT.
                             ") when creating an object of class ".
                             __PACKAGE__.
                             '. Given TIMEOUT value ignored and default value '.DEFAULT_TIMEOUT.' used instead');
      }
      else {
         $self->{TIMEOUT}=$args{TIMEOUT};
      }
   }

   $self;
}

###########################################################################################################
package TranNbr;
use strict;
use constant HIGHEST_NBR=>99;

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

###########################################################################################################
sub next_trn {
   my$self=shift;
   ($self->{TRN}>HIGHEST_NBR)&&do{$self->{TRN}=0};
   $self->{TRN}++;
}

###########################################################################################################
sub reset_trn {
   $_[0]->{TRN}=0;
}

###########################################################################################################
sub _init {
   $_[0]->reset_trn();
   $_[0];
}

'Choppers rule';
__END__