File Coverage

blib/lib/Verotel/FlexPay.pm
Criterion Covered Total %
statement 71 71 100.0
branch 14 14 100.0
condition 5 5 100.0
subroutine 18 18 100.0
pod 6 7 85.7
total 114 115 99.1


line stmt bran cond sub pod time code
1             package Verotel::FlexPay;
2              
3 1     1   161272 use strict;
  1         4  
  1         31  
4 1     1   6 use warnings;
  1         2  
  1         28  
5 1     1   5 use Digest::SHA qw( sha256_hex sha1_hex );
  1         2  
  1         63  
6 1     1   592 use Params::Validate qw(:all);
  1         9439  
  1         216  
7 1     1   625 use URI;
  1         2756  
  1         31  
8 1     1   6 use Carp;
  1         3  
  1         51  
9 1     1   653 use utf8;
  1         14  
  1         5  
10              
11 1     1   37 use base 'Exporter';
  1         2  
  1         1193  
12              
13             # WARNING: Use X.X.X format for $VERSION -> see: https://rt.cpan.org/Public/Bug/Display.html?id=119713
14             # because 0.20.1 < 0.1 (0.1 is converted to real number)
15             our $VERSION = '4.0.1';
16              
17             our @EXPORT_OK = qw(
18             get_signature
19             get_status_URL
20             get_purchase_URL
21             get_subscription_URL
22             get_upgrade_subscription_URL
23             get_cancel_subscription_URL
24             validate_signature
25             );
26              
27             my $STATUS_URL = 'https://secure.verotel.com/salestatus';
28             my $FLEXPAY_URL = 'https://secure.verotel.com/startorder';
29             my $CANCEL_URL = 'https://secure.verotel.com/cancel-subscription';
30             my $PROTOCOL_VERSION = '3.5';
31              
32             =head1 NAME
33              
34             Verotel::FlexPay
35              
36             =head1 DESCRIPTION
37              
38             This library allows merchants to use Verotel payment gateway and get paid by their users via Credit Card and other payment methods.
39              
40             =head2 get_signature($secret, %params)
41              
42             Returns signature for the given parameters using L<$secret>.
43              
44             Signature is an SHA-256 hash as hexadecimal number generated from L<$secret>
45             followed by the parameters joined with colon (:). Parameters ("$key=$value")
46             are alphabeticaly orderered by their keys. Only the following parameters are
47             considered for signing:
48              
49             =head1 AUTHOR
50              
51             Verotel dev team
52              
53             =head1 SUPPORT
54              
55             Documentation PDF for the library can be found on the Verotel blog (http://blog.verotel.com/downloads/).
56              
57             =over 2
58              
59             version,
60             shopID, saleID, referenceID,
61             priceAmount, priceCurrency,
62             description, name
63             custom1, custom2, custom3
64             subscriptionType
65             period
66             trialAmount, trialPeriod
67             cancelDiscountPercentage
68              
69             =back
70              
71             =head3 Example:
72              
73             get_signature('aaB',
74             shopID => '123',
75             custom1 => 'xyz',
76             custom2 => undef ,
77             ignored => 'bla'
78             );
79              
80             returns the SHA-256 string for "aaB:custom1=xyz:custom2=:shopID=123" converted to lowercase.
81              
82             =cut
83              
84             sub get_signature {
85 13     13 1 10334 my $secret = shift;
86 13         69 my %params = @_;
87 13         59 %params = _filter_params( %params );
88 13         40 return _signature($secret, \%params);
89             }
90              
91              
92             =head2 validate_signature($secret, %params)
93              
94             Returns true if the signature passed in the parameters match the signature computed from B parameters (except for the signature itself).
95              
96             =head3 Example:
97              
98             validate_signature('aaB',
99             shopID => 123,
100             saleID => 345,
101             signature => 'acb4dd91827bc79999a04ac2082d0e43bb018a9ce563dfd3e863fbae32e5f381'
102             );
103              
104             returns true as the signature passed as the parameter is the same as the signature computed for "aaB:saleID=345:shopID=123"
105              
106             Note: It accepts SHA-256 signature, but for now accepts also old SHA-1 signature for backward compatiblity.
107              
108             =cut
109              
110             sub validate_signature {
111 3     3 1 3935 my ($secret, %params) = @_;
112 3         10 my $verified_sign = lc(delete $params{signature});
113 3         10 my $calculated_sign = _signature($secret, \%params);
114 3 100       16 return 1 if $verified_sign eq $calculated_sign;
115              
116 2         7 my $old_sha1_sign = _signature($secret, \%params, \&sha1_hex);
117 2 100       15 return ($verified_sign eq $old_sha1_sign ? 1 : 0);
118             }
119              
120              
121             =head2 get_purchase_URL($secret, %params)
122              
123             Return URL for purchase with signed parameters (only the parameters listed in the description of get_signature() are considered for signing).
124              
125             =head3 Example:
126              
127             get_purchase_URL('mySecret', shopID => 65147, priceAmount => '6.99', priceCurrency => 'USD');
128              
129             returns
130              
131             "https://secure.verotel.com/startorder?priceAmount=6.99&priceCurrency=USD&shopID=65147&type=purchase&version=3.5&signature=37d56280eae410d2e5d6b67ccd29fd84173f2eed5a329c9b2f7fe9a77ad95441"
132              
133             =cut
134              
135             sub get_purchase_URL {
136 5     5 1 8284 my ($secret, %params) = @_;
137 5         22 return _generate_URL($FLEXPAY_URL, $secret, 'purchase', %params);
138             }
139              
140             =head2 get_subscription_URL($secret, %params)
141              
142             Return URL for subscription with signed parameters (only the parameters listed in the description of get_signature() are considered for signing).
143              
144             =head3 Example:
145              
146             get_subscription_URL('mySecret', shopID => 65147, subscriptionType => 'recurring', period => 'P1M');
147              
148             returns
149              
150             "https://secure.verotel.com/startorder?period=P1M&shopID=65147&subscriptionType=recurring&type=subscription&version=3.5&signature=2f2ffd9ba91dec62be74b143d0093ce7cefc62d1dab237aa3a327d76188cf77c"
151              
152             =cut
153              
154             sub get_subscription_URL {
155 3     3 1 5140 my ($secret, %params) = @_;
156 3         12 return _generate_URL($FLEXPAY_URL, $secret, 'subscription', %params);
157             }
158              
159             =head2 get_subscription_URL($secret, %params)
160              
161             Return URL for upgrade subscription with signed parameters (only the parameters listed in the description of get_signature() are considered for signing).
162              
163             =head3 Example:
164              
165             get_upgrade_subscription_URL('mySecret', shopID => 65147, subscriptionType => 'recurring', period => 'P1M');
166              
167             returns
168              
169             "https://secure.verotel.com/startorder?period=P1M&shopID=65147&subscriptionType=recurring&type=upgradesubscription&version=3.5&signature=2276fd3aea2ca4027641515c731c6783ec2def70504c5276c5f4599039129e52"
170              
171             =cut
172              
173             sub get_upgrade_subscription_URL {
174 1     1 0 1758 my ($secret, %params) = @_;
175 1         7 return _generate_URL($FLEXPAY_URL, $secret, 'upgradesubscription', %params);
176             }
177              
178              
179             =head2 get_status_URL($secret, %params)
180              
181             Return URL for status with signed parameters (only the parameters listed in the description of get_signature() are considered for signing).
182              
183             =head3 Example:
184              
185             get_status_URL('mySecret', shopID => '65147', saleID => '1485');
186              
187             returns
188              
189             "https://secure.verotel.com/salestatus?saleID=1485&shopID=65147&version=3.5&signature=1a24a2d189824c6800d85131f11a2fca0ebbc233f31cad6d45e947496e423ff7"
190              
191             =cut
192              
193             sub get_status_URL {
194 3     3 1 4995 my ($secret, %params) = @_;
195 3         11 return _generate_URL($STATUS_URL, $secret, undef, %params);
196             }
197              
198              
199             =head2 get_cancel_subscription_URL($secret, %params)
200              
201             Return URL for cancel subscription with signed parameters (only the parameters listed in the description of get_signature() are considered for signing).
202              
203             =head3 Example:
204              
205             get_cancel_subscription_URL('mySecret', shopID => '65147', saleID => '1485');
206              
207             returns
208              
209             "https://secure.verotel.com/cancel-subscription?saleID=1485&shopID=65147&version=3.5&signature=1a24a2d189824c6800d85131f11a2fca0ebbc233f31cad6d45e947496e423ff7"
210              
211             =cut
212              
213             sub get_cancel_subscription_URL {
214 3     3 1 5197 my ($secret, %params) = @_;
215 3         9 return _generate_URL($CANCEL_URL, $secret, undef, %params);
216             }
217              
218              
219             ################ PRIVATE METHODS ##########################
220              
221              
222             sub _generate_URL {
223 15     15   41 my ($baseURL, $secret, $type, %params) = (@_);
224              
225 15 100       41 if (!$secret) {croak "no secret given"};
  4         44  
226 11 100       23 if (!%params) {croak "no params given"};
  4         37  
227              
228 7         14 $params{version} = $PROTOCOL_VERSION;
229 7 100       14 if (defined $type) {
230 5         10 $params{type} = $type;
231             }
232              
233             # remove empty values:
234 7         36 my @sorted_params = map { (defined($params{$_}) && $params{$_} ne '')
235 51 100 100     185 ? ($_ => $params{$_})
236             : ()
237             } sort keys %params;
238              
239 7         34 my $url = new URI($baseURL);
240 7         8796 my $signature = get_signature($secret, @sorted_params);
241              
242 7         43 $url->query_form(@sorted_params, signature => $signature);
243              
244 7         1514 return $url->as_string();
245             }
246              
247             sub _signature {
248 18     18   39 my ($secret, $params_ref, $algorigthm_func) = @_;
249 18 100       75 my @values = map { $_.'='.(defined $params_ref->{$_} ? $params_ref->{$_} : "") }
  102         330  
250             sort keys %$params_ref;
251 18         69 my $encString = join(":", $secret, @values);
252 18         54 utf8::encode($encString);
253              
254 18   100     111 $algorigthm_func ||= \&sha256_hex;
255 18         176 return lc($algorigthm_func->($encString));
256             }
257              
258             sub _filter_params {
259 13     13   40 my (%params) = @_;
260              
261 13         47 my @keys = grep { m/ ^(
  89         277  
262             version
263             | shopID
264             | price(Amount|Currency)
265             | paymentMethod
266             | description
267             | referenceID
268             | saleID
269             | custom[123]
270             | subscriptionType
271             | period
272             | name
273             | trialAmount
274             | trialPeriod
275             | cancelDiscountPercentage
276             | type
277             | backURL
278             | declineURL
279             | precedingSaleID
280             | upgradeOption
281             )$
282             /x } keys %params;
283              
284 13         26 my %filtered = map { $_ => $params{$_} } @keys;
  75         139  
285              
286 13         84 return %filtered;
287             }
288              
289             1;