added on WebSTLs (webstls.com) at 2026-07-01 22:26:43
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # WebSTLs -- buyer's "My Subscriptions" page (one per storefront). | |
| 4 | #====================================================================== | |
| 5 | use strict; | |
| 6 | use warnings; | |
| 7 | ||
| 8 | use lib '/var/www/vhosts/webstls.com/httpdocs'; | |
| 9 | use CGI; | |
| 10 | use MODS::Template; | |
| 11 | use MODS::DBConnect; | |
| 12 | use MODS::WebSTLs::Config; | |
| 13 | use MODS::WebSTLs::Themes; | |
| 14 | use MODS::WebSTLs::BuyerAuth; | |
| 15 | use MODS::WebSTLs::Subscriptions; | |
| 16 | ||
| 17 | $| = 1; | |
| 18 | ||
| 19 | my $q = CGI->new; | |
| 20 | my $form = $q->Vars; | |
| 21 | my $tfile = MODS::Template->new; | |
| 22 | my $db = MODS::DBConnect->new; | |
| 23 | my $cfg = MODS::WebSTLs::Config->new; | |
| 24 | my $themes= MODS::WebSTLs::Themes->new; | |
| 25 | my $bauth = MODS::WebSTLs::BuyerAuth->new; | |
| 26 | my $sub = MODS::WebSTLs::Subscriptions->new; | |
| 27 | my $DB = $cfg->settings('database_name'); | |
| 28 | ||
| 29 | my $sid = $form->{id} || $form->{storefront_id} || 0; | |
| 30 | $sid =~ s/[^0-9]//g; | |
| 31 | unless ($sid) { print "Status: 302 Found\nLocation: /\n\n"; exit; } | |
| 32 | ||
| 33 | my $dbh = $db->db_connect(); | |
| 34 | my $buyer = $bauth->verify($q, $db, $dbh, $DB); | |
| 35 | unless ($buyer && $buyer->{id}) { | |
| 36 | $db->db_disconnect($dbh); | |
| 37 | print "Status: 302 Found\nLocation: /buyer_login.cgi?id=$sid\n\n"; exit; | |
| 38 | } | |
| 39 | ||
| 40 | # POST: cancel. | |
| 41 | if (($ENV{REQUEST_METHOD} || '') eq 'POST' && ($form->{_act} || '') eq 'cancel') { | |
| 42 | my $sub_id = $form->{sub_id}; $sub_id =~ s/[^0-9]//g; | |
| 43 | $sub->cancel_subscription($db, $dbh, $DB, $sub_id, $buyer->{id}); | |
| 44 | $db->db_disconnect($dbh); | |
| 45 | print "Status: 302 Found\nLocation: /my_subscription.cgi?id=$sid&canceled=1\n\n"; exit; | |
| 46 | } | |
| 47 | ||
| 48 | my $store = $db->db_readwrite($dbh, qq~ | |
| 49 | SELECT id, name, subdomain, theme_id FROM `${DB}`.storefronts WHERE id='$sid' LIMIT 1 | |
| 50 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 51 | my $css = $themes->css_vars($themes->by_id($store->{theme_id})); | |
| 52 | ||
| 53 | # All buyer's subs at this storefront. | |
| 54 | my $subs = $sub->buyer_subscriptions_for($db, $dbh, $DB, $buyer->{id}); | |
| 55 | my @rows; | |
| 56 | foreach my $s (@$subs) { | |
| 57 | next unless ($s->{seller_id} || 0); | |
| 58 | # Match storefront by joining the plan | |
| 59 | my $owner = $db->db_readwrite($dbh, qq~ | |
| 60 | SELECT storefront_id FROM `${DB}`.subscription_plans WHERE id='$s->{plan_id}' LIMIT 1 | |
| 61 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 62 | next unless $owner && ($owner->{storefront_id} || 0) eq $sid; | |
| 63 | push @rows, { | |
| 64 | id => $s->{id}, | |
| 65 | plan_name => _h($s->{plan_name}), | |
| 66 | kind => $s->{plan_kind}, | |
| 67 | kind_label => $s->{plan_kind} eq 'ship_monthly' ? 'Ship monthly' : 'Download quota', | |
| 68 | status => $s->{status}, | |
| 69 | is_active => $s->{status} eq 'active' ? 1 : 0, | |
| 70 | is_canceled => $s->{status} eq 'canceled' ? 1 : 0, | |
| 71 | price_label => '$' . sprintf('%.2f', ($s->{price_cents} || 0) / 100), | |
| 72 | cadence => $s->{cadence_days}, | |
| 73 | quota => $s->{quota_per_period}, | |
| 74 | used => $s->{downloads_used_this_period} || 0, | |
| 75 | remaining => ($s->{quota_per_period} || 0) - ($s->{downloads_used_this_period} || 0), | |
| 76 | period_end => $s->{current_period_end} || '', | |
| 77 | }; | |
| 78 | } | |
| 79 | ||
| 80 | $db->db_disconnect($dbh); | |
| 81 | ||
| 82 | my $tvars = { | |
| 83 | theme_css_vars => $css, | |
| 84 | store_id => $sid, | |
| 85 | store_name => _h($store->{name} || $store->{subdomain}), | |
| 86 | has_subs => scalar(@rows) ? 1 : 0, | |
| 87 | subs => \@rows, | |
| 88 | canceled_flash => defined $form->{canceled} ? 1 : 0, | |
| 89 | }; | |
| 90 | ||
| 91 | print "Content-Type: text/html; charset=utf-8\nCache-Control: no-store, no-cache, must-revalidate, max-age=0\nPragma: no-cache\nExpires: 0\n\n"; | |
| 92 | print join('', $tfile->template('webstls_my_subscription.html', $tvars, undef)); | |
| 93 | exit; | |
| 94 | ||
| 95 | sub _h { | |
| 96 | my $s = shift // ''; | |
| 97 | $s =~ s/&/&/g; $s =~ s/</</g; $s =~ s/>/>/g; | |
| 98 | $s =~ s/"/"/g; $s =~ s/'/'/g; | |
| 99 | return $s; | |
| 100 | } |