File Coverage

blib/lib/Mollie/Micropayment.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package Mollie::Micropayment;

use strict;
use warnings;

use Carp;
use LWP::Simple;
use XML::Simple;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Mollie::Micropayment ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);

our $VERSION = '0.04';


##################################################
# Object constructor
##################################################
sub new {
	my($class,$wordlist,$replacement) = @_;
	my $self = { };

	# default vars
	$self->{'partnerid'}		= undef;
	$self->{'amount'}			= 1.30;
	$self->{'report'}			= undef;
	$self->{'country'}			= 31;
	$self->{'servicenumber'}	= undef;
	$self->{'paycode'}			= undef;
	$self->{'duration'}			= undef;
	$self->{'mode'}				= undef;
	$self->{'costperminute'}	= undef;
	$self->{'costpercall'}		= undef;
	$self->{'currency'}			= undef;

	# after a paycheck is done, we can use these vars
	$self->{'payed'}			= "false";
 	$self->{'durationdone'}		= 0;
 	$self->{'durationleft'}		= undef;
 	$self->{'paystatus'}		= undef;


	# And I give you my blessing
	return bless $self,$class;

}

##################################################
# For debugging purposes only!
##################################################
sub printenv {
	my $self = shift;
	warn __PACKAGE__ . '->printenv() has been deprecated and will be removed in the future!';
	foreach my $key(sort(keys(%{$self}))) {
		print $key . ": " . $self->{$key} . "\n";
	}
}

##################################################
# Set/gets the partnerid gotten from Mollie
##################################################
sub partnerid {
	my $self = shift;
	if (@_) { $self->{"partnerid"} = shift }
	return $self->{"partnerid"};
}

##################################################
# Set/gets the amount the user has to pay
# Amount can be a float (0.00) but must be over
# 0.40 because Mollie doesn't accept amounts
# lower than 0.41
##################################################
sub amount {
	my($self,$amount) = @_;
	if ($amount > 0 || $amount eq "endless") {
	    $self->{'amount'} = $amount;
	} elsif(length($amount) == 0) {
		# It's ok, user is asking the amount
	} else {
		croak("False amount has been set. Only 'endless' or a numeric value can be set.");
	}
	return $self->{'amount'};
}

##################################################
# Sets country code. Also checks if code is OK
##################################################
sub country {
	my($self,$country) = @_;


	my %codes;
	$codes{'31'} = "NL";
	$codes{'32'} = "BE";
	$codes{'33'} = "FR";
	$codes{'39'} = "IT";
	$codes{'41'} = "CH";
	$codes{'43'} = "AT";
	$codes{'44'} = "UK";
	$codes{'49'} = "DE";

	if (int($country) && exists($codes{$country})) {
	    $self->{'country'} = $country;
	} else {
		croak("False country code used.");
	}
}

##################################################
# Sets/gets the report URL. Can be used to let Mollie
# send a response to the adres(url) in $adres
##################################################
sub reporturl {
	my $self = shift;
	if (@_) { $self->{"report"} = shift }
	return $self->{"report"};
}

##################################################
# Sets/gets the servicenumber
##################################################
sub servicenumber {
	my $self = shift;
	if (@_) { $self->{"servicenumber"} = shift }
	return $self->{"servicenumber"};
}

##################################################
# Sets/gets paycode
##################################################
sub paycode {
	my $self = shift;
	if (@_) { $self->{"paycode"} = shift }
	return $self->{"paycode"};
}

##################################################
# Get payment info from Mollie
##################################################
sub payinfo {
	my $self = shift;
	my $response = get(	"http://www.mollie.nl/xml/micropayment/" .
						"?a=fetch" .
						"&partnerid=" 		. CGI::escape($self->{'partnerid'}) .
						"&amount=" 			. CGI::escape($self->{'amount'}) .
						"&servicenumber=" 	. CGI::escape($self->{'servicenumber'}) .
						"&country=" 		. CGI::escape($self->{'country'}) .
						"&report=" 			. CGI::escape($self->{'report'})
						);

	if(substr($response,0,5) eq "Error") {
		croak("Error while retrieving payment info. Not a valid XML response!");
	}

	my $xs  = XML::Simple->new();
	my $xml = $xs->XMLin($response);

	$self->{'servicenumber'} 	= exists($xml->{'item'}{'servicenumber'}) 	? $xml->{'item'}{'servicenumber'} 	: undef;
	$self->{'paycode'} 			= exists($xml->{'item'}{'paycode'}) 		? $xml->{'item'}{'paycode'} 		: undef;
	$self->{'amount'} 			= exists($xml->{'item'}{'amount'}) 			? $xml->{'item'}{'amount'} 			: 0;
	$self->{'duration'} 		= exists($xml->{'item'}{'duration'}) 		? $xml->{'item'}{'duration'} 		: undef;
	$self->{'mode'} 			= exists($xml->{'item'}{'mode'}) 			? $xml->{'item'}{'mode'} 			: undef;
	$self->{'costperminute'}	= exists($xml->{'item'}{'costperminute'}) 	? $xml->{'item'}{'costperminute'} 	: undef;
	$self->{'costpercall'} 		= exists($xml->{'item'}{'costpercall'}) 	? $xml->{'item'}{'costpercall'} 	: undef;
	$self->{'currency'} 		= exists($xml->{'item'}{'currency'}) 		? $xml->{'item'}{'currency'} 		: undef;

	return 1;
}

##################################################
# Check the payment status from Mollie
##################################################
sub checkpayment {
	my $self = shift;
	my $response = get(	"http://www.mollie.nl/xml/micropayment/" .
						"?a=check" .
						"&servicenumber=" 	. CGI::escape($self->{'servicenumber'}) .
						"&paycode=" 		. CGI::escape($self->{'paycode'}));

	if($response eq "Payment unknown.") {
		croak("Error while checking payment. Not a valid XML response!");
	}

	my $xs  = XML::Simple->new();
	my $xml = $xs->XMLin($response);


	$self->{'payed'} 			= exists($xml->{'item'}{'payed'}) 			? $xml->{'item'}{'payed'} 			: "false";
	$self->{'durationdone'} 	= exists($xml->{'item'}{'durationdone'}) 	? $xml->{'item'}{'durationdone'} 	: 0;
	$self->{'durationleft'} 	= exists($xml->{'item'}{'durationleft'}) 	? $xml->{'item'}{'durationleft'} 	: undef;
	$self->{'paystatus'} 		= exists($xml->{'item'}{'paystatus'}) 		? $xml->{'item'}{'paystatus'} 		: undef;
	$self->{'amount'} 			= exists($xml->{'item'}{'amount'}) 			? $xml->{'item'}{'amount'} 			: undef;
	$self->{'duration'} 		= exists($xml->{'item'}{'duration'}) 		? $xml->{'item'}{'duration'} 		: undef;
	$self->{'mode'} 			= exists($xml->{'item'}{'mode'}) 			? $xml->{'item'}{'mode'} 			: undef;
	$self->{'costperminute'} 	= exists($xml->{'item'}{'costperminute'}) 	? $xml->{'item'}{'costperminute'} 	: undef;
	$self->{'costpercall'} 		= exists($xml->{'item'}{'costpercall'}) 	? $xml->{'item'}{'costpercall'} 	: undef;
	$self->{'currency'} 		= exists($xml->{'item'}{'currency'}) 		? $xml->{'item'}{'currency'} 		: undef;

	return $self->{'payed'};
}

##################################################
# Check if user has completed payment or not
##################################################
sub is_payed {
	my $self = shift;
	return $self->{'payed'};
}

##################################################
# Retrieve currency (eur,dollar,gbp)
##################################################
sub currency {
	my $self = shift;
	return $self->{'currency'};
}

##################################################
# Retrieve the mode (ppc or ppm)
##################################################
sub mode {
	my $self = shift;
	return $self->{'mode'};
}

##################################################
# Retrieve cost per call. Only for ppc
##################################################
sub costpercall {
	my $self = shift;
	return $self->{'costpercall'};
}

##################################################
# Retrieve cost per minute. Only for ppm
##################################################
sub costperminute {
	my $self = shift;
	return $self->{'costperminute'};
}

##################################################
# Retrieve duration of call for ppm
##################################################
sub duration {
	my $self = shift;
	return $self->{'duration'};
}


1;
__END__