<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Verotel::FlexPay;

use strict;
use warnings;
use base 'Exporter';

use Digest::SHA1 qw( sha1_hex );
use Params::Validate qw(:all);
use URI;
use Carp;
use utf8;

our $VERSION = '3.4';

our @EXPORT_OK = qw(
    get_signature
    get_status_URL
    get_purchase_URL
    get_subscription_URL
    get_upgrade_subscription_URL
    get_cancel_subscription_URL
    validate_signature
);

my $STATUS_URL = 'https://secure.verotel.com/salestatus';
my $FLEXPAY_URL = 'https://secure.verotel.com/startorder';
my $CANCEL_URL = 'https://secure.verotel.com/cancel-subscription';
my $PROTOCOL_VERSION = $VERSION;

=head2 get_signature($secret, %params)

Returns sha1_hex signature for the given parameters using L&lt;$secret&gt;.

Signature is an SHA-1 hash as hexadecimal number generated from L&lt;$secret&gt;
followed by the parameters joined with colon (:). Parameters ("$key=$value")
are alphabeticaly orderered by their keys. Only the following parameters are
considered for signing:

=over 2

version,
shopID, saleID, referenceID,
priceAmount, priceCurrency,
description, name
custom1, custom2, custom3
subscriptionType
period
trialAmount, trialPeriod
cancelDiscountPercentage

=back

=head3 Example:

    get_signature('aaB',
        shopID =&gt; '123',
        custom1 =&gt; 'xyz',
        custom2 =&gt; undef ,
        ignored =&gt; 'bla'
    );

returns the SHA-1 string for "aaB:custom1=xyz:custom2=:shopID=123" converted to lowercase.

=cut

sub get_signature {
    my $secret = shift;
    my %params = @_;
    %params = filter_params( %params );
    return signature($secret, %params);
}


=head2 validate_signature($secret, %params)

Returns true if the signature passed in the parameters match the signature computed from B&lt;all&gt; parameters (except for the signature itself).

=head3 Example:

    validate_signature('aaB',
        shopID =&gt; 123,
        saleID =&gt; 345,
        signature =&gt; '30a671fd2ab5a7580c3ecc279e092eef35a97ff1'
    );

returns true as the signature passed as the parameter is the same as the signature computed for "aaB:saleID=345:shopID=123"

=cut

sub validate_signature {
    my ($secret, %params) = @_;
    my $sign1  = lc(delete $params{signature});
    my $sign2  = signature($secret, %params);
    return ($sign1 eq $sign2) ? 1 : 0;
}


=head2 get_purchase_URL($secret, %params)

Return URL for purchase with signed parameters (only the parameters listed in the description of get_signature() are considered for signing).

=head3 Example:

    get_purchase_URL('mySecret', shopID =&gt; 65147, priceAmount =&gt; '6.99', priceCurrency  =&gt; 'USD');

returns

    "https://secure.verotel.com/startorder?priceAmount=6.99&amp;priceCurrency=USD&amp;shopID=65147&amp;type=purchase&amp;version=3&amp;signature=419265a47644c7852c4a595385b867a4ce87da7b"

=cut

sub get_purchase_URL {
    my ($secret, %params) = @_;
    return generate_URL($FLEXPAY_URL, $secret, 'purchase',  %params);
}

=head2 get_subscription_URL($secret, %params)

Return URL for subscription with signed parameters (only the parameters listed in the description of get_signature() are considered for signing).

=head3 Example:

    get_subscription_URL('mySecret', shopID =&gt; 65147, subscriptionType =&gt; 'recurring', period =&gt; 'P1M');

returns

    "https://secure.verotel.com/startorder?period=P1M&amp;shopID=65147&amp;subscriptionType=recurring&amp;type=subscription&amp;version=3&amp;signature=602c185d1ab001b84b8e5248b67539aae94aa7fb"

=cut

sub get_subscription_URL {
    my ($secret, %params) = @_;
    return generate_URL($FLEXPAY_URL, $secret, 'subscription', %params);
}

=head2 get_subscription_URL($secret, %params)

Return URL for upgrade subscription with signed parameters (only the parameters listed in the description of get_signature() are considered for signing).

=head3 Example:

    get_upgrade_subscription_URL('mySecret', shopID =&gt; 65147, subscriptionType =&gt; 'recurring', period =&gt; 'P1M');

returns

    "https://secure.verotel.com/startorder?period=P1M&amp;shopID=65147&amp;subscriptionType=recurring&amp;type=upgradesubscription&amp;version=3.4&amp;signature=602c185d1ab001b84b8e5248b67539aae94aa7fb"

=cut

sub get_upgrade_subscription_URL {
    my ($secret, %params) = @_;
    return generate_URL($FLEXPAY_URL, $secret, 'upgradesubscription', %params);
}


=head2 get_status_URL($secret, %params)

Return URL for status with signed parameters (only the parameters listed in the description of get_signature() are considered for signing).

=head3 Example:

    get_status_URL('mySecret', shopID =&gt; '65147', saleID =&gt; '1485');

returns

    "https://secure.verotel.com/salestatus?saleID=1485&amp;shopID=65147&amp;version=3&amp;signature=c6f7c22553ba51e6171b34918652cf5099320f77"

=cut

sub get_status_URL {
    my ($secret, %params) = @_;
    return generate_URL($STATUS_URL, $secret, undef, %params);
}


=head2 get_cancel_subscription_URL($secret, %params)

Return URL for cancel subscription with signed parameters (only the parameters listed in the description of get_signature() are considered for signing).

=head3 Example:

    get_cancel_subscription_URL('mySecret', shopID =&gt; '65147', saleID =&gt; '1485');

returns

    "https://secure.verotel.com/cancel-subscription?saleID=1485&amp;shopID=65147&amp;version=3&amp;signature=c6f7c22553ba51e6171b34918652cf5099320f77"

=cut

sub get_cancel_subscription_URL {
    my ($secret, %params) = @_;
    return generate_URL($CANCEL_URL, $secret, undef, %params);
}


################ PRIVATE METHODS ##########################


sub generate_URL {
    my ($baseURL, $secret, $type, %params) = (@_);

    if (!$secret) {croak "no secret given"};
    if (!%params) {croak "no params given"};

    $params{version} = $PROTOCOL_VERSION;
    if (defined $type) {
        $params{type} = $type;
    }

    # remove empty values:
    my @sorted_params = map { (defined($params{$_}) &amp;&amp; $params{$_} ne '')
                            ? ($_ =&gt; $params{$_})
                            : ()
                    } sort keys %params;

    my $url         = new URI($baseURL);
    my $signature   = get_signature($secret, @sorted_params);

    $url-&gt;query_form(@sorted_params, signature =&gt; $signature);

    return $url-&gt;as_string();
}

sub signature {
    my ($secret, %params) = @_;
    my @values = map { $_.'='.(defined $params{$_} ? $params{$_} : "") }
                        sort keys %params;
    my $encString = join(":", $secret, @values);
    utf8::encode($encString);

    return lc(sha1_hex($encString));
}

sub filter_params {
    my (%params) = @_;

    my @keys = grep { m/ ^(
                            version
                            | shopID
                            | price(Amount|Currency)
                            | paymentMethod
                            | description
                            | referenceID
                            | saleID
                            | custom[123]
                            | subscriptionType
                            | period
                            | name
                            | trialAmount
                            | trialPeriod
                            | cancelDiscountPercentage
                            | type
                            | backURL
                            | declineURL
                            | precedingSaleID
                            | upgradeOption
                        )$
                    /x } keys %params;

    my %filtered = map { $_ =&gt; $params{$_} } @keys;

    return %filtered;
}

1;
</pre></body></html>