Diff

/var/www/vhosts/3dshawn.com/affiliate.3dshawn.com/my_credit.cgi

added on local at 2026-07-01 13:47:35

Added

+117

lines

Removed

-0

lines

Context

unchanged

Blobs

from
to c300969878dc

Restore this content →

Unified diff

Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.

	1	#!/usr/bin/perl
	2	#======================================================================
	3	# WebSTLs -- buyer-facing store-credit history.
	4	#
	5	# GET /my_credit.cgi?id=<storefront_id>
	6	# Shows the signed-in buyer's current store-credit balance + the
	7	# ledger rows that produced it (grants, applies, reversals). Auth is
	8	# the buyer session cookie; visitors are bounced to /buyer_login.cgi.
	9	#======================================================================
	10	use strict;
	11	use warnings;
	12
	13	use lib '/var/www/vhosts/3dshawn.com/affiliate.3dshawn.com';
	14	use CGI;
	15	use MODS::Template;
	16	use MODS::DBConnect;
	17	use MODS::AffSoft::Config;
	18	use MODS::AffSoft::BuyerAuth;
	19	use MODS::AffSoft::Themes;
	20	use MODS::AffSoft::BuyerCredits;
	21
	22	my $q = CGI->new;
	23	my $form = $q->Vars;
	24	my $tfile = MODS::Template->new;
	25	my $db = MODS::DBConnect->new;
	26	my $cfg = MODS::AffSoft::Config->new;
	27	my $auth = MODS::AffSoft::BuyerAuth->new;
	28	my $themes = MODS::AffSoft::Themes->new;
	29	my $bc = MODS::AffSoft::BuyerCredits->new;
	30	my $DB = $cfg->settings('database_name');
	31
	32	$\| = 1;
	33
	34	my $sid = $form->{id} \|\| $form->{storefront_id} \|\| 0;
	35	$sid =~ s/[^0-9]//g;
	36
	37	my $dbh = $db->db_connect();
	38
	39	my $buyer = $auth->verify($q, $db, $dbh, $DB);
	40	unless ($buyer && $buyer->{id}) {
	41	$db->db_disconnect($dbh);
	42	my $target = $sid ? "/buyer_login.cgi?id=$sid" : '/';
	43	print "Status: 302 Found\nLocation: $target\n\n";
	44	exit;
	45	}
	46
	47	$sid \|\|= $buyer->{storefront_id};
	48
	49	my $store = $db->db_readwrite($dbh, qq~
	50	SELECT id, name, subdomain, theme_id FROM `${DB}`.storefronts
	51	WHERE id='$sid' LIMIT 1
	52	~, $ENV{SCRIPT_NAME}, __LINE__);
	53	unless ($store && $store->{id}) {
	54	$db->db_disconnect($dbh);
	55	print "Status: 302 Found\nLocation: /\n\n";
	56	exit;
	57	}
	58
	59	my $balance = $bc->balance_cents($db, $dbh, $DB, $store->{id},
	60	{ buyer_account_id => $buyer->{id} });
	61
	62	my @hist = $bc->history($db, $dbh, $DB, $store->{id},
	63	{ buyer_account_id => $buyer->{id} }, 100);
	64	my @rows;
	65	my %label = (
	66	manual_grant => 'Store credit',
	67	order_refund => 'Order refund credit',
	68	promotional => 'Promotional credit',
	69	order_apply => 'Used on order',
	70	reversal => 'Order refunded',
	71	);
	72	foreach my $h (@hist) {
	73	my $a = $h->{amount_cents} \|\| 0;
	74	push @rows, {
	75	amount_dollars => ($a < 0 ? '-' : '+') . '$' . sprintf('%.2f', abs($a)/100),
	76	is_positive => $a > 0 ? 1 : 0,
	77	is_negative => $a < 0 ? 1 : 0,
	78	reason => $h->{reason},
	79	reason_label => $label{$h->{reason}} \|\| $h->{reason},
	80	related_order_id => $h->{related_order_id} ? ($h->{related_order_id} + 0) : 0,
	81	has_related => $h->{related_order_id} ? 1 : 0,
	82	note => _h($h->{note} \|\| ''),
	83	created_at => $h->{created_at} \|\| '-',
	84	};
	85	}
	86
	87	my $theme = $themes->by_id($store->{theme_id});
	88	my $css_vars = $themes->css_vars($theme);
	89
	90	$db->db_disconnect($dbh);
	91
	92	my $tvars = {
	93	theme_css_vars => $css_vars,
	94	store_id => $store->{id},
	95	store_name => _h($store->{name} \|\| $store->{subdomain}),
	96	buyer_email => _h($buyer->{email}),
	97	buyer_name => _h($buyer->{display_name} \|\| $buyer->{email}),
	98	balance_dollars => '$' . sprintf('%.2f', $balance/100),
	99	balance_cents => $balance,
	100	has_credit => $balance > 0 ? 1 : 0,
	101	rows => \@rows,
	102	has_rows => scalar(@rows) ? 1 : 0,
	103	no_rows => scalar(@rows) ? 0 : 1,
	104	my_orders_href => "/my_orders.cgi?id=$store->{id}",
	105	back_href => "/store.cgi?id=$store->{id}",
	106	logout_href => "/buyer_logout.cgi?id=$store->{id}",
	107	};
	108
	109	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";
	110	print join('', $tfile->template('webstls_my_credit.html', $tvars, undef));
	111
	112	sub _h {
	113	my $s = shift; $s = '' unless defined $s;
	114	$s =~ s/&/&/g; $s =~ s/</</g; $s =~ s/>/>/g;
	115	$s =~ s/"/"/g; $s =~ s/'/'/g;
	116	return $s;
	117	}