/usr/local/CPAN/Device-Gsm/Sms/Token/SCA.pm


# Sms::Token::SCA - SMS SCA token (service center address)
# Copyright (C) 2002-2006 Cosimo Streppone, cosimo@cpan.org
#
# This program is free software; you can redistribute it and/or modify
# it only under the terms of Perl itself.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# Perl licensing terms for details.
#
# $Id$

package Sms::Token::SCA;
use integer;
use strict;
use Device::Gsm::Sms::Token;

@Sms::Token::SCA::ISA = ('Sms::Token');

# takes (scalar message (string) reference)
# returns success/failure of decoding
# if all ok, removes SCA from message
sub decode {
	my($self, $rMessage) = @_;
	my $ok = 0;
	my($length, $type, $address);
	my $msg = $$rMessage;
	my $msg_copy = $msg;

	# .------------.----------.---------------------------------.
	# | LENGTH (1) | TYPE (1) | ADDRESS BCD DIGITS (0-8 octets) |
	# `------------'----------'---------------------------------'
	$length = substr $msg, 0, 2;

	# If length is `00', SCA = default end decoding ends
	if( $length eq '00' ) {
		$self->data( '' );
		$self->state( Sms::Token::DECODED );
		# Remove length-octet read from message
		$$rMessage = substr( $$rMessage, 2 );
		return 1;
	}

	# Begin decoding (length is number of octets for the SCA + 1 (length) )
	$length = hex $length;

	# Length > 9 is impossible; max is 8 + 1 (length)
	if( $length > 9 ) {
		$self->data( undef );
		$self->state( Sms::Token::ERROR );
		return 0;
	}

	$self->set( 'length' => $length );

	# Get type of message (81 = national, 91 = international)
	$type = substr $msg, 2, 2;
	if( $type ne '81' and $type ne '91' ) {
		$self->data( undef );
		$self->state( Sms::Token::ERROR );
		return 0;
	}

	$self->set( type => $type );

	# Get rest of address
	$address = substr $msg, 4, ( ($length - 1) << 1 );

	# Reverse each pair of bcd digits
	my $sca;
	while( $address ) {
		$sca .= reverse substr( $address, 0, 2 );
		$address = substr $address, 2;
	}

	# Truncate last `F' if found (XXX)
	chop $sca if substr($sca, -1) eq 'F';

	# If sca is international, put a '+' sign before
	$sca = '+'.$sca if $type eq '91';

	$self->data( $sca );
	$self->set( type => $type );
	$self->set( 'length' => $length );
	$self->state( Sms::Token::DECODED );

	# Remove SCA info from message
	$$rMessage = substr( $msg, ($length + 1) << 1 );

	return 1;
}

#
# [token]->encode( [$data] )
#
# takes internal token data and encodes it, returning the result
# or undef value in case of errors
#
sub encode {
	my $self = shift;

	# Take supplied data (optional) or object internal data
	my $data = shift;
	if( ! defined $data || $data eq '' ) {
		$data = $self->data();
	}

	# Begin encoding as SCA
	$data =~ s/\s+//g;

	my $type = index($data,'+') == 0 ? 91 : 81;

	# Remove all non-numbers
	$data =~ s/\D//g;

	my $len  = unpack 'H2' => chr( length $data );

	$data .= 'F';
	my @digit = split // => $data;
	my $encoded;

	while( @digit > 1 ) {
		$encoded .= join '', reverse splice @digit, 0, 2;
	}

	$data = uc $len . $type . $encoded;

	$self->data( $data );
	$self->set( 'length' => $len );
	$self->set( 'type'   => $type );
	$self->state( Sms::Token::ENCODED );

	return $data;

}

1;