File Coverage

blib/lib/Business/BancaSella/Encode/Gestpay.pm

Criterion	Covered	Total	%
statement	63	64	98.4
branch	10	14	71.4
condition	6	11	54.5
subroutine	13	14	92.8
pod	3	9	33.3
total	95	112	84.8

package Business::BancaSella::Encode::Gestpay;

push @ISA,'Business::BancaSella::Gestpay';
use Business::BancaSella::Gestpay;
use URI::Escape;
use HTML::Entities;
use Carp;

$VERSION = "0.13";


my $bKeys = {
				currency					=> 'PAY1_UICCODE',
				amount						=> 'PAY1_AMOUNT',
				id							=> 'PAY1_SHOPTRANSACTIONID',
				otp							=> 'PAY1_OTP',
				cardnumber 					=> 'PAY1_CARDNUMBER',
				expmonth 					=> 'PAY1_EXPMONTH',
				expyear  					=> 'PAY1_EXPYEAR',
				name  						=> 'PAY1_CHNAME',
				mail	 					=> 'PAY1_CHMAIL',
				language					=> 'PAY1_IDLANGUAGE',
			};


sub Version { $VERSION; }
require 5.004;
use strict;

my %fields 	=
    (
				base_url		=> 'https://ecomm.sella.it/gestpay/pagam.asp',
				currency		=> 'eur',
     );

my @fields_req	= qw/shopping amount id otp/;

sub new
{
	my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {};
    bless $self,$class;
    $self->init(@_);
    return $self;
}

sub init {
	my $self = shift;
	my (%options) = @_;
	$self->SUPER::init(@_);
	# Assign default options
	while (my ($key,$value) = each(%fields)) {
		$self->{$key} = $self->{$key} || $value;
    }
    # Assign options
    while (my ($key,$value) = each(%options)) {
    	$self->{$key} = $value
    }
    # Check required params
    foreach (@fields_req) {
		croak "You must declare '$_' in " . ref($self) . "::new"
				if (!defined $self->{$_});
	}
}

sub uri {
	my $self 	= shift;
	my $uri 	= 'a=' . $self->shopping . '&b=' . $self->getB;
	#$uri		= uri_escape($uri);
	return  	$self->base_url . '?' . $uri;
}

sub form {
	my $self	= shift;
	my $frmName = shift || '';
	my $ret 	= '
78
					$self->base_url . '">' . "\n";
	$ret		.= '
80
					'">' . "\n";
	$ret		.= '
82
					encode_entities($self->getB) .	'">' . "\n";
	$ret		.= "\n";
}

sub getB {
	my $self 	= shift;
	my @b;
	foreach (keys(%{$bKeys})) {
		my $addValue;
		if (exists($self->{$_}) && defined($self->{$_}) ) {
			$addValue = $self->$_;
			$addValue = valuta_encode($addValue) if ($_ eq 'currency');
			$addValue = lingua_encode($addValue) if ($_ eq 'language');
			push @b,$bKeys->{$_} . '=' . $addValue;
		}
	}
	# add user personal parameters
	while (my ($key,$val) = each %{$self->{user_params}}) {
		push @b, "$key=$val";
	}
	#return join('*P1*',@b);
	return uri_escape(join('*P1*',@b));
}

sub valuta_encode {
	my $valuta	= lc(shift);
	my %vd		= (
					'eur'	=> 242,
					'itl'	=> 18,
					'usd'	=> 1,
					'uk' 	=> 2,
					'yen'	=> 71,
					'hkd' => 103,
					'real' => 234
				);
	die "Unable to encode you currency '$valuta'" if (!exists $vd{$valuta});
	return $vd{$valuta};
}

sub lingua_encode {
	my $lingua	= lc(shift);
	my %ld		= (
					'italian'		=> 1,
					'english'		=> 2,
					'spanish'		=> 3,
					'french'		=> 4
				);
	return $ld{'english'} if (!exists $ld{$lingua});
	return $ld{$lingua};
}

sub base_url { my $s=shift; return @_ ? ($s->{base_url}=shift) : $s->{base_url} }

1;