added on local at 2026-07-01 12:34:25
| 1 | package MODS::PTMatrix::Stripe; | |
| 2 | #====================================================================== | |
| 3 | # TaskForge -- thin Stripe wrapper using curl (LWP::Protocol::https is | |
| 4 | # not installed on this box). All calls are POSTs to api.stripe.com | |
| 5 | # with the secret key in the Authorization: Bearer header. | |
| 6 | # | |
| 7 | # Methods: | |
| 8 | # create_checkout_session({ price_id, quantity, customer_email, | |
| 9 | # success_url, cancel_url, metadata }) | |
| 10 | # create_billing_portal_session({ customer_id, return_url }) | |
| 11 | # verify_webhook_sig($payload, $sig_header, $secret) # returns 1/0 | |
| 12 | #====================================================================== | |
| 13 | use strict; | |
| 14 | use warnings; | |
| 15 | use Digest::SHA qw(hmac_sha256_hex); | |
| 16 | use IPC::Open3; | |
| 17 | use Symbol 'gensym'; | |
| 18 | use JSON::PP qw(decode_json encode_json); | |
| 19 | ||
| 20 | use MODS::PTMatrix::Config; | |
| 21 | my $cfg = MODS::PTMatrix::Config->new; | |
| 22 | ||
| 23 | sub new { my ($class) = @_; return bless { _key => undef }, $class; } | |
| 24 | ||
| 25 | sub key { | |
| 26 | my ($self) = @_; | |
| 27 | return $self->{_key} //= ($cfg->settings('stripe_secret') || ''); | |
| 28 | } | |
| 29 | ||
| 30 | sub _post { | |
| 31 | my ($self, $path, $form) = @_; | |
| 32 | my $k = $self->key; | |
| 33 | return { error => 'no_key' } unless $k; | |
| 34 | ||
| 35 | my @args = ('curl', '-sS', '-X', 'POST', | |
| 36 | '-H', "Authorization: Bearer $k", | |
| 37 | '-H', 'Content-Type: application/x-www-form-urlencoded'); | |
| 38 | my @body; | |
| 39 | foreach my $kk (sort keys %$form) { | |
| 40 | my $v = $form->{$kk}; | |
| 41 | next unless defined $v; | |
| 42 | if (ref($v) eq 'ARRAY') { | |
| 43 | my $i = 0; | |
| 44 | foreach my $item (@$v) { | |
| 45 | if (ref($item) eq 'HASH') { | |
| 46 | foreach my $ik (sort keys %$item) { | |
| 47 | push @body, _urlenc("${kk}[$i][$ik]") . '=' . _urlenc($item->{$ik}); | |
| 48 | } | |
| 49 | } else { | |
| 50 | push @body, _urlenc("${kk}[$i]") . '=' . _urlenc($item); | |
| 51 | } | |
| 52 | $i++; | |
| 53 | } | |
| 54 | } else { | |
| 55 | push @body, _urlenc($kk) . '=' . _urlenc($v); | |
| 56 | } | |
| 57 | } | |
| 58 | push @args, '-d', join('&', @body); | |
| 59 | push @args, "https://api.stripe.com/v1/$path"; | |
| 60 | ||
| 61 | my ($wtr, $rdr, $err); $err = gensym; | |
| 62 | my $pid = open3($wtr, $rdr, $err, @args); | |
| 63 | close $wtr; | |
| 64 | local $/; | |
| 65 | my $out = <$rdr> // ''; my $errtxt = <$err> // ''; | |
| 66 | waitpid($pid, 0); | |
| 67 | my $obj; | |
| 68 | eval { $obj = decode_json($out); }; | |
| 69 | if ($@) { return { error => 'bad_json', raw => $out, stderr => $errtxt }; } | |
| 70 | return $obj; | |
| 71 | } | |
| 72 | ||
| 73 | sub create_checkout_session { | |
| 74 | my ($self, $args) = @_; | |
| 75 | my $form = { | |
| 76 | mode => 'subscription', | |
| 77 | success_url => $args->{success_url}, | |
| 78 | cancel_url => $args->{cancel_url}, | |
| 79 | customer_email => $args->{customer_email}, | |
| 80 | 'line_items' => [{ | |
| 81 | price => $args->{price_id}, | |
| 82 | quantity => $args->{quantity} || 1, | |
| 83 | }], | |
| 84 | }; | |
| 85 | if ($args->{metadata}) { | |
| 86 | foreach my $mk (keys %{$args->{metadata}}) { | |
| 87 | $form->{"metadata[$mk]"} = $args->{metadata}->{$mk}; | |
| 88 | } | |
| 89 | } | |
| 90 | return $self->_post('checkout/sessions', $form); | |
| 91 | } | |
| 92 | ||
| 93 | sub create_billing_portal_session { | |
| 94 | my ($self, $args) = @_; | |
| 95 | return $self->_post('billing_portal/sessions', { | |
| 96 | customer => $args->{customer_id}, | |
| 97 | return_url => $args->{return_url}, | |
| 98 | }); | |
| 99 | } | |
| 100 | ||
| 101 | # Stripe-Signature header looks like "t=NNN,v1=HEX,v0=..." | |
| 102 | sub verify_webhook_sig { | |
| 103 | my ($payload, $header, $secret) = @_; | |
| 104 | return 0 unless $header && $secret && defined $payload; | |
| 105 | my ($t, @sigs); | |
| 106 | foreach my $part (split /,/, $header) { | |
| 107 | my ($k, $v) = split /=/, $part, 2; | |
| 108 | if ($k eq 't') { $t = $v; } | |
| 109 | if ($k eq 'v1') { push @sigs, $v; } | |
| 110 | } | |
| 111 | return 0 unless $t && @sigs; | |
| 112 | my $signed = "$t.$payload"; | |
| 113 | my $expect = hmac_sha256_hex($signed, $secret); | |
| 114 | foreach my $s (@sigs) { | |
| 115 | return 1 if lc($s) eq lc($expect); | |
| 116 | } | |
| 117 | return 0; | |
| 118 | } | |
| 119 | ||
| 120 | sub _urlenc { | |
| 121 | my $s = shift // ''; | |
| 122 | $s =~ s/([^A-Za-z0-9_.\-~])/sprintf("%%%02X", ord $1)/ge; | |
| 123 | return $s; | |
| 124 | } | |
| 125 | ||
| 126 | 1; |