File Coverage

blib/lib/SMS/CPAGateway.pm

Criterion	Covered	Total	%
statement	12	78	15.3
branch	0	20	0.0
condition	0	6	0.0
subroutine	4	11	36.3
pod	1	1	100.0
total	17	116	14.6

#!/usr/bin/perl
# SMS::CPAGateway
#
# Copyright Eskild Hustvedt 2008, 2010
# for Portu Media & Communications
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package SMS::CPAGateway;
use Any::Moose;
use LWP::UserAgent;
use URI::Encode;
use constant { true => 1, false => undef };

our $VERSION = 0.01;

# - Public attributes -

has 'servers' => (
	is => 'rw',
	isa => 'ArrayRef[Str]',
	required => true,
);

has 'fromNo' => (
	isa => 'Int',
	is => 'rw',
	required => true,
);

has 'price' => (
	isa => 'Int',
	is => 'rw',
	required => true,
	default => 0,
);

has 'key' => (
	isa => 'Str',
	required => true,
	is => 'rw',
);

has 'id' => (
	isa => 'Str',
	is => 'rw',
	builder => '_buildID',
	lazy => 1,
);

has 'errors'=> (
	isa => 'ArrayRef[Str]',
	is => 'rw',
	default => sub { [] },
	writer => '_writeErrors',
);

has 'hadError' => (
	isa => 'Bool',
	is => 'rw',
	default => false,
	writer => '_setError',
);

# - Public methods -

# Purpose: Send an SMS
# Usage: object->send(RECIPIENT,MESSAGE,PRICE?);
# RECIPIENT is the recipient phone number, with +XX direction code.
# MESSAGE is the message.
# PRICE is the price
sub send
{
	my $self = shift;
	my $recipient = shift;
	my $message = shift;
	my $price = shift;
	if (not $recipient =~ /^\+/)
	{
		if ($recipient =~ /^00/)
		{
			$recipient =~ s/^00/+/;
		}
		else
		{
			$self->_appendError('Recipient does not start with +');
			return false;
		}
	}
	if(not defined $price)
	{
		$price = $self->price;
	}
	elsif(not $price =~ /^\d+$/)
	{
		$self->_appendError('Illegal price value. "'.$price.'"');
		return false;
	}
	$self->_recipient($recipient);
	return $self->_SMSSend($message,$price);
}

# --- INTERNAL METHODS AND ATTRIBUTES ---

has '_recipient' => (
	isa => 'Str',
	is => 'rw',
);

has '_prevID' => (
	isa => 'Str',
	is => 'rw',
	);

has '_ua' => (
	isa => 'Object',
	is => 'ro',
	lazy => true,
	default => sub { LWP::UserAgent->new() },
);

has '_uriE' => (
	isa => 'Object',
	is => 'ro',
	lazy => true,
	default => sub { URI::Encode->new() },
);

# Purpose: Construct a unique identifier
# Usage: id = this->_buildID();
sub _buildID
{
	my $self = shift;
	my $recipient = $self->_recipient;
	$recipient =~ s/\+/00/;
	my $id;
	# Should be below 100 chars long, so loop until we get it right
	while(!defined $id || length($id) > 99)
	{
		$id = $recipient.'-'.time().int(rand(10_000)).int(rand(100_000)).'-SMS::CPAGateway-'.$VERSION;
	}
	$self->_prevID($id);
	return $id;
}

# Purpose: Get our unique identifier
# Usage: id = self->_getID();
sub _getID
{
	my $self = shift;
	if(
		(not defined $self->_prevID)
			or
		(not $self->_prevID eq $self->id)
	)
	{
		return $self->id;
	}
	$self->id($self->_buildID());
	return $self->id;
}

sub _appendError
{
	my $self = shift;
	my $error = shift;
	my $errorList = $self->errors;
	if (ref($error))
	{
		$error = 'Error reply '.$error->{reply}.' when requesting URL '.$error->{URL}.' at '.time();
	}
	push(@{$errorList},$error);
	$self->_writeErrors($errorList);
	$self->_setError(true);
}

# Purpose: Handle errors in requests
# Usage: my $ret = $self->_errHandler(URI,reply);
#
# This method verifies the content of reply and returns true or false.
# false meaning that sending failed and we should retry. Errors are
# added to the error list via $self->_appendError
sub _errHandler
{
	my $self = shift;
	my $URL = shift;
	my $reply = shift;

	my $content = $reply->content;

	if ($content =~ /^\s*ok/i)
	{
		# All is well
		return true;
	}
	elsif ($content =~ /^\s*err/i)
	{
		$self->_appendError( { URL => $URL, reply => $content } );
		return false;
	}
	else
	{
		# Okay, this server isn't acting properly
		$self->_appendError('The server returned an unknown reply, so I am assuming failure: '.$content);
		return false;
	}
}

# Purpose: Construct the request URI and attempt to submit it to the servers
# Usage: $ret = $self->_SMSSend(message,$price);
sub _SMSSend
{
	my $self = shift;
	my $message = shift;
	my $price = shift;
	# Construct URI
	my $URI = 	'?auth='.$self->_uriE->encode($self->key).
				'&id='.$self->_uriE->encode($self->_getID).
				'&from='.$self->_uriE->encode($self->fromNo).
				'&to='.$self->_uriE->encode($self->_recipient).
				'&type=text&data='.$self->_uriE->encode($message).
				'&price='.$price;

	foreach my $host (@{$self->servers})
	{
		if ($self->_attemptSend($host,$URI))
		{
			# We sent it and all went well
			return true;
		}
		# If not, we didn't send it and we ought to try the next server
	}
	# If we've gotten this far then all servers failed and we have to give up
	$self->_appendError('All servers failed. Giving up.');
	return false;
}

# Purpose: Attempt to send an SMS
# Usage: $ret =  $self->_attemptSend(host,URI);
sub _attemptSend
{
	my $self = shift;
	my $host = shift;
	my $URI = shift;

	my $request = $host.'/'.$URI;

	my $reply = $self->_ua->get($request);
	if ($reply->is_success())
	{
		return $self->_errHandler($request,$reply);
	}
	else
	{
		$self->_appendError('Server '.$host.' failed');
		return false;
	}
}

__PACKAGE__->meta->make_immutable;
1;

__END__