File Coverage

blib/lib/Business/Stripe/WebCheckout.pm

Criterion	Covered	Total	%
statement	15	164	9.1
branch	0	74	0.0
condition	0	33	0.0
subroutine	5	17	29.4
pod	11	11	100.0
total	31	299	10.3

package Business::Stripe::WebCheckout;

# TODO - Pre  release
#
# TODO - Post release
#
# 12-04-21 - Improve obtaining success/cancel URLs from environment
# 14-04-21 - Add P&P
# 16-04-21 - Properly implement live testing without real Stripe keys
#

use HTTP::Tiny;
use JSON::PP;
use Data::Dumper;

use strict;
use warnings;

our $VERSION = '1.2';
$VERSION = eval $VERSION;

sub new {
    my $class = shift;
    my %attrs = @_;

    my @products;
    $attrs{'trolley'} = \@products;

    $attrs{'currency'} //= 'GBP';

    $attrs{'error'} = '';

    $attrs{'cancel-url'}  //= "$ENV{'REQUEST_SCHEME'}://$ENV{'HTTP_HOST'}$ENV{'SCRIPT_NAME'}";
    $attrs{'success-url'} //= "$ENV{'REQUEST_SCHEME'}://$ENV{'HTTP_HOST'}$ENV{'SCRIPT_NAME'}";
    $attrs{'error'}         = 'cancel-url and success-url cannot be derived from the environment and need to be provided' unless ($attrs{'cancel-url'} and $attrs{'success-url'});

    # This is changed during testing only
    $attrs{'url'}         //= 'https://api.stripe.com/v1/checkout/sessions';

    $attrs{'error'} = 'Public API key provided is not a valid key' if $attrs{'api-public'} and $attrs{'api-public'} !~ /^pk_/;
    $attrs{'error'} = 'Secret API key provided is not a valid key' unless $attrs{'api-secret'} =~ /^sk_/;
    $attrs{'error'} = 'Secret API key provided as Public key' if $attrs{'api-public'} and $attrs{'api-public'} =~ /^sk_/;
    $attrs{'error'} = 'Public API key provided as Secret key' if $attrs{'api-secret'} =~ /^pk_/;
    $attrs{'error'} = 'Secret API key is too short' unless length $attrs{'api-secret'} > 100;
    $attrs{'error'} = 'Secret API key is missing' unless $attrs{'api-secret'};

    return bless \%attrs, $class;
}

sub success {
    my $self = shift;
    return !$self->{'error'};
}

sub error {
    my $self = shift;
    return $self->{'error'};
}

sub add_product {
    my ($self, %product) = @_;
    $self->{'error'} = '';

    unless ($product{'price'} > 0 and $product{'price'} !~ /\./) {
        $self->{'error'} = 'Invalid price.  Price is an integer of the lowest currency unit';
        return;
    }
    unless ($product{'qty'} > 0 and $product{'qty'} !~ /\./) {
        $self->{'error'} = 'Invalid qty.  Qty is a positive integer';
        return;
    }

    unless ($product{'name'}) {
        $self->{'error'} = 'No product name supplied';
        return;
    }
    $self->{'intent'} = undef;
    # Update existing Product by ID
    foreach my $prod(@{$self->{'trolley'}}) {
        if ($prod->{'id'} eq $product{'id'}) {
            foreach my $field('name', 'description', 'qty', 'price') {
                $prod->{$field} = $product{$field};
            }
            return scalar @{$self->{'trolley'}};
        }
    }

    my $new_product;
    foreach my $field('id', 'name', 'description', 'qty', 'price') {
        $new_product->{$field} = $product{$field};
    }
    push @{$self->{'trolley'}}, $new_product;
}

sub list_products {
    my $self = shift;
    my @products;
    foreach my $prod(@{$self->{'trolley'}}) {
        push @products, $prod->{'id'};
    }
    return @products;
}

sub get_product {
    my ($self, $id) = @_;
    $self->{'error'} = '';

    unless ($id) {
        $self->{'error'} = 'Product ID missing';
        return;
    }

    foreach my $prod(@{$self->{'trolley'}}) {
        if ($prod->{'id'} eq $id) {
            return $prod;
        }
    }
    $self->{'error'} = "Product ID $id not found";
}

sub delete_product {
    my ($self, $id) = @_;
    $self->{'error'} = '';

    unless ($id) {
        $self->{'error'} = 'Product ID missing';
        return;
    }

    for (my $i = 0; $i < scalar @{$self->{'trolley'}}; $i++) {
        if (${$self->{'trolley'}}[$i]->{'id'} eq $id) {
            $self->{'intent'} = undef;
            splice @{$self->{'trolley'}}, $i, 1;
            return scalar @{$self->{'trolley'}};
        }
    }
    $self->{'error'} = "Product ID $id not found";
}

# Private method called internally by get_intent and get_intent_id
# Attempts to obtain a new session intent from Stripe
# Returns existing session if it exists and Trolley hasn't changed
sub _create_intent {
    my $self = shift;

    if ($self->{'intent'}) {
        return $self->{'intent'};
    }

    $self->{'reference'} //= __PACKAGE__;

    my $http = HTTP::Tiny->new;
    my $headers = {
        'Authorization' => 'Bearer ' . $self->{'api-secret'},
        'Stripe-Version'    => '2020-08-27',
    };

    # Update URL and headers during stripe-live tests
    if ($self->{'url'} =~ /^https:\/\/www\.boddison\.com/) {
        $headers->{'BODTEST'} = __PACKAGE__ . " v$VERSION";
        $headers->{'Authorization'} = undef,
        $self->{'url'} .= '?fail' if $self->{'api-test-fail'};
    }

    my $vars = {
        'headers'           => $headers,
        'agent'             => 'Perl-WebCheckout/$VERSION',
    };
    my $payload = {
        'cancel_url'                => $self->{'cancel-url'},
        'success_url'               => $self->{'success-url'},
        'payment_method_types[0]'   => 'card',
        'mode'                      => 'payment',
        'client_reference_id'       => $self->{'reference'},
    };
    $payload->{'customer_email'} = $self->{'email'} if $self->{'email'};
    if ($self->{'getShipping'}) {
        $payload->{'shipping_address_collection[allowed_countries][0]'} = $self->{'getShipping'};
    }

    my $i = 0;
    foreach my $prod(@{$self->{'trolley'}}) {
        $payload->{"line_items[$i][currency]"}      = $self->{'currency'};
        $payload->{"line_items[$i][name]"}          = $prod->{'name'};
        $payload->{"line_items[$i][description]"}   = $prod->{'description'} if $prod->{'description'};
        $payload->{"line_items[$i][quantity]"}      = $prod->{'qty'};
        $payload->{"line_items[$i][amount]"}        = $prod->{'price'};
        $i++;
    }

    my $response = $http->post_form($self->{'url'}, $payload, $vars);

    $self->{'error'} = '';
    if ($response->{'success'}) {
        $self->{'intent'} = $response->{'content'};
    } else {
        my $content = $response->{'content'};
        eval {
            $content = decode_json($response->{'content'});
        };
        if ($@) {
            $self->{'error'} = $content;
        } else {
            $self->{'error'} = $content->{'error'}->{'message'};
        }
    }
}

sub get_intent {
    my ($self, %attrs) = @_;

    $self->{'reference'} = $attrs{'reference'} if $attrs{'reference'};
    $self->{'email'} = $attrs{'email'} if $attrs{'email'};

    $self->{'error'} = '';
    return $self->_create_intent;
}

sub get_intent_id {
    my ($self, %attrs) = @_;

    $self->{'reference'} = $attrs{'reference'} if $attrs{'reference'};
    $self->{'email'} = $attrs{'email'} if $attrs{'email'};

    $self->{'error'} = '';
    my $intent = $self->_create_intent;
    if ($self->{'error'}) {
        return $intent;
    } else {
        return decode_json($intent)->{'id'};
    }
}

sub get_ids {
    my ($self, %attrs) = @_;

    $self->{'public-key'} = $attrs{'public-key'} if $attrs{'public-key'};

    $self->{'error'} = '';
    unless ($self->{'api-public'}) {
        $self->{'error'} = 'Required Public API Key missing';
        return;
    }

    $self->{'reference'} = $attrs{'reference'} if $attrs{'reference'};
    $self->{'email'} = $attrs{'email'} if $attrs{'email'};

    my $intent_id = $self->get_intent_id;

    my %result;
    if ($self->{'error'}) {
        $result{'status'}  = 'error';
        $result{'message'} = $self->{'error'};
    } else {
        $result{'status'}  = 'success';
        $result{'api-key'} = $self->{'api-public'};
        $result{'session'} = $intent_id;
    }

    $attrs{'format'} = 'text' unless $attrs{'format'};
    return encode_json(\%result) if lc($attrs{'format'}) eq 'json';
    return $result{'message'} || "$result{'api-key'}:$result{'session'}";
}

sub checkout {
    my $self = shift;

    my $data = $self->get_ids( 'format' => 'text', @_);

    return if $self->{'error'};

    my ($key, $session) = split /:/, $data;

    unless ($key and $session) {
        $self->{'error'} = 'Error getting key and session';
        return;
    }

return <<"END_HTML";
Content-type: text/html





 </td>
</tr>

<tr>
<td  class="h" >
<a name="286">286</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> var stripe = Stripe('$key');
 </td>
</tr>

<tr>
<td  class="h" >
<a name="287">287</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> var result = stripe.redirectToCheckout({sessionId: '$session'});
 </td>
</tr>

<tr>
<td  class="h" >
<a name="288">288</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> if (result.error) {
 </td>
</tr>

<tr>
<td  class="h" >
<a name="289">289</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">     alert(result.error.message);
 </td>
</tr>

<tr>
<td  class="h" >
<a name="290">290</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> }
 </td>
</tr>

<tr>
<td  class="h" >
<a name="291">291</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">


END_HTML

}

1;

__END__