File Coverage

blib/lib/Net/UCP/Common.pm

Criterion	Covered	Total	%
statement	69	95	72.6
branch	6	16	37.5
condition	3	13	23.0
subroutine	17	21	80.9
pod	0	10	0.0
total	95	155	61.2

package Net::UCP::Common;

use 5.008007;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw(STX ETX UCP_DELIMITER DEF_SMSC_PORT ACK NACK DEBUG) ] );
our @EXPORT_OK   = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT      = qw();

our $VERSION = '0.05';

use constant STX           => chr(2);
use constant ETX           => chr(3);
use constant UCP_DELIMITER => '/';
use constant DEF_SMSC_PORT => 3024;
use constant ACK           => 'A';
use constant NACK          => 'N';

use constant DEBUG         => 0;

sub new {
    my $self = {};
    bless($self, shift())->_init(@_);
}

# Calculate packet checksum
sub checksum {
    shift;

    my $checksum;

    defined($_[0]) || return(0);
    map {$checksum += ord} (split //,pop @_);
    sprintf("%02X", $checksum%256);

}

# Calculate data length
sub data_len {
    shift;

    defined($_[0]) || return(0);
    my $len = length(pop @_) + 17;
    for(1..(5-length($len))) {
        $len = '0' . $len;
    }

    $len;
}

sub decode_7bit {
    shift;

    my ($oadc) = shift;
    my ($msg,$bits);
    my $cnt = 0;
    my $ud  = $oadc || "";
    my $len = length($ud);
    $msg    = "";

    my $byte = unpack('b8', pack('H2', substr($ud, 0, 2)));

    while (($cnt < length($ud)) && (length($msg) < $len)) {
        $msg .= pack('b7', $byte);
        $byte = substr($byte,7,length($byte)-7);
        if ( (length( $byte ) < 7) ) {
            $cnt+=2;
            $byte = $byte.unpack('b8', pack('H2', substr($ud, $cnt, 2)));
        }
    }

    return $msg;
}

#use Encode is the best solution
sub encode_7bit {
    my($self, $msg) = @_;

    my($bit_string, $user_data) = ('','');
    my($octet, $rest);

    defined($msg) && length($msg) || return('00');   # Zero length user data.

    for(split(//,$msg)) {
        $bit_string.=unpack('b7',$_);
    }

    while(defined($bit_string) && (length($bit_string))) {
        $rest = $octet = substr($bit_string,0,8);
        $user_data .= unpack("H2",pack("b8",substr($octet.'0'x7,0,8)));
        $bit_string = (length($bit_string) > 8) ? substr($bit_string,8) : '';
    }

    sprintf("%02X", length($rest) < 5 ? length($user_data)-1 : length($user_data)).uc($user_data);
}

sub convert_sms_to_ascii {
    my $self = shift;
    my $msg = shift;

    $msg =~ tr{\x00\x02\x05\x04\x06\x07\x08\x11\x5f\x7f}
    {\x40\x24\xe8\xe9\xf9\xec\xf2\x5f\xa7\xe0} if defined $msg;

    return $msg;
}


sub convert_ascii_to_sms {
    my $self = shift;
    my $msg = shift;

    $msg =~ tr{\x40\x24\xe8\xe9\xf9\xec\xf2\x5f\xa7\xe0}
    {\x00\x02\x05\x04\x06\x07\x08\x11\x5f\x7f} if defined $msg;

    return $msg;
}


sub ia5_decode {
    my ($self, $msg) = @_;

    my $tmp = "";
    my $out = "";

    while (length($msg)) {
        ($tmp,$msg) = ($msg =~ /(..)(.*)/);
        $out .= sprintf("%s", chr(hex($tmp)));
    }

    return $out;
}

sub ia5_encode { shift; join('',map {sprintf "%02X", ord} split(//,pop(@_))); }

sub error_by_code {
    my $self = shift;

    my $ec = shift || '';
    return $self->{EC}->{$ec};
}

sub _init {
    my $self = shift;

    my %ec_string = (
		     ''   => 'Unknown error code',
		     '01' => 'Checksum error',
		     '02' => 'Syntax error',
		     '04' => 'Operation not allowed (at this point in time)',
		     '05' => 'Call barring active',
		     '06' => 'AdC invalid',
		     '07' => 'Authentication failure',
		     '08' => 'Legitimisation code for all calls, failure',
		     '24' => 'Message too long',
		     '26' => 'Message type not valid for the pager type',
		     );

    $self->{EC} = %ec_string;
    $self;
}


1;
__END__