File Coverage

blib/lib/Net/SMS/2Way.pm

Criterion	Covered	Total	%
statement	12	185	6.4
branch	0	88	0.0
condition	0	23	0.0
subroutine	4	14	28.5
pod	6	9	66.6
total	22	319	6.9

package Net::SMS::2Way;

use 5.0;
use strict;
use LWP::UserAgent;
use HTTP::Request;

require Exporter;

our @ISA = qw(Exporter);

our $VERSION = '0.08';		# 21 Jan. 2009

our $urls = {
	ZA => 'http://bulksms.2way.co.za:5567',
	UK => 'http://www.bulksms.co.uk:5567',
	ES => 'http://bulksms.com.es:5567',
	DE => 'http://bulksms.de:5567',
	US => 'http://usa.bulksms.com:5567',
	INT => 'http://bulksms.vsms.net:5567'
};

our $default_options = {
	country => 'ZA',
	quote => 0,
};

our @bulksms_send_options = qw(
	sender msg_class dca want_report routing_group source_id repliable strip_dup_recipients
	stop_dup_id send_time send_time_unixtime scheduling_description test_always_succeed
	test_always_fail allow_concat_text_sms oncat_text_sms_max_parts
);

our $bulk_sms_send_defaults = {};

our @mandatory_options = qw(username password);

sub new
{
	my $class = shift @_;
	my $ref = shift @_;
	my $error;

	$ref->{script} = $0;

	# Get settings from config file
	my $cfg_ref = _parse_config($ref->{config}) if $ref->{config};

	# Merge settings from config so that the config file settings are overwritten
	foreach my $key (keys(%$cfg_ref))
	{
		if ($ref->{$key} eq '')
		{
			$ref->{$key} = $cfg_ref->{$key};
		}
	}

	# Add defaults
	foreach my $key (%$default_options)
	{
		if ($ref->{$key} eq '')
		{
			$ref->{$key} = $default_options->{$key};
		}
	}

	# Add BulkSMS defaults
	foreach my $key (%$bulk_sms_send_defaults)
	{
		if ($ref->{$key} eq '')
		{
			$ref->{$key} = $bulk_sms_send_defaults->{$key};
		}
	}

	#Check mandatory options
	foreach my $key (@mandatory_options)
	{
		if ($ref->{$key} eq '')
		{
			$error .= "Option '$key' does not have a value.\n";
		}
	}

	# Is there a proxy ?
	$ENV{http_proxy} = $ref->{http_proxy} if ($ref->{http_proxy} ne '');

	# Wich base URL to use ?
	$ref->{base_url} = $urls->{$ref->{country}};

	return 0 if $error;

	bless ( $ref, $class );
}

sub send_batch
{
	my $this = shift @_;
	my $data = shift @_;
	my %data = %$data;
	my $csv_data = "msisdn,message\n";
	my $recipient_count = 0;

	foreach my $number ( keys( %data ) )
	{
		$number =~ s/\D//g;			# strip all non-digits
		next if $number !~ /\d/;

		next if ($this->{sa_numbers_only} > 0 && $number !~ /^(27|0[78])/);

		if ($this->{sa_numbers_only} > 0 && $number =~ /^(27[78])/)
		{
			# SA cell prefixes as per http://en.wikipedia.org/wiki/Telephone_numbers_in_South_Africa
			$number =~ s/^0(82|83|84|72|73|74|76|78|79)(\d+)/27$1$2/;
		}

		if ($number eq '')
		{
			$this->{error} = "One of the recipient numbers is invalid: $number";
			return 0;
		}

		$csv_data .= "\"$number\",\"" . $data{$number} . "\"\n";
		$recipient_count++;
	}

	return 0 unless $recipient_count;

	my $url = $this->{base_url} . '/eapi/submission/send_batch/1/1.0';
	my $args = { batch_data => $csv_data };
	my @tmp;

	if (! (@tmp = $this->http_post($url, $args)) )
	{
		$this->send_to_log("WARN: Could not do http_post() for send_batch(): " . $this->{error});
		return 0;
	}

	my $retval = pop( @tmp );
	my $log_mesg = "SMS batch sent. Results: $retval";

	$this->send_to_log( $log_mesg ) if $this->{verbose} > 0;

	return $retval;
}

sub send_sms
{
	my $this = shift @_;
	my $message = shift @_;
	my @recipients = @_;

	# un-comment at your convenience
	#if (!$message) {
	#	$this->{error} = "Message is empty!\n";
	#	return 0;
	#}

	foreach my $number (@recipients)
	{
		$number =~ s/\D//g;			# strip all non-digits
		next if $number !~ /\d/;

		next if ($this->{sa_numbers_only} > 0 && $number !~ /^(27|0[78])/);

		if ($this->{sa_numbers_only} > 0 && $number =~ /^(27[78])/)
		{
			# SA mobile prefixes as per http://en.wikipedia.org/wiki/Telephone_numbers_in_South_Africa
			$number =~ s/^0(82|83|84|72|73|74|76|78|79)(\d+)/27$1$2/;
		}

		if ($number eq '')
		{
			$this->{error} = "One of the recipient numbers is invalid: $number";
			return 0;
		}

	}

	my $args;

	# Extract all the BulkSMS options
	foreach my $option (@bulksms_send_options)
	{
		if ( exists($this->{$option}) && $this->{$option} ne '' )
		{
			$args->{$option} = $this->{$option};
		}
	}

	$args->{msisdn} = join(',', @recipients);
	$args->{message} = $message;

	my @tmp;
	my $url = $this->{base_url} . '/eapi/submission/send_sms/2/2.0';

	if ( $this->{quote} > 0 )
	{
		# This is a hack to get a quote on much credits an SMS will cost
		$url = $this->{base_url} . '/eapi/submission/quote_sms/2/2.0';
	}

	if (! (@tmp = $this->http_post($url, $args)) )
	{
		$this->send_to_log("WARN: Could not do http_post() for send_sms(): " . $this->{error});
		return 0;
	}

	return pop( @tmp ) if $this->{quote} > 0;	# ... for the quote_sms hack

	my $retval = pop( @tmp );
	my $log_mesg = "SMS sent to " . join(',', @recipients) . ". Results: $retval";

	$this->send_to_log( $log_mesg ) if $this->{verbose} > 0;

	return $retval;
}

sub quote_sms
{
	my $this = shift @_;
	my $message = shift @_;
	my @recipients = @_;

	$this->{quote} = 1;

	my $quotation = $this->send_sms($message, @recipients);

	$this->{quote} = 0;

	return $quotation;
}

sub get_credits
{
	my $this = shift @_;
	my $url = $this->{base_url} . '/eapi/user/get_credits/1/1.1';
	my @tmp = $this->http_post($url);

	my ($status, $balance) = split /\|/, pop(@tmp)
		|| ($this->send_to_log("WARN: Could not do http_post() for get_credits(): " . $this->{error}) && return -1);

	return $balance;
}

sub get_inbox
{
	my $this = shift @_;
	my $last_retrieved_id = shift @_;
	my @tmp;

	if ( !defined($last_retrieved_id) )
	{
		$last_retrieved_id = 0;
	}

	my $url = $this->{base_url} . '/eapi/reception/get_inbox/1/1.0';
	my $args = {last_retrieved_id => $last_retrieved_id};

	if (! (@tmp = $this->http_post($url, $args)) )
	{
		$this->send_to_log("WARN: Could not do http_post() for get_inbox(): " . $this->{error});
		return 0;
	}

	my $end_of_headers_marker = 0;
	my @results;

	foreach my $line (@tmp)
	{
		$end_of_headers_marker = 1 if $line =~ /^$/;
		next if $line =~ /^$/;
		push (@results, $line) if $end_of_headers_marker == 1;
	}

	return @results;
}

sub get_report
{
	my $this = shift @_;
	my $batch_id = shift @_;
  	my @tmp;

	if ( !$batch_id )
	{
		$this->{error} = "batch_id was not specified\n";
		return 0;
	}

	my $url = $this->{base_url} .= '/eapi/status_reports/get_report/2/2.0?';
  	my $args = {batch_id => $batch_id, optional_fields => 'body,completed_time,created_time,credits,origin_address,source_id'};

	if (! (@tmp = $this->http_post($url, $args)) )
	{
		$this->send_to_log( "WARN: Could not do http_post() for get_report(): " . $this->{error} );
		return 0;
	}

	my $end_of_headers_marker = 0;
	my @results;

	foreach my $line (@tmp)
	{
		$end_of_headers_marker = 1 if $line =~ /^$/;
		next if $line =~ /^$/;
		push (@results, $line) if $end_of_headers_marker == 1;
	}

	return @results;
}

sub http_post
{
	my $this = shift @_;
	my $url = shift @_;
	my $args = shift @_;

	my $timeout = $this->{timeout} || 30;

	my $uagent = LWP::UserAgent->new(timeout => $timeout);

	if( exists($this->{http_proxy}) && $this->{http_proxy} ne '' )
	{
		$uagent->proxy(['http'], $this->{http_proxy});
	}

  	my $request = HTTP::Request->new(POST => $url);
  	$request->content_type('application/x-www-form-urlencoded');

  	my $content = 'username=' . $this->{username} . '&password=' . $this->{password};

  	foreach my $arg (keys(%$args))
	{
  		$content .= '&' . $arg . '=' . $args->{$arg};
  	}

  	$request->content($content);

	$this->send_to_log("INFO: URL=$url content=$content") if $this->{verbose} > 0;

  	my $response = $uagent->request($request);

	if ($response->is_success)
	{
		my @tmp = split( /\n/, $response->as_string );
		return @tmp;
	}
	elsif ($response->is_error)
	{
		$this->{error} = $response->code . ':' . $response->message . "\n";
		return 0;
	}
	else
	{
		$this->{error} = $response->code . ':' . $response->message . ':' . $response->content . "\n";
		return 0;
	}
}

sub send_to_log
{
	my $this = shift @_;
	my $message = shift @_;

	chomp($message);

	if ($this->{logfile} == -1)
	{
		return 1;
	}

	if ($this->{logfile} eq '')
	{
		$this->{logfile} = "$0.log";
	}

	open (LGFH, ">>".$this->{logfile}) || die "ERROR: Could not open " . $this->{logfile} . ": $!\n";

	print LGFH scalar(localtime()) . " - $message - $0\n";

	close (LGFH);
}

sub _parse_config
{
	my $file = shift @_;
	my $cfg_ref;

	open (CFG, $file) || die "ERROR: Could not open $file: $!\n";

	while ()
	{
		chomp;

		next if /^\s+$/;		# Ignore lines with just whitespace...
		next if /^$/;			# blank lines...
		next if /^#/;			# and lines that start with a comment.

		s/#.*//;			# Strip away all comments

		s/^\s+//;			# Remove leading...
		s/\s+$//;			# ...and trailing whitespace

		s/\s*=\s*/=/;

		my ($var, $val) = split /=/;
		$cfg_ref->{$var} = $val;
	}

	close (CFG);

	return $cfg_ref;
}

1;

__END__