zlax/ljr
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

init

Browse Source
This commit is contained in:
ivan
2019-02-06 00:49:12 +03:00
commit 8dbb1bb605
4796 changed files with 506072 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

309
ljcom/htdocs/admin/accounts/acctedit.bml Normal file
View File

@@ -0,0 +1,309 @@
<?_code
{
use strict;
use vars qw(%GET %POST);
my $remote = LJ::get_remote();
return "You must first <a href=\"$LJ::SITEROOT/login.bml?ret=1\">log in</a>."
unless $remote;
return LJ::no_access_error("You don't have access to use this tool.", "moneyenter")
unless LJ::remote_has_priv($remote, "moneyenter");
# heading
my $ret = "<h2>Account Management</h2>";
# no user specified, get one
unless ($GET{'user'}) {
$ret .= "<form method='get'>";
$ret .= "User: " . LJ::html_text({ 'name' => 'user', 'size' => 15, 'maxlength' => 15 }) . " ";
$ret .= LJ::html_submit('Load');
$ret .= "</form>";
return $ret;
}
# load user
my $user = LJ::canonical_username($GET{'user'});
my $u = LJ::load_user($user, "force");
return "Invalid user: '$user'" unless $u;
# establish some cap bit -> item mappings
my %bonus_caps = map { $LJ::Pay::bonus{$_}->{'cap'}, $_ } keys %LJ::Pay::bonus;
my $zerodate = "0000-00-00 00:00:00";
my $dbh = LJ::get_db_writer();
# save chanes
if (LJ::did_post()) {
# 'notes' field is required
return "<?h1 Error h1?><?p The 'notes' fields is required. Please enter a description of " .
"the action you are performing, why it was done, etc. p?>" unless $POST{'notes'};
my @bits_set;
my @bits_del;
my $logmsg;
# save bit-only features
foreach my $bit (0..14) {
# make sure $bit is a valid cap as specified by %LJ::CAP (for general caps),
# or either %LJ::Pay::capinf or %LJ::Pay::bonus (for local caps)
next unless
( ref $LJ::CAP{$bit} eq 'HASH' ||
(grep { defined $_->{cap} && $_->{cap} == $bit } values %LJ::Pay::bonus) ||
(grep { defined $_->{cap} && $_->{cap} == $bit } values %LJ::Pay::capinf) );
# build bit mask to set at the end
unless ($POST{"cap_${bit}_set"}) {
push @bits_del, $bit;
next;
}
push @bits_set, $bit;
}
# save paid account expiration
{
my $exp = $POST{'paid_exp'};
# check expiration date format
if (defined $exp) {
return "<b>Error:</b> Invalid expiration date format, expecting: yyyy-mm-dd hh:mm:ss"
unless $exp =~ /^\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}$/;
}
# does a paiduser row already exist?
my $paiduntil = $dbh->selectrow_array("SELECT paiduntil FROM paiduser WHERE userid=?",
undef, $u->{'userid'});
# update existing row
if ($paiduntil) {
# if expdate is 0000-00-00 00:00:00, just delete the row
if ($exp eq $zerodate) {
$dbh->do("DELETE FROM paiduser WHERE userid=?", undef, $u->{'userid'});
$logmsg .= "[delete] item: paid_account, paiduntil: $exp\n";
}
# unnecessary query?
next if $paiduntil eq $exp;
# otherwise do an update
$dbh->do("UPDATE paiduser SET paiduntil=? WHERE userid=?",
undef, $exp, $u->{'userid'});
$logmsg .= "[update] item: paid_account, paiduntil: $exp\n";
# insert new, non-blank, row
} elsif ($exp ne $zerodate) {
$dbh->do("INSERT INTO paiduser (userid, paiduntil) " .
"VALUES (?, ?)", undef, $u->{'userid'}, $exp);
$logmsg .= "[insert] item: paid_account, paiduntil: $exp\n";
}
}
# update bonus feature
foreach my $itemname (sort keys %LJ::Pay::bonus) {
my $bitem = $LJ::Pay::bonus{$itemname};
next unless ref $bitem eq 'HASH';
my ($exp, $size, $days) = map { $POST{"${itemname}_$_"} } qw(exp size daysleft);
# check expiration date format
if (defined $exp) {
return "<b>Error:</b> Invalid expiration date format, expecting: yyyy-mm-dd hh:mm:ss"
unless $exp =~ /^\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}$/;
}
# see if row exists
my $dbrow = $dbh->selectrow_hashref("SELECT expdate, size, daysleft FROM paidexp " .
"WHERE userid=? AND item=?",
undef, $u->{'userid'}, $itemname);
# row exists, do an update
if ($dbrow) {
# if a zero row, just delete
if ($exp eq $zerodate && ! $size && ! $days) {
$dbh->do("DELETE FROM paidexp WHERE userid=? AND item=?", undef, $u->{'userid'}, $itemname);
$logmsg .= "[delete] item: $itemname, expdate: $exp, size: $size, daysleft: $days\n";
next;
}
# prepare update query
my $sets;
$sets .= "expdate=" . $dbh->quote($exp) . "," if defined $exp && $dbrow->{'expdate'} ne $exp;
$sets .= "size=" . $dbh->quote($size) . "," if defined $size && $dbrow->{'size'} != $size;
$sets .= "daysleft=" . $dbh->quote($days) . "," if defined $days && $dbrow->{'daysleft'} != $days;
chop $sets if $sets;
# unnecessary query?
next unless $sets;
# otherwise do an update
$dbh->do("UPDATE paidexp SET $sets WHERE userid=? AND item=?",
undef, $u->{'userid'}, $itemname);
$logmsg .= "[update] item: $itemname, expdate: $exp, size: $size, daysleft: $days\n";
# if no rows, then we need to insert a new row, but not an empty one
} elsif ($exp ne $zerodate || $size > 0 || $days > 0) {
$exp ||= $zerodate;
$size ||= 0;
$days ||= 0;
$dbh->do("INSERT INTO paidexp (userid, item, size, expdate, daysleft) VALUES (?, ?, ?, ?, ?)",
undef, $u->{'userid'}, $itemname, $size, $exp, $days);
$logmsg .= "[insert] item: $itemname, expdate: $exp, size: $size, daysleft: $days\n";
}
# call any necessary apply_hooks
my $apply_hook = $bitem->{apply_hook};
if ($apply_hook && ref $apply_hook eq 'CODE') {
$apply_hook->($u, $itemname);
}
}
# note which caps were changed and log $logmsg to statushistory
{
my $caps_add = join(",", @bits_set);
my $caps_del = join(",", @bits_del);
$logmsg .= "[caps] add: $caps_add, del: $caps_del\n";
$logmsg .= "[notes] $POST{'notes'}";
LJ::statushistory_add($u->{'userid'}, $remote->{'userid'},
"acctedit", $logmsg);
}
# done looping through possible bits
LJ::modify_caps($u, \@bits_set, \@bits_del);
return "<?h1 Success! h1?><?p Changes to this account have been saved. p?>";
}
### update form
$ret .= "<form method='post' action='acctedit.bml?user=$u->{'user'}'>";
$ret .= "<table border='1' cellspacing='0' cellpadding='5'>";
$ret .= "<tr><td>Bit</td><td>Class</td><td>Set?</td><td>Expiration</td></tr>";
# so we know which bits to skip when going through %LJ::CAP hash
my %special_bit = ($LJ::Pay::capinf{'paid'}->{'bit'} => 1);
while (my ($itemname, $ref) = each %LJ::Pay::bonus) {
$special_bit{$ref->{'cap'}} = 1;
}
# do bit-only features
foreach my $bit (sort { $a <=> $b } keys %LJ::CAP) {
next unless ref $LJ::CAP{$bit} eq 'HASH';
next if $special_bit{$bit};
my $has_cap = $u->{'caps'} & 1 << $bit || 0;
my $name = $LJ::CAP{$bit}->{'_name'} || "<i>(no name)</i>";
$name = "<b>$name</b>" if $has_cap;
$ret .= "<tr><td align='middle'>$bit</td><td><label for='cap_${bit}_set'>$name</label></td><td>";
$ret .= LJ::html_check({ 'type' => 'check', 'name' => "cap_${bit}_set",
'id' => "cap_${bit}_set", 'value' => 1,
'selected' => $has_cap }) . "</td>";
# expiration
$ret .= "<td>&nbsp;</td></tr>";
}
# paid account status
{
my $bit = $LJ::Pay::capinf{'paid'}->{'bit'};
my $has_cap = $u->{'caps'} & 1 << $bit || 0;
my $name = "Paid Account";
$name = "<b>$name</b>" if $has_cap;
$ret .= "<tr><td align='middle'>$bit</td><td><label for='cap_${bit}_set'>$name</label></td>";
$ret .= "<td>";
$ret .= LJ::html_check({ 'type' => 'check', 'name' => "cap_${bit}_set",
'id' => "cap_${bit}_set", 'value' => 1,
'selected' => $has_cap }) . "</td>";
# get paid account status from database
my $exp = $dbh->selectrow_array("SELECT paiduntil FROM paiduser WHERE userid=?",
undef, $u->{'userid'});
# expiration text box
$ret .= "<td>";
$ret .= LJ::html_text({ 'name' => "paid_exp", 'value' => $exp || $zerodate,
'size' => 19, 'maxlength' => 19 });
$ret .= "</td></tr>";
}
# bonus features
foreach my $itemname (sort { $LJ::Pay::bonus{$a}->{'bit'} <=> $LJ::Pay::bonus{$b}->{'bit'} } keys %LJ::Pay::bonus) {
my $bitem = $LJ::Pay::bonus{$itemname};
next unless ref $bitem eq 'HASH';
my $bit = $bitem->{'cap'};
my $has_cap = $u->{'caps'} & 1 << $bit || 0;
my $name = $bitem->{'name'};
$name = "<b>$name</b>" if $has_cap;
$ret .= "<tr><td align='middle'>$bit</td><td><label for='cap_${bit}_set'>$name</label></td>";
$ret .= "<td>";
if (defined $bit) {
$ret .= LJ::html_check({ 'type' => 'check', 'name' => "cap_${bit}_set",
'id' => "cap_${bit}_set", 'value' => 1,
'selected' => $has_cap });
} else {
$ret .= "&nbsp;";
}
$ret .= "</td>";
# get activation status from the db
my ($exp, $size, $daysleft) =
$dbh->selectrow_array("SELECT expdate, size, daysleft FROM paidexp " .
"WHERE userid=? AND item=?",
undef, $u->{'userid'}, $itemname);
$size += 0;
$daysleft += 0;
# expire text box
$ret .= "<td>";
$ret .= LJ::html_text({ 'name' => "${itemname}_exp", 'value' => $exp || $zerodate,
'size' => 19, 'maxlength' => 19 });
# need a size box?
if (LJ::Pay::is_bonus($bonus_caps{$bit}, 'sized')) {
$ret .= "<br />Size: ";
$ret .= LJ::html_text({ 'name' => => "${itemname}_size", 'value' => $size,
'size' => 5, 'maxlength' => 5 });
}
# daysleft text box
$ret .= "<br />Daysleft: ";
$ret .= LJ::html_text({ 'name' => => "${itemname}_daysleft", 'value' => $daysleft,
'size' => 3, 'maxlength' => 3 });
$ret .= "</td></tr>";
}
$ret .= "<tr><td colspan='4' align='left'><b>Notes: </b> <small><i>(required)</i></small><br />";
$ret .= LJ::html_textarea({ 'name' => 'notes', 'rows' => 3, 'cols' => 60, 'wrap' => 'soft' });
$ret .= "</td></tr><tr><td colspan='4' align='right'>";
$ret .= LJ::html_submit('Update') . "</td></tr>";
$ret .= "</table>";
$ret .= "</form>";
return $ret;
}
_code?>

43
ljcom/htdocs/admin/accounts/delivernow.bml Normal file
View File

@@ -0,0 +1,43 @@
<?_code
{
use strict;
use vars qw(%POST);
my $remote = LJ::get_remote();
return "You must first <a href=\"/login.bml?ret=1\">log in</a>."
unless $remote;
return "You don't have access to use this tool."
unless LJ::remote_has_priv($remote, "moneyenter");
if ($POST{'payid'} && $POST{'piid'}) {
my $dbh = LJ::get_db_writer();
my ($piid, $status) =
$dbh->selectrow_array("SELECT piid, status FROM payitems " .
"WHERE piid=? AND payid=?",
undef, $POST{'piid'}, $POST{'payid'});
return "<b>Error:</b> Payid/Piid pair not found!"
unless $piid;
return "<b>Error:</b> Status = '$status' (not 'pending')"
unless $status eq 'pend';
$dbh->do("UPDATE payitems SET giveafter=NULL " .
"WHERE piid=? AND payid=? AND status='pend'",
undef, $POST{'piid'}, $POST{'payid'});
return "<b>Success:</b> Delivery date set to now. " .
"(PAYID: $POST{'payid'}, PIID: $POST{'piid'})";
}
return "This tool will will set an item's delivery date to be now." .
"<form method='post' action='delivernow.bml'>\n" .
"<p>Payid: " . LJ::html_text({ 'name' => 'payid', 'size' => 10 }) . "\n" .
"Piid: " . LJ::html_text({ 'name' => 'piid', 'size' => 10 }) . "</p>\n" .
LJ::html_submit(undef, 'Change');
"</form>\n";
}
_code?>

88
ljcom/htdocs/admin/accounts/depositslip.bml Normal file
View File

@@ -0,0 +1,88 @@
<html>
<head><title>Deposit Slip</title>
<style>
body, td { font-size: 10pt; font-family: arial, helvetica; }
</style>
</head>
<body>
<?_code
{
use strict;
use vars qw(%GET);
my $dbh = LJ::get_db_writer();
my ($ret, $sth);
my $remote = LJ::get_remote();
unless (LJ::remote_has_priv($remote, "moneyview")) {
if ($remote) {
return "You don't have access to see this.";
} else {
return "You must first <a href=\"/login.bml?ret=1\">log in</A>.";
}
}
my $from = $GET{'from'};
unless (defined $from) {
$ret .= "<form method='get'>after (yyyy-mm-dd[ hh:mm[:ss]]): <input name='from' size='20'> Opt. end: <input name='to' size='20'> <input type='submit' value='Make Report'> </form>";
return $ret;
}
my $to = $GET{'to'} || $dbh->selectrow_array("SELECT NOW()");
$sth = $dbh->prepare("SELECT p.payid, u.user, p.daterecv, p.amount, p.months, p.forwhat, p.used, p.mailed, p.method FROM payments p LEFT JOIN useridmap u ON u.userid=p.userid WHERE p.mailed<>'C' AND method IN ('cash', 'check', 'moneyorder') AND p.daterecv > ? AND p.daterecv <= ? ORDER BY p.daterecv");
$sth->execute($from, $to);
my @pays;
push @pays, $_ while $_ = $sth->fetchrow_hashref;
return "(none)" unless @pays;
my $in = join(',', map { $_->{'payid'} } @pays);
$sth = $dbh->prepare("SELECT payid, pval FROM payvars WHERE payid IN ($in) AND pkey='notes'");
$sth->execute;
my %notes;
while (my ($id, $v) = $sth->fetchrow_array) {
$notes{$id} .= ", " if $notes{$id};
$notes{$id} = $v;
}
$ret .= "<h1>Received Payments</h1><span style='font-size: 13pt'><b>" . $pays[0]->{'daterecv'} . " to " .
$pays[-1]->{'daterecv'} . "</b></span>";
$ret .= "<p><table cellpadding='4' cellspacing='1' border='1'>\n";
$ret .= "<tr><td><b>Order#</b></td>";
$ret .= "<td><b>Date</b></td>";
$ret .= "<td><b>Type</b></td>";
$ret .= "<td><b>User</b></td>";
$ret .= "<td><b>Notes</b></td>";
$ret .= "<td><b>Amount</b></td></tr>\n";
my $tot = 0;
foreach my $p (@pays)
{
my $amount = sprintf("\$%.02f", $p->{'amount'});
$tot += $p->{'amount'};
my $date = substr($p->{'daterecv'}, 0, 10);
$ret .= "<tr valign='top'><td>$p->{'payid'}</td>";
$ret .= "<td><nobr>$date</nobr></td>";
$ret .= "<td>$p->{'method'}</td>";
$ret .= "<td>$p->{'user'}</td>";
$ret .= "<td>$notes{$p->{'payid'}}</td>";
$ret .= "<td align='right'>$amount</td>";
$ret .= "</tr>\n";
}
$ret .= "<tr><td colspan='5'></td><td align='right'><b>\$" . sprintf("%.02f", $tot) . "</b></td></tr>\n";
$ret .= "</table>";
return $ret;
}
_code?>
</body>
</html>

115
ljcom/htdocs/admin/accounts/enterbatch.bml Normal file
View File

@@ -0,0 +1,115 @@
<html>
<head><title>Enter Batch</title></head>
<body>
<?_code
{
use strict;
use vars qw(%POST);
my $ret;
my $remote = LJ::get_remote();
unless (LJ::remote_has_priv($remote, "moneyenter")) {
return "You don't have access to enter payments: need 'moneyenter' priv."
if $remote;
return "<?needlogin?>";
}
my $do_proc = LJ::did_post() && ! $POST{'new'};
my $dbh = LJ::get_db_writer();
my $row = sub {
my $i = shift;
my ($cart, $amt, $meth, $country, $state, $notes) =
$POST{'new'} ? () : map { LJ::trim($POST{"${_}_$i"}) } qw(cart amt meth country state notes);
my $rowhtml = sub {
my $col = shift;
$ret .= $col ? "<tr bgcolor='$col'>" : "<tr>";
$ret .= "<td>#" . LJ::html_text({ name => "cart_$i", value => $cart, size => 13 }) . "</td>";
$ret .= "<td>\$" . LJ::html_text({ name => "amt_$i", value => $amt, size => 6 }) . "</td>";
$ret .= "<td>" . LJ::html_select({ name => "meth_$i", selected => $meth, },
qw(check check cash cash moneyorder moneyorder)) . "</td>";
$ret .= "<td>" . LJ::html_text({ name => "country_$i", value => defined $country ? $country : 'US',
size => 2, maxlength => 70 }) . "</td>";
$ret .= "<td>" . LJ::html_text({ name => "state_$i", value => $state,
size => 2, maxlength => 70 }) . "</td>";
$ret .= "<td>" . LJ::html_text({ name => "notes_$i", value => $notes,
size => 60, maxlength => 255 }) . "</td>";
$ret .= "</tr>\n";
return undef;
};
my $err = sub {
my $errmsg = shift;
$rowhtml->("#ff5050");
$ret .= "<tr bgcolor='#ff9090'><td colspan='6'>$errmsg</td></tr>\n";
};
return $rowhtml->() unless $do_proc && $cart;
return $err->("Invalid order format (should be like 1234-342)")
unless $cart =~ /^\d+-\d+$/;
return $err->("Invalid payment amount")
unless $amt =~ /^\d+(\.\d\d)?$/;
my $cartobj = LJ::Pay::load_cart($cart);
return $err->("Cannot find order number") unless $cartobj;
return $err->("Order price of \$$cartobj->{'amount'} doesn't match paid amount")
unless $cartobj->{'amount'}*100 == $amt*100;
# make sure that the cart is valid and ready for processing, but don't do
# checks if the cart is already completely processed, since it doesn't matter
# in that case anyway and errors will likely be found
unless ($cartobj->{'used'} eq 'Y') {
return $err->("Cart is no longer valid. Cannot process payment.")
unless LJ::Pay::is_valid_cart($cartobj);
}
# validate state/country
{
my $errstr;
my ($ctry, $st) = LJ::Pay::check_country_state($country, $state, \$errstr);
return $err->("Error: $errstr") if $errstr;
LJ::Pay::payid_set_state($cartobj->{payid}, $ctry, $st);
}
# only update once (from cart to 'N' (pending))
$dbh->do("UPDATE payments SET used='N', mailed='N', daterecv=NOW() ".
"WHERE payid=? AND mailed='C'", undef, $cartobj->{'payid'});
# allow method to be updated multiple times (to fix error)
$dbh->do("UPDATE payments SET method=? WHERE payid=?", undef,
$meth, $cartobj->{'payid'});
# likewise, keep letting notes be added (as long as they're different)
if ($notes &&
! $dbh->selectrow_array("SELECT COUNT(*) FROM payvars WHERE ".
"payid=? AND pkey='notes' AND pval=?",
undef, $cartobj->{'payid'}, $notes))
{
$dbh->do("INSERT INTO payvars (payid, pkey, pval) VALUES (?,?,?)", undef,
$cartobj->{'payid'}, "notes", $notes);
}
# Note that we've received a valid payment from this user
# * FIXME: could be faster, but this page is seldom-used
if (my $u = LJ::load_userid($cartobj->{userid})) {
LJ::Pay::note_payment_from_user($u);
}
return $rowhtml->("#c0ffc0");
};
$ret .= "<form method='post'>";
$ret .= "<table><tr valign='bottom'><td>order number</td><td>amt paid</td><td>method</td><td colspan=2>country,<br />state</td><td>internal notes (name, return addr)</td></tr>\n";
for (1..20) { $row->($_); }
$ret .= "</table>";
$ret .= "<p><input type='submit' value='Process'> <input type='submit' name='new' value='Blank Page'></p></form>";
return $ret;
}
_code?>
</body>
</html>

371
ljcom/htdocs/admin/accounts/enternew.bml Normal file
View File

@@ -0,0 +1,371 @@
<?_code
{
use strict;
use vars qw(%POST);
my $remote = LJ::get_remote();
return "<?needlogin?>" unless $remote;
return "You don't have access to enter payments: need 'moneyenter' priv."
unless LJ::remote_has_priv($remote, "moneyenter");
my $grant_perm = LJ::check_priv($remote, "grantperm");
my %methods =
( 'paypal' => 'PayPal',
'moneybookers' => 'Money Bookers',
'cash' => 'Cash',
'check' => 'Check',
'moneyorder' => 'Money Order',
'free' => 'Free',
);
if (LJ::did_post() && $POST{'submit'}) {
# determine purchase user and recipient user/email
my $user = LJ::canonical_username($POST{'user'});
my $giftfrom = LJ::canonical_username($POST{'giftfrom'});
my $rcptemail = $POST{'email'};
my $userid = 0;
my $rcptuser = $user;
my $rcptuserid = 0;
# user, no email
unless ($rcptemail) {
return LJ::bad_input("Invalid user specified.")
unless $user;
$userid = LJ::get_userid($user)
or return LJ::bad_input("User <b>$user</b> doesn't exist.");
$rcptuserid = $userid;
}
if ($giftfrom) {
$rcptuser = $user;
$rcptuserid = $userid;
$user = $giftfrom;
$userid = LJ::get_userid($giftfrom);
return LJ::bad_input("Gift user <b>$giftfrom</b> doesn't exist.")
unless $userid;
}
return LJ::bad_input("Invalid recipient specified")
unless $rcptuserid || $rcptemail;
my %pay; # payments row
my %payit; # payitems row
return LJ::bad_input("Must enter a dollar amount for this order.")
unless defined $POST{'amount'};
# handle $11.11 as well as '11.11'
$POST{'amount'} =~ s/^\$//;
$POST{'amount'} += 0;
$pay{'amount'} = $POST{'amount'};
$payit{'amt'} = $POST{'amount'};
# check for valid method
$pay{'method'} = lc($POST{'method'});
return LJ::bad_input("Invalid payment method: $pay{'method'}")
unless grep { $pay{'method'} } keys %methods;
# check datesent format
return LJ::bad_input("Invalid date format.")
unless $POST{'datesent'} =~ /^\d\d\d\d-\d\d-\d\d/;
$pay{'datesent'} = $POST{'datesent'};
# paid account
if ($POST{'item'} eq "paidacct") {
return LJ::bad_input("No months specified or auto-detected. Payment <b>not</b> entered.")
unless $POST{'paidacct_mo'};
$payit{'subitem'} = undef;
$payit{'qty'} = $POST{'paidacct_mo'};
# perm account
} elsif ($POST{'item'} eq 'perm') {
# need a special priv to grant perm accounts
return LJ::bad_input("You do not have permission to create permanent accounts.")
unless $grant_perm;
# coupons
} elsif ($POST{'item'} eq 'coupon') {
return LJ::bad_input("You selected a coupon but didn't enter a dollar amount.")
unless $POST{'amount'};
$payit{'subitem'} = "dollaroff";
$payit{'subitem'} .= $POST{'coupon_type'} =~ /^(tan|int)$/ ? $POST{'coupon_type'} : '';
$payit{'qty'} = undef;
# userpics
} elsif ($POST{'item'} eq 'userpic') {
return LJ::bad_input("Cannot send userpics to an email address")
unless $rcptuserid;
return LJ::bad_input("Must specify a number of months for userpics")
unless $POST{'userpic_mo'};
return LJ::bad_input("Cannot apply userpics to the account.")
unless LJ::Pay::can_apply_bool_bonus($rcptuserid, undef, 'userpic');
$payit{'qty'} = $POST{'userpic_mo'};
$payit{'subitem'} = undef;
# disk quota
} elsif ($POST{'item'} eq 'diskquota') {
return LJ::bad_input("Cannot send disk quota to an email address")
unless $rcptuserid;
return LJ::bad_input("Must specify a number of months for disk quota.")
unless $POST{'diskquota_mo'};
return LJ::bad_input("Must specify a size (in megabytes) for disk quota.")
unless $POST{'diskquota_size'};
return LJ::bad_input("Cannot apply disk quota to account.")
unless LJ::Pay::can_apply_sized_bonus($rcptuserid, undef, 'diskquota',
$POST{'diskquota_size'}, $POST{'diskquota_mo'});
$payit{'qty'} = $POST{'diskquota_mo'};
my ($prev_exp, $prev_size) = LJ::Pay::get_bonus_dim($rcptuserid, 'diskquota');
$payit{'subitem'} = "$POST{'diskquota_size'}-$prev_exp-$prev_size";
# rename token
} elsif ($POST{'item'} eq 'rename') {
# subitem, qty need to be undef, so that's already fine
# verify it's a valid item
} else {
return LJ::bad_input("Must select the item the user is paying for.");
}
$payit{'item'} = $POST{'item'};
$payit{'rcptemail'} = $rcptemail || undef;
$payit{'rcptid'} = $rcptuserid || 0;
# at this point, the following should be properly set and validated:
# - %pay: (datesent, amount)
# - %payit: (rcptid, rcptemail, amt, item, subitem, qty)
### now, insert a payment
my $dbh = LJ::get_db_writer();
$dbh->do("INSERT INTO payments (anum, userid, datesent, daterecv, amount, " .
"used, mailed, notes, method, forwhat) " .
"VALUES (0, ?, ?, NOW(), ?, 'N', 'N', ?, ?, 'cart')",
undef, $userid, $pay{'datesent'}, $pay{'amount'},
$POST{'notes'}, $pay{'method'});
return "<?h1 Database Error! h1?><?p " . $dbh->errstr . " p?>" if $dbh->err;
my $payid = $dbh->{'mysql_insertid'};
$payit{'payid'} = $payid;
$dbh->do("INSERT INTO payvars (payid, pkey, pval) VALUES (?, 'notes', ?)",
undef, $payid, $POST{'inote'}) if $POST{'inote'};
# create a coupon if necessary
if ($payit{'item'} eq "coupon") {
my $type = "dollaroff";
my $cptype = $POST{'coupon_type'} =~ /^(tan|int)$/ ? $POST{'coupon_type'} : '';
$type .= $cptype;
($payit{'tokenid'}, $payit{'token'}) =
LJ::Pay::new_coupon($type, $payit{'amt'}, $rcptuserid, $payid);
return "<?h1 Error h1?><?p Error generating coupon. p?>"
unless $payit{'tokenid'} && $payit{'token'};
my $cpemail = $rcptemail;
if ($rcptuserid) {
my $u = LJ::load_userid($rcptuserid);
$cpemail = $u->{'email'} if $u;
# we kindasorta trust this user now
LJ::Pay::note_payment_from_user($u);
}
LJ::Pay::send_coupon_email($cpemail, $payit{'token'}, $payit{'amt'}, $cptype);
}
# now that we've optionally created a coupon token, log a payitem row
{
my $cartobj = LJ::Pay::load_cart("$payid-0");
LJ::Pay::add_cart_item($cartobj, \%payit)
or return "<?h1 Error h1?><?p Error generating cart item. p?>";
}
# log a statushistory row if there's a userid to associate it with
if ($userid) {
my $mo = $POST{'months'}+0;
my $rcpt = "rcptemail=$rcptemail";
if ($rcptuserid) {
my $u = LJ::load_userid($rcptuserid);
$rcpt = "rcptuser=$u->{'user'}" if $u;
}
LJ::statushistory_add($userid, $remote->{'userid'}, "payenter",
"item=$payit{'item'}, subitem=$payit{'subitem'}, qty=$payit{'qty'}, amt=$payit{'amt'}, $rcpt");
}
# send email notification of this action
my $rcpt = $rcptuser || $rcptemail;
my $msgbody = "Entered by $remote->{'user'}: payment \#$payid for $rcpt\n\n";
foreach my $k (sort keys %POST) {
$msgbody .= "$k:\n===============\n$POST{$k}\n\n";
}
LJ::send_mail({ 'to' => "paypal\@$LJ::DOMAIN", # TODO: not paypal
'from' => $LJ::BOGUS_EMAIL,
'subject' => "Payment \#$payid -- $rcpt",
'body' => $msgbody,
});
$dbh->do("INSERT INTO paymentsearch (payid, ikey, ival) VALUES (?,?,?)",
undef, $payid, "handemail", $rcptemail)
unless $userid;
return "<?h1 Success h1?><?p Payment \#$payid entered for <b>$rcpt</b> for \$$pay{'amount'} for: p?><ul>" .
join("", map { "<li>$_->[0]=$_->[1]</li>" }
(['user' => $user], ['rcptuser' => $rcptuser], ['rcptemail' => $rcptemail],
['method' => lc($POST{'method'})], ['item' => $payit{'item'}],
['subitem' => $payit{'subitem'}], ['qty' => $payit{'qty'}], ['token' => $payit{'token'} ])
) .
"</ul>";
}
# payment form
my $ret;
$ret = "Hello, $remote->{'user'}! Enter a payment:";
$ret .= "<hr /><form method='post'>";
$ret .= "<table align='left'><tr valign='top'><td align='left'>";
$ret .= "<table><tr><td align='right'>Payment Type:</td>";
$ret .= "<td>" . LJ::html_select({ 'name' => 'method' },
'', '(select)', map { $_ => $methods{$_} } keys %methods) . "</td></tr>";
$ret .= "<tr>";
$ret .= $GET{'newacct'} ?
("<td align='right'>Rcpt Email:</td>" .
"<td>" . LJ::html_text({ 'name' => 'email', 'size' => '40', 'maxlength' => 50 }) .
"(<a href='enternew.bml'>back</a>)</td>") :
("<td align='right'>Rcpt Username:</td>" .
"<td>" . LJ::html_text({ 'name' => 'user', 'size' => 15, 'maxlength' => 15 }) .
"(<a href='enternew.bml?newacct=1'>new account?</a>)</td>");
$ret .= "</tr>";
$ret .= "<tr valign='top'><td align='right'>Gift From <sup>(Opt)</sup>:</td><td>";
$ret .= LJ::html_text({ 'name' => 'giftfrom', 'size' => 15, 'maxlength' => 15 });
$ret .= "</td></tr>";
$ret .= "<tr valign='top'><td align='right'>Date Sent:</td><td>";
$ret .= LJ::html_text({ 'name' => 'datesent', 'size' => 23, 'maxlength' => 19, 'value' => LJ::mysql_time() });
$ret .= "<br /><tt>yyyy-mm-dd <font color='#909090'>[hh:mm:ss]</font></tt></td></tr>";
$ret .= "<tr><td align='right'>Amount:</td><td>";
$ret .= "\$" . LJ::html_text({ 'name' => 'amount', 'size' => 6, 'maxlength' => 6 }) . " USD</td></tr>";
# notes
$ret .= "<tr><td align='right' valign='top'>Internal note:</td><td>";
$ret .= LJ::html_text({ 'name' => 'inote', 'size' => 40, 'maxlength' => 255 });
$ret .= "</td></tr>";
$ret .= "<tr><td align='right' valign='top'>Note to user:</td><td>";
$ret .= LJ::html_textarea({ 'name' => 'notes', 'rows' => 10, 'cols' => 40, 'wrap' => 'soft' });
$ret .= "</td></tr>";
$ret .= "<tr><td>&nbsp;</td><td>";
$ret .= LJ::html_submit('submit', "Process Payment");
$ret .= "</td></tr></table>";
$ret .= "</td><td align='left'>";
# indivual item types
$ret .= "<table cellspacing=0 cellpadding=0>";
my $sep = "<tr><td>&nbsp;</td><td><hr></td></tr>";
# paid time
$ret .= "<tr valign='top'><td align='right'>";
$ret .= "<label for='item-paidacct'>Paid time:</label> ";
$ret .= LJ::html_check({ 'type' => 'radio', 'name' => 'item', 'value' => 'paidacct',
'id' => 'item-paidacct' }) . "</td>";
$ret .= "<td>Months: ";
$ret .= LJ::html_text({ 'name' => 'paidacct_mo', 'size' => 2, 'maxlength' => 2 });
$ret .= "</td></tr>";
$ret .= $sep;
# permanent account
if ($grant_perm) {
$ret .= "<tr valign='top'><td align='right'>";
$ret .= "<label for='item-perm'>Permanent Acct:</label> ";
$ret .= LJ::html_check({ 'type' => 'radio', 'name' => 'item', 'value' => 'perm',
'id' => 'item-perm' }) . "</td>";
$ret .= "<td>&nbsp;</td></tr>";
$ret .= $sep;
}
# userpics
$ret .= "<tr valign='top'>";
$ret .= "<td align='right'><label for='item-userpic'>Userpics:</label> ";
$ret .= LJ::html_check({ 'type' => 'radio', 'name' => 'item', 'value' => 'userpic',
'id' => 'item-userpic' }) . "</td>";
$ret .= "<td> Months: ";
$ret .= LJ::html_text({ 'name' => 'userpic_mo', 'size' => 2, 'maxlength' => 2 });
$ret .= "</td></tr>";
$ret .= $sep;
# quota
$ret .= "<tr valign='top'>";
$ret .= "<td align='right'><label for='item-diskquota'>Disk Quota:</label> ";
$ret .= LJ::html_check({ 'type' => 'radio', 'name' => 'item', 'value' => 'diskquota',
'id' => 'item-diskquota' }) . "</td>";
$ret .= "<td><table cellspacing=0><tr valign='top'><td>Size:</td><td>";
$ret .= LJ::html_text({ 'name' => 'diskquota_size', 'size' => 4, 'maxlength' => 4 });
$ret .= "</td></tr><tr valign='top'><td>Months:</td><td>";
$ret .= LJ::html_text({ 'name' => 'diskquota_mo', 'size' => 2, 'maxlength' => 2 });
$ret .= "</td></tr></table";
$ret .= "</td></tr>";
$ret .= $sep;
# coupons
$ret .= "<td align='right'><label for='item-coupon'>Coupon:</label> ";
$ret .= LJ::html_check({ 'type' => 'radio', 'name' => 'item', 'value' => 'coupon',
'id' => 'item-coupon' }) . "</td>";
$ret .= "<td> ". LJ::html_select({ 'type' => 'check', 'name' => 'coupon_type',
'id' => 'coupon_type', 'value' => 'gen' },
'gen' => "General",
'int' => "Intangible only",
'tan' => "Tangible only", );
$ret .= "</td></tr>";
$ret .= $sep;
# rename
$ret .= "<tr valign='top'>";
$ret .= "<td align='right'><label for='item-rename'>Rename:</label> ";
$ret .= LJ::html_check({ 'type' => 'radio', 'name' => 'item', 'value' => 'rename',
'id' => 'item-rename' }) . "</td>";
$ret .= "<td>&nbsp;</td></tr>";
$ret .= "</table>";
return $ret;
}
_code?>

66
ljcom/htdocs/admin/accounts/fraud_suspects.bml Normal file
View File

@@ -0,0 +1,66 @@
<html><head>
<title>Fraud suspects</title>
<style>
h1 { font-size: 20pt; }
h2 { font-size: 17pt; }
.label { background: #ccc; text-align: right; vertical-align: top; }
.data { background: #eee; padding-left: 10px; }
.tbl td { border-bottom: 1px solid #aaa; }
.tbl
{
font-family: Verdana, sans-serif;
font-size: 11px;
border-top: 1px solid #aaa;
border-right: 1px solid #aaa;
border-left: 1px solid #aaa;
width: 500px; margin-bottom: 10px;
}
</style>
</head><body>
<?_code
my $dbh = LJ::get_db_writer();
my $ret;
my $remote = LJ::get_remote();
my $viewall = LJ::remote_has_priv($remote, "moneyview");
my $viewsearch = 0;
if (! $viewall) {
$viewsearch = LJ::remote_has_priv($remote, "moneysearch");
}
unless ($viewall || $viewsearch) {
return "You don't have access to see this, or you're not logged in.";
}
my $sql = q{
SELECT * FROM fraudsuspects
};
my $data = $dbh->selectall_hashref($sql, 'payid', undef);
$ret .= "<h1>Possible fraudulent payments</h1>";
foreach my $row (sort { $a->{dateadd} <=> $b->{dateadd} } values %$data) {
my $added = gmtime($row->{dateadd});
my $reason = $row->{reason};
$reason =~ s#\n#<br />#mg;
$ret .= <<EOF;
<table border='0' cellspacing='0' class='tbl'>
<tr>
<td class='label'>Payid:</td>
<td class='data'><a href='paiddetails.bml?payid=$row->{payid}'>$row->{payid}</a></td>
</tr>
<td class='label'>Date added:</td>
<td class='data'>$added</td>
</tr>
<td class='label'>Reason:</td>
<td class='data'>$reason</td>
</tr>
</table>
EOF
}
return $ret;
_code?>
</body></html>

3
ljcom/htdocs/admin/accounts/notes.html Normal file
View File

@@ -0,0 +1,3 @@
<h1>Other resources to know:</h1>
<a href="http://www.livejournal.com/paidaccounts/apply.bml">http://www.livejournal.com/paidaccounts/apply.bml</a> -- apply a code towards an account (the logged in user must do it)

213
ljcom/htdocs/admin/accounts/paiddetails.bml Normal file
View File

@@ -0,0 +1,213 @@
<html><head>
<title>Paid Details</title>
<style>
h1 { font-size: 20pt; }
h2 { font-size: 17pt; }
.fraud
{
position: absolute;
top: 10px;
left: 600px;
border: 2px solid #842020;
padding: 4px;
background: #eed9d9;
width: 400px;
}
</style>
</head><body>
<?_code
my $dbh = LJ::get_db_writer();
my ($ret, $sth);
my $remote = LJ::get_remote();
my $viewall = LJ::remote_has_priv($remote, "moneyview");
my $viewsearch = 0;
if (! $viewall) {
$viewsearch = LJ::remote_has_priv($remote, "moneysearch");
}
unless ($viewall || $viewsearch) {
return "You don't have access to see this, or you're not logged in.";
}
$FORM{'payid'} =~ s/\-\d+//;
unless ($FORM{'payid'}) {
return "<form method='get'>Enter payid (or order number): <input name='payid' size='10'> <input type='submit' value='View'></form>";
}
my $payid = $FORM{'payid'}+0;
## for people without moneyview priv, they have to have userid arg
my $extrawhere = "";
if (! $viewall) {
my $userid = $FORM{'userid'}+0;
$extrawhere = "AND p.userid=$userid";
}
if ($FORM{'userid'} eq "0") { # not == 0
$sth = $dbh->prepare("SELECT * FROM payments WHERE payid=$payid AND userid=0");
} else {
$sth = $dbh->prepare("SELECT p.*, u.user FROM payments p LEFT JOIN useridmap u ON u.userid=p.userid WHERE p.payid=$payid $extrawhere");
}
$sth->execute;
my $pm = $sth->fetchrow_hashref;
return "Invalid payment ID, or missing arguments" unless $pm;
# see if a code is associated with this payment:
my $cd = $dbh->selectrow_hashref("SELECT ac.* FROM acctpay ap, acctcode ac ".
"WHERE ap.payid=$payid AND ap.acid=ac.acid");
if ($cd) {
my $code = LJ::acct_code_encode($cd->{'acid'}, $cd->{'auth'});
$ret .= "<b>From code: </b> <tt>$code</tt>";
if ($cd->{'userid'}) {
$ret .= " (created by " . LJ::ljuser(LJ::get_username($dbh, $cd->{'userid'})) . ")";
}
if ($cd->{'rcptid'}) {
$ret .= " (used by " . LJ::ljuser(LJ::get_username($dbh, $cd->{'rcptid'})) . ")";
} else {
$ret .= " (code is unused)";
}
}
# see if a rename is associated with this payment
if ($pm->{'forwhat'} eq "rename") {
my $rn = $dbh->selectrow_hashref("SELECT renid, token, fromuser, touser, rendate ".
"FROM renames WHERE payid=?", undef, $payid);
if ($rn) {
my $code = sprintf("%06x%s", $rn->{'renid'}, $rn->{'token'});
$ret .= "<p><b>Rename Code</b>: <tt>$code</tt> (from: $rn->{'fromuser'}, to: $rn->{'touser'}, rendate: $rn->{'rendate'})</p>";
}
}
$ret .= "<h1>Payment \#$pm->{'payid'}</h1>";
$ret .= "<b>Amount:</b> \$$pm->{'amount'} <b>Method:</b> $pm->{'method'} <b>For:</b> $pm->{'forwhat'} ";
if ($pm->{'giftafter'}) {
$ret .= " (to be delivered: " . scalar(gmtime($pm->{'giftafter'})) . " (GMT)";
}
$ret .= "<br /><b>Date sent:</b> $pm->{'datesent'} <b>Recv:</b> $pm->{'daterecv'}";
$ret .= "<br /><b>Used:</b> $pm->{'used'} <b>Mailed:</b> $pm->{'mailed'}";
$ret .= "<br /><b>Buyer:</b> ";
if ($pm->{'user'}) {
$ret .= LJ::ljuser($pm->{'user'});
}
if ($pm->{'notes'}) {
my $not = LJ::eall($pm->{'notes'});
$not =~ s/\n/<br>\n/g;
$ret .= "<br /><b>Notes:</b> $not";
}
# clear fraud flag
if (LJ::did_post() && $FORM{fraudclear}) {
LJ::Pay::payvar_set($payid, "fraud_status", "clear");
$dbh->do("DELETE FROM fraudsuspects WHERE payid=?", undef, $payid);
}
# vars
$ret .= "<p>";
$sth = $dbh->prepare("SELECT pkey, pval FROM payvars WHERE payid=?");
$sth->execute($payid);
my ($refund, $fraud_status);
while (my ($k, $v) = $sth->fetchrow_array) {
if ($k eq "an-refund") {
my @parts = split(/,/, $v);
$refund = $v; $v = "<i>(hidden)</i> expir=$parts[1]";
}
$fraud_status = $v if $k eq 'fraud_status';
$ret .= "<tt><b>$k</b></tt> = $v<br />\n";
}
if ($fraud_status eq 'suspect') {
my $sql = q{
SELECT dateadd, reason
FROM fraudsuspects
WHERE payid=?
};
my ($added, $reason) = $dbh->selectrow_array($sql, undef, $payid);
$added = $added ? gmtime($added) . ' GMT' : 'unknown';
$reason ||= '?';
$reason =~ s#\n#<br />#mg;
$ret .= <<EOF;
<form method='post' action='paiddetails.bml'>
<div class='fraud'>
This payment has been flagged as possible fraud.
<br /><br />
<strong>Date added: </strong>$added<br />
<strong>Reason(s): </strong><br />
<div style='margin-left: 20px'>$reason</div>
<br />
<input type='submit' name='fraudclear' value='Clear'>
<input type='hidden' value='$payid' name='payid'>
</div>
</form>
EOF
}
$sth = $dbh->prepare("SELECT ikey, ival FROM paymentsearch WHERE payid=?");
$sth->execute($payid);
while (my ($k, $v) = $sth->fetchrow_array) {
$ret .= "<tt><b>$k</b></tt> = $v<br />\n";
}
$ret .= "</p>";
my $cartobj;
if ($pm->{'forwhat'} eq "cart") {
my $cart = "$pm->{'payid'}-$pm->{'anum'}";
$ret .= "<h1>Order $cart</h1>";
$cartobj = LJ::Pay::load_cart($cart);
LJ::Pay::render_cart($cartobj, \$ret, {
'tokens' => 1,
'piids' => 1,
});
$ret .= "<small><b>all piids:</b> " . join(", ", map { $_->{'piid'} } @{$cartobj->{'items'}}) . "</small>";
}
$ret .= "<h1>Authorize.net Transaction Log</h1>";
my @anet;
$sth = $dbh->prepare("SELECT cmd, datesent, ip, amt, result, response, cmdnotes ".
"FROM authnetlog WHERE payid=?");
$sth->execute($payid);
push @anet, $_ while $_ = $sth->fetchrow_hashref;
if (@anet) {
$ret .= "<table border='1' cellpadding='2'><tr>";
foreach (qw(date/ip cmd amt result extra)) {
$ret .= "<td><b>$_</b></td>";
}
$ret .= "</tr>";
foreach my $an (@anet) {
my @fields = split(/,/, $an->{'response'});
my $extra;
if ($an->{'cmd'} eq "authcap") {
$extra = "authnet_txn = $fields[6]";
}
$ret .= "<tr><td><small>$an->{'datesent'}<br />$an->{'ip'}</small></td><td>$an->{'cmd'}</td><td>\$$an->{'amt'}</td><td><b>$an->{'result'}</b>: $fields[3]</td><td>$extra</td></tr>\n";
}
$ret .= "</table>";
} else {
$ret .= "<i>No Authorize.net history</i>";
}
$ret .= "<h1>Revoke & Refund</h1>";
$ret .= "<form method='post' action='rr.bml'>";
$ret .= LJ::html_hidden("cart", "${payid}-$cartobj->{'anum'}");
$ret .= "Item piids to revoke/refund: <input name='plist' size='30'> (comma or space separated)";
if ($cartobj->{'method'} eq "cc") {
if (! $refund) {
$ret .= "<br />Partial Card Number: <input name='partialnum' size='12'> (1234***5678) Exp. Date: <input name='expdate' size='7'> (mm/yyyy)";
}
$ret .= "<br /><input type='checkbox' value='1' name='no_refund' id='no_refund'> <label for='no_refund'>Don't refund, just revoke (if chargeback, and bank already did it)</label>\n";
}
$ret .= "<br />Opt. notes: <input name='refreason' size='40' />\n";
$ret .= "<br /><input type='submit' value='Revoke+Refund'>\n";
$ret .= "<small>[ <b>Only press once and wait!</b> ]</small>";
$ret .= "</form>";
return $ret;
_code?>
</body></html>

161
ljcom/htdocs/admin/accounts/paidsearch.bml Normal file
View File

@@ -0,0 +1,161 @@
<html>
<head><title>Paid Search</title></head>
<body>
<?_code
{
use strict;
use vars qw(%GET);
my $remote = LJ::get_remote();
return "You must first <a href=\"/login.bml?ret=1\">login</a>."
unless $remote;
unless (LJ::remote_has_priv($remote, "moneysearch") ||
LJ::remote_has_priv($remote, "moneyview"))
{
return "You don't have access to see this.";
}
my $ret;
my $user = $GET{'user'};
$ret .= "<h1>Search for payments.</h1>\n";
$ret .= "<form method='get'>";
$ret .= "Search method: ";
$ret .= LJ::html_select({ 'name' => 'method', 'selected' => $GET{'method'} },
'user' => "Username",
'email' => "Email",
'lastname' => "Last Name",
'pptxnid' => "PayPal - transaction ID",
'cpid' => "Coupon",
# 'ppemail' => "Email",
# 'pplastname' => "PayPal - last name",
# 'handemail' => "Manually entered email",
);
$ret .= " Search value: ";
$ret .= LJ::html_text({ 'name' => 'value',
'value' => $GET{'value'},
'size' => 30 });
$ret .= "<input type=\"submit\" value=\"Search\"></form><hr>";
return $ret unless $GET{'method'};
my $dbh = LJ::get_db_writer();
my $sth;
my %matched;
my @ps_vars; # payment search vars;
# by-user search
if ($GET{'method'} eq "user") {
my $user = $GET{'value'};
my $userid = LJ::get_userid($user);
unless ($userid) {
$ret .= "<p><b>Error:</b> Username not found.";
return $ret;
}
# include payments created by the user
$sth = $dbh->prepare("SELECT payid FROM payments WHERE userid=?");
$sth->execute($userid);
$matched{$_} = 1 while $_ = $sth->fetchrow_array;
# include payments with payment items for that user
$sth = $dbh->prepare("SELECT payid FROM payitems WHERE rcptid=?");
$sth->execute($userid);
$matched{$_} = 1 while $_ = $sth->fetchrow_array;
# HACK: mysql doesn't optimize these queries properly, so we'll do it by hand: much faster
{
my @acid = (
@{ $dbh->selectcol_arrayref
("SELECT acid FROM acctcode WHERE userid=? LIMIT 5000", undef, $userid)||[] },
@{ $dbh->selectcol_arrayref
("SELECT acid FROM acctcode WHERE rcptid=? LIMIT 5000", undef, $userid)||[] },
);
my $bind = join(",", map { "?" } @acid);
# include payments tied to account codes either purchased by or used by the user (new payment system)
$sth = $dbh->prepare("SELECT pi.payid FROM acctpayitem p, payitems pi " .
"WHERE pi.piid=p.piid AND p.acid IN ($bind) LIMIT 5000");
$sth->execute(@acid);
$matched{$_} = 1 while $_ = $sth->fetchrow_array;
# include payments tied to account codes either purchased by or used by the user (new payment system)
$sth = $dbh->prepare("SELECT payid FROM acctpay WHERE acid IN ($bind) LIMIT 5000");
$sth->execute(@acid);
$matched{$_} = 1 while $_ = $sth->fetchrow_array;
}
}
# by-email search
if ($GET{'method'} eq "email") {
my $email = $GET{'value'};
# payment search vars: ppemail (from a paypal payment notification)
# and 'handemail' (manually entered (before cart system))
push @ps_vars, qw(ppemail handemail);
# from rcptemail
$sth = $dbh->prepare("SELECT payid FROM payitems WHERE ".
"rcptemail=?");
$sth->execute($email);
$matched{$_} = 1 while $_ = $sth->fetchrow_array;
}
# coupon search
if ($GET{'method'} eq "cpid") {
my $cpid = $GET{'value'};
# accept $cpid-$auth, but only care about $cpid
$cpid =~ s/^(\d+).*/$1/;
# get the payid that used/bought this coupon
my ($payid, $ppayid) =
$dbh->selectrow_array("SELECT payid, ppayid FROM coupon " .
"WHERE cpid=?", undef, $1);
$matched{$payid} = 1 if $payid; # transaction coupon was used on
$matched{$ppayid} = 1 if $ppayid; # transaction where coupon was purchased
}
# paypal transaction ID or last name
push @ps_vars, "pplastname" if $GET{'method'} eq "lastname";
push @ps_vars, "pptxnid" if $GET{'method'} eq "pptxnid";
# include any paymentsearch vars the above modes might want
for my $var (@ps_vars) {
$sth = $dbh->prepare("SELECT payid FROM paymentsearch WHERE ".
"ikey=? AND ival=?");
$sth->execute($var, $GET{'value'});
$matched{$_} = 1 while $_ = $sth->fetchrow_array;
}
return $ret. "<i>No matches</i>" unless %matched;
my $in = join(',', keys %matched);
$sth = $dbh->prepare("SELECT p.*, u.user ".
"FROM payments p LEFT JOIN useridmap u ".
"ON p.userid=u.userid ".
"WHERE p.payid IN ($in) ORDER BY p.payid");
$sth->execute;
$ret .= "<table cellpadding=4 cellspacing=1 border=1><tr><td><b>Pay ID#</b></td><td><b>User</b></td><td><b>Date Sent/Recv</b><td><b>Amount</b></td><td><b>Months</b></td><td><b>Used/Mailed</b></td><td><b>Method</b></td></tr>\n";
while (my $row = $sth->fetchrow_hashref)
{
my $amount = sprintf("\$%.02f", $row->{'amount'});
my $usedmailed = "$row->{'used'}/$row->{'mailed'}";
if ($row->{'mailed'} eq "C") {
$usedmailed = "Unpaid! Still in cart!";
}
$ret .= "<TR VALIGN=TOP><TD ALIGN=CENTER><A HREF=\"paiddetails.bml?payid=$row->{'payid'}&userid=$row->{'userid'}\">#$row->{'payid'}</A></TD><TD><B><A HREF=\"/userinfo.bml?user=$row->{'user'}\">$row->{'user'}</A></B></TD><TD>$row->{'datesent'}<BR>$row->{'daterecv'}</TD><TD ALIGN=RIGHT>$amount</TD><TD ALIGN=RIGHT>$row->{'months'}</TD><TD ALIGN=CENTER>$usedmailed</TD><TD>$row->{'method'}</TD></TR>";
}
$ret .= "</table>\n";
return $ret;
}
_code?>
</body>
</html>

209
ljcom/htdocs/admin/accounts/paidsummary.bml Normal file
View File

@@ -0,0 +1,209 @@
<?_code
{
use strict;
use vars qw(%GET);
my $remote = LJ::get_remote();
return "You must first <a href=\"/login.bml?ret=1\">log in</a>."
unless $remote;
return "You don't have access to see this."
unless LJ::remote_has_priv($remote, "moneyview");
my $dbh = LJ::get_dbh("slow", "slave", "master")
or return "database unavailable";
my ($ret, $sth);
my $wholemonth = 0;
if ($GET{'day'} eq "*") { $wholemonth = 1; }
my $year = $GET{'year'}+0;
my $month = $GET{'month'}+0;
my $day = $GET{'day'}+0;
unless ($year && $month) {
my @time = localtime();
$year = $time[5]+1900;
$month = $time[4]+1;
$day = $time[3];
}
if ($wholemonth) { $day = "*"; }
$ret .= "<form method='GET'>";
$ret .= "Year: " . LJ::html_text({ 'name' => 'year', 'size' => 4, 'value' => $year }) . " ";
$ret .= "Month: " . LJ::html_text({ 'name' => 'month', 'size' => 2, 'value' => $month }) . " ";
$ret .= "Day: " . LJ::html_text({ 'name' => 'day', 'size' => 2, 'value' => $day }) . " ";
$ret .= LJ::html_submit('View') . "</form> (enter * for day to get month report)";
my ($date_low, $date_high);
# whole month
my $fmt = sub { $dbh->quote(sprintf("%02d-%02d-%02d 00:00:00", @_)) };
if ($day eq '*') {
$date_low = $fmt->($year, $month, '01');
if ($month+1 > 12) {
$date_high = $fmt->($year+1, 1, '01');
} else {
$date_high = $fmt->($year, $month+1, '01');
}
} else {
$date_low = $fmt->($year, $month, $day);
if ($day+1 > LJ::days_in_month($month, $year)) {
if ($month+1 > 12) {
$date_high = $fmt->($year+1, 1, '01');
} else {
$date_high = $fmt->($year, $month+1, '01');
}
} else {
$date_high = $fmt->($year, $month, $day+1);
}
}
$sth = $dbh->prepare("SELECT * FROM payments WHERE mailed<>'C' AND daterecv>$date_low AND daterecv<$date_high");
$sth->execute;
my @rows = ();
push @rows, $_ while $_ = $sth->fetchrow_hashref;
my $u = LJ::load_userids( map { $_->{userid} } @rows );
$ret .= "<table style='margin-top: 10px;' cellpadding='4' cellspacing='1' border='1'><tr><td><b>Pay ID#</b></td><td><b>User</b></td><td><b>Date Sent/Recv</b><td><b>Amount</b></td><td><b>Used/Mailed</b></td><td><b>Method</b></td></tr>\n";
my $totalmoney = 0;
my %methodcount = ();
my %methodtotal = ();
my %daycount = ();
my %daytotal = ();
my $row_ct = 0;
my $row_show = 0;
my $row_skip = 0;
my $row_html;
foreach my $row (@rows)
{
my $amount = sprintf("\$%.02f", $row->{'amount'});
$totalmoney += $row->{'amount'};
$methodcount{$row->{'method'}}++;
$methodtotal{$row->{'method'}} += $row->{'amount'};
if ($row->{'daterecv'} =~ /^(\d\d\d\d-\d\d-\d\d)/) {
my $day = $1;
$daycount{$day}++;
$daytotal{$day} += $row->{'amount'};
}
$row_ct++;
next if $GET{'skip'} && ++$row_skip <= $GET{'skip'};
if ($row_show < 500) {
my $user = $u->{$row->{userid}}->{user};
$row_show++;
$row_html .= "<tr valign='top'><td align='center'><a href=\"paiddetails.bml?payid=$row->{'payid'}\">#$row->{'payid'}</a></td><td><b><a href=\"/userinfo.bml?user=$user\">$user</a></b></td><td>$row->{'datesent'}<br />$row->{'daterecv'}</td><td align='right'>$amount</td><td align='center'>$row->{'used'}/$row->{'mailed'}</td><td>$row->{'method'}</td></tr>";
}
}
my $slinks;
if ($GET{'skip'}) {
$slinks .= "<a href=\"" . BML::self_link({ 'skip' => $GET{'skip'} - 500}) . "\">&lt;&lt; Back</a> ";
}
if ($row_show != $row_ct) {
my $from = $GET{'skip'}+1;
my $to = $row_show+$GET{'skip'};
$slinks .= "(Records $from-$to of $row_ct) ";
}
if ($GET{'skip'} + $row_show < $row_ct) {
$slinks .= "<a href=\"" . BML::self_link({ 'skip' => $GET{'skip'} + 500}) . "\">Forward &gt;&gt;</a> ";
}
my $bar_html;
$bar_html .= "<tr><td colspan='7' align='center' bgcolor='#c0c0c0'><i>$slinks</i></td></tr>\n"
if $slinks;
$ret .= $bar_html;
$ret .= $row_html;
$ret .= $bar_html;
$ret .= "</table>\n";
return $ret unless @rows;
$ret .= "<p><b>Statistics:</b><ul>";
$ret .= "<li>Total money: <b>" . sprintf("\$%.02f", $totalmoney) . "</b></li>\n";
$ret .= "<li>Break-down by payment method:<ul>";
foreach my $method (sort keys %methodcount) {
$ret .= "<li>$method: <b>$methodcount{$method} = " . sprintf("\$%.02f", $methodtotal{$method}) . "</b></li>\n";
}
$ret .= "</ul></li>";
$ret .= "<li>Break-down by day:<ul>";
foreach my $day (sort keys %daycount) {
$ret .= "<li>$day: <b>$daycount{$day} = " . sprintf("\$%.02f", $daytotal{$day}) . "</b></li>\n";
}
$ret .= "</ul></li>";
$ret .= "<li>Break-down by item type:<ul>";
my @payid_in = map { $_->{payid} } @rows;
my $payid_bind = join(",", map { '?' } @rows);
$sth = $dbh->prepare("SELECT * FROM payitems WHERE status='done' AND payid IN ($payid_bind)");
$sth->execute(@payid_in);
die $dbh->errstr if $dbh->err;
my %idata = ();
while (my $it = $sth->fetchrow_hashref) {
my $item = $it->{item};
my $subkey = $item . (LJ::Pay::is_bonus($it, 'sized') ? ('-' . (split('-', $it->{subitem}))[0]) : '') . ($it->{qty} ? "-$it->{qty}" : '');
foreach my $ref ($idata{$item}, $idata{$item}->{sub}->{$subkey}) {
$ref->{ct}++;
$ref->{sum_pos} += $it->{amt} if $it->{amt} > 0;
$ref->{sum_neg} += $it->{amt} if $it->{amt} < 0;
}
delete $idata{$item}->{sub} if $item eq $subkey;
}
# sorts with proper string/integer comparisons on key parts
my $sort_sub = sub {
my ($aname, $asize, $aqty) = split('-', $a);
if ($asize && ! $aqty) { $aqty = $asize; $asize = 0; }
my ($bname, $bsize, $bqty) = split('-', $b);
if ($bsize && ! $bqty) { $bqty = $bsize; $bsize = 0; }
return $bname cmp $aname || $bsize <=> $asize || $bqty <=> $aqty;
};
# recursive closure to display items, counts, totals
my $show_item;
$show_item = sub {
my ($itemname, $ref) = @_;
return '' unless $ref;
my $r = "<li>$itemname: <b>$ref->{ct}</b> = " . sprintf("\$%.02f", $ref->{sum_pos});
$r .= ", " . sprintf("\$%.02f", $ref->{sum_neg}) if $ref->{sum_neg};
if (%{$ref->{sub}||{}}) {
$r .= "<ul>";
$r .= $show_item->($_, $ref->{sub}->{$_})
foreach sort $sort_sub keys %{$ref->{sub}};
$r .= "</ul>";
}
$r .= "</li>";
return $r;
};
# build tree of items
foreach my $item (sort $sort_sub keys %idata) {
$ret .= $show_item->($item, $idata{$item});
}
$ret .= "</ul></li>\n";
$ret .= "</ul></p>";
return $ret;
}
_code?>

199
ljcom/htdocs/admin/accounts/rr.bml Normal file
View File

@@ -0,0 +1,199 @@
<?_code
{
use strict;
use vars qw(%POST);
use LWP;
use LWP::UserAgent;
my $dbh = LJ::get_db_writer();
my $sth;
my $remote = LJ::get_remote();
return "<?needlogin?>" unless $remote;
unless (LJ::remote_has_priv($remote, "moneyenter")) {
return "You don't have rights to refund/revoke payments.";
}
return "POST required" unless LJ::did_post();
my $cartobj = LJ::Pay::load_cart($POST{'cart'});
return "Invalid cart." unless $cartobj;
return "Can't refund/revoke items that weren't paid for."
unless $cartobj->{'used'} eq "Y";
my %refund;
foreach my $n (split(/[\s\,]+/, $POST{'plist'})) {
next if $n =~ /\D/;
unless (grep { $_->{'piid'} == $n } @{$cartobj->{'items'}}) {
return "Invalid piid ($n) for this order.";
}
$refund{$n} = 1;
}
my @revoke;
my $refund_amt;
my $total_refund = 1;
foreach my $it (@{$cartobj->{'items'}}) {
if ($refund{$it->{'piid'}} && ($it->{'status'} eq "done" || $it->{'status'} eq "pend")) {
push @revoke, $it;
$refund_amt += $it->{'amt'};
# note we've already refunded shipping for this item
$it->{'ship_refund_done'}++;
} else {
$total_refund = 0;
}
}
unless (@revoke) {
return "No items selected to refund/revoke";
}
# if we revoked any items in need of shipping, just refund all shipping costs
foreach my $it (@revoke) {
next unless LJ::Pay::item_needs_shipping($it);
foreach (@{$cartobj->{'items'}}) {
next unless $_->{'item'} eq 'shipping';
next if $_->{'ship_refund_done'};
$refund_amt += $_->{'amt'};
push @revoke, $_;
last;
}
last;
}
my $cardnum = $POST{'partialnum'};
my $expdate = $POST{'expdate'};
# refund if Auth.net
my $transid;
my $refund = sub {
my $type = shift; # "VOID" or "CREDIT";
unless (defined $transid) {
my $res;
$res = $dbh->selectrow_array("SELECT pval FROM payvars WHERE payid=? AND pkey='an-refund'",
undef, $cartobj->{'payid'});
if ($res) {
# if payment is relatively new, we still have the refund data around
my @f = split(/,/, $res);
$transid = $f[0];
$expdate = $f[1];
# $cardnum = "$f[2]***$f[3]"; # old way.
$cardnum = "$f[3]"; # new way. stupid authorize.net.
} else {
# otherwise the refund info's probably been purged, so we'll get the transid
# and card fingerprint from the user
$res = $dbh->selectrow_array("SELECT response FROM authnetlog WHERE payid=? AND cmd='authcap' AND result='pass' ORDER BY datesent DESC LIMIT 1", undef, $cartobj->{'payid'});
return 0 unless $res;
$transid = (split(/,/, $res))[6];
}
}
my $ua = new LWP::UserAgent;
$ua->agent("LJ-AuthNet/1.0");
my $vars = {
'x_Version' => '3.1',
'x_Delim_Data' => 'True',
'x_Login' => $LJ::AUTHNET_USER,
'x_Password' => $LJ::AUTHNET_PASS,
'x_Type' => $type,
'x_Merchant_Email' => $LJ::AUTHNET_MERCHANT,
'x_Trans_ID' => $transid,
'x_Card_Num' => $cardnum,
#'x_Exp_Date' => $expdate, # no longer required
};
if ($type eq "CREDIT") {
$vars->{'x_Amount'} = $refund_amt;
}
my $req = new HTTP::Request POST => 'https://secure.authorize.net/gateway/transact.dll';
$req->content_type('application/x-www-form-urlencoded');
$req->content(join("&", map { LJ::eurl($_) . "=" . LJ::eurl($vars->{$_}) } keys %$vars));
# Pass request to the user agent and get a response back
my $res = $ua->request($req);
my ($ct, $err);
if ($res->is_success) {
$ct = $res->content;
} else {
return 0;
}
my @fields = split(/,/, $ct);
my $pass = $fields[0] == 1;
$dbh->do("INSERT INTO authnetlog (cmd, payid, datesent, amt, result, response) ".
"VALUES (?,?,NOW(),?,?,?)", undef, lc($type),
$cartobj->{'payid'}, $refund_amt, $pass ? "pass" : "fail", $ct);
die $dbh->errstr if $dbh->err;
return $pass;
};
if ($cartobj->{'method'} eq "cc" && ! $POST{'no_refund'}) {
return "Error: merchant gateway is currently down, please try again later."
if $LJ::AUTHNET_DOWN > 0.5;
unless (($total_refund && $refund->("VOID")) ||
$refund->("CREDIT")) {
return "Error: unable to refund. Check error messages. Not revoking items.";
}
}
my $piids = join(",", map { $_->{'piid'} } @revoke);
LJ::Pay::payvar_add($cartobj->{'payid'}, "revoke",
LJ::mysql_time(time()) . ": (piid $piids) $POST{'refreason'}");
# group revoked items by userid for locking
my %revoke_uid = ();
foreach my $it (@revoke) {
my $uid = $it->{'rcptid'} || 'anon';
push @{$revoke_uid{$uid}}, $it;
}
# remove items from account, one userid at a time
foreach my $uid (keys %revoke_uid) {
unless ($uid eq 'anon') {
LJ::Pay::get_lock($uid)
or return "Could not obtain lock on account, please try again later";
}
LJ::Pay::revoke_payitems(@{$revoke_uid{$uid}});
unless ($uid eq 'anon') {
LJ::Pay::release_lock($uid);
}
}
# if any coupons were revoked, display the payids they were used on
# so the admin can make a human judgement if anything else needs to
# be revoked
my @cp_rev = map { $_->{'tokenid'} } grep { $_->{'item'} eq 'coupon' && $_->{'amt'} > 0 } @revoke;
my $bind = join(",", map { "?" } @cp_rev);
my $cp_ids = $dbh->selectcol_arrayref("SELECT payid FROM coupon WHERE cpid IN ($bind)",
undef, @cp_rev) || [];
my $cp_ret;
if (@$cp_ids) {
$cp_ret = "<p>Coupons have revoked. Below are the payment IDs on which they were used. " .
"You may wish to review these payments to determine if further action should " .
"be taken.</p>";
$cp_ret .= "<ul>" .
join("", map { "<li><a href='paiddetails.bml?payid=$_'>Payment #$_</a></li>" } @$cp_ids) .
"</ul>";
}
# if this was a fraudulent payment, mark it as refunded.
my $fraud = $dbh->selectrow_array("SELECT pval FROM fraudstatus ".
"WHERE payid=? AND pkey='fraud_status'",
undef, $cartobj->{'payid'});
LJ::Pay::payvar_set($cartobj->{'payid'}, "fraud_status", "refunded") if $fraud eq 'suspect';
return "Success. Press back and reload for details.$cp_ret";
}
_code?>

82
ljcom/htdocs/admin/accounts/shipping_finish.bml Normal file
View File

@@ -0,0 +1,82 @@
<html>
<head>
<style>
strong { font-weight: bold; color: red; font-size: 14pt; }
</style>
</head>
<body>
<?_code
{
use strict;
use vars qw(%POST);
my $remote = LJ::get_remote();
return "<?needlogin?>" unless $remote;
return "You don't have access to finish payments"
unless LJ::remote_has_priv($remote, "moneyenter") || LJ::remote_has_priv($remote, "shipping");
my $ret;
unless (LJ::did_post() && $POST{'ids'}) {
$ret .= "<form method='post'>Enter order numbers that have been shipped:<br />";
$ret .= "<textarea name='ids' rows='40' cols='20' /></textarea>\n";
$ret .= "<br /><input type='submit' value='Shipped' /></form>";
return $ret;
}
my $dbh = LJ::get_db_writer();
my $ids = $POST{'ids'};
$ids =~ s/\r//g;
my @ids = split(/\n/, $ids);
foreach my $id (@ids) {
next unless $id =~ /\S/;
$id =~ s/\s+//g;
unless ($id =~ /^(\d+)-(\d+)$/) {
$ret .="<strong>Error!</strong> -- invalid order number: $id<br />";
next;
}
my ($payid, $anum) = ($1, $2);
my $pay = $dbh->selectrow_hashref("SELECT * FROM payments WHERE payid=? AND anum=?",
undef, $payid, $anum);
unless ($pay) {
$ret .="<strong>Error!</strong> -- invalid order number: $id<br />";
next;
}
my ($status, $date) = $dbh->selectrow_array("SELECT status, dateshipped FROM shipping ".
"WHERE payid=?", undef, $payid);
unless ($status eq "needs") {
if ($status eq "shipped") {
$ret .="<strong>Error!</strong> -- Order already shipped on $date<br />";
} else {
$ret .="<strong>Error!</strong> -- Order is valid, but has no physical items<br />";
}
next;
}
my $rv = $dbh->do("UPDATE shipping SET status='shipped', dateshipped=NOW() WHERE payid=?", undef,
$payid);
if ($rv > 0) {
$ret .= "Order $payid-$anum marked as shipped.<br />\n";
# decrement inventory
my $sth = $dbh->prepare("SELECT item, subitem FROM payitems ".
"WHERE payid=? AND item IN ('clothes')");
$sth->execute($payid);
while (my ($item, $subitem) = $sth->fetchrow_array) {
$dbh->do("UPDATE inventory SET qty=qty-1 WHERE item=? AND subitem=?",
undef, $item, $subitem);
}
} else {
$ret .="<strong>Error!</strong> -- some db error updating $payid-$anum<br />\n";
}
}
return $ret;
}
_code?>
</body>
</html>

193
ljcom/htdocs/admin/accounts/shipping_labels.bml Normal file
View File

@@ -0,0 +1,193 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head><title></title>
<style>
@media print {
@page {
size: 8.5in 11in; /* width height */
// margin: 0.5in;
}
body { margin: 0; }
a { color: black; }
div.page, div.newpage {
width: 7.0in;
border: 0; margin: 0; padding: 0;
position: relative;
}
div.newpage {
page-break-before: always;
}
div.littlelabel {
// border: 1px solid black;
background: transparent;
font-size: 25pt; font-weight: bold;
position: absolute;
left: 1.6in;
width: 3.75in;
top: 5.7in;
height: 0.75in;
text-align: center;
}
div.littlelabel p {
margin-top: 0.2in;
}
div.returnaddr {
// border: 1px solid black;
background: transparent;
position: absolute;
left: 1.6in;
top: 6.8in;
width: 3.75in;
height: 1.5in;
font-family: sans-serif;
font-size: 11pt;
}
div.toaddr {
// border: 1px solid black;
background: transparent;
position: absolute;
left: 2.25in;
top: 7.85in;
width: 3.1in;
height: 1.5in;
font-size: 15pt;
font-weight: bold;
font-family: sans-serif;
}
div.lilorder {
font-size: 8pt;
font-family: sans-serif;
position: absolute;
left: 1.6in;
top: 9.3in;
}
div.shdate { display: none; }
}
@media screen {
a { color: black; }
h1 { border: 2px solid black; }
div.shdate { color: blue; font-size: 10pt; font-family: sans-serif; margin-top: 0; }
div.returnaddr, div.littlelabel,
div.lilorder { display: none; }
div.toaddr { margin-left: 2in; font-size: 15pt; font-weight: bold; }
}
</style>
</head>
<body>
<?_code
{
use strict;
use vars qw(%POST);
my $remote = LJ::get_remote();
return "You must first <a href=\"/login.bml?ret=1\">log in</a>."
unless $remote;
return "You don't have access to see this."
unless LJ::remote_has_priv($remote, "moneyview") || LJ::remote_has_priv($remote, "shipping");
my $ret;
unless (LJ::did_post()) {
$ret .= "<form method='post'>";
$ret .= "All labels past date: <input name='date' value='0000-00-00 00:00:00' size='20' /> <input type='submit' value='Generate' />";
$ret .= "<p>(be sure to set printer margins to 0.5\" at top and left, with no header or footer.)</p>";
$ret .= "</form>";
return $ret;
}
my $dbh = LJ::get_db_writer();
my $sth;
my %country;
LJ::load_codes($dbh, { "country" => \%country });
$sth = $dbh->prepare("SELECT payid, dateready FROM shipping ".
"WHERE dateready > ? AND status='needs' ".
"ORDER BY dateready");
$sth->execute($POST{'date'});
my @ship;
push @ship, $_ while $_ = $sth->fetchrow_hashref;
my $ct;
foreach my $sh (@ship) {
$ct++;
my $cartobj = $dbh->selectrow_hashref("SELECT * FROM payments WHERE payid=?",
undef, $sh->{'payid'});
next unless $cartobj;
# load all the cart
my $cart = "$cartobj->{'payid'}-$cartobj->{'anum'}";
$cartobj = LJ::Pay::load_cart($cart);
next unless $cartobj;
if ($ct == 1) {
$ret .= "<div class='page'>";
} else {
$ret .= "<div class='newpage'>";
}
$ret .= "<h1>Order \#$cart</h1>";
$ret .= "<div class='shdate'>$sh->{'dateready'}</div>";
$ret .= "<p style='margin-bottom: 20px'>Enclosed are the items you ordered. If you have any questions, email accounts\@livejournal.com and reference the order number above.</p>";
LJ::Pay::render_cart($cartobj, \$ret, { shipping_labels => 1 });
$ret .= "<div class='littlelabel'><p>$cart</p></div>";
$ret .= "<div class='returnaddr'>" . LJ::Pay::postal_address_html() . "</div>\n";
$ret .= "<div class='toaddr'>";
my %payvar;
my $sth = $dbh->prepare("SELECT pkey, pval FROM payvars WHERE payid=? AND pkey LIKE 'ship%'");
$sth->execute($cartobj->{'payid'});
while (my ($k, $v)= $sth->fetchrow_array) { $payvar{$k} = $v; }
my $ctry = uc($payvar{'ship_country'});
# Canadian shipping labels need to be printed in all caps, ugh
if ($ctry eq 'CA') {
$payvar{$_} = uc($payvar{$_})
foreach grep { $_ =~ /^ship_/ } keys %payvar;
$country{'CA'} = uc($country{'CA'});
}
$ret .= "$payvar{'ship_name'}<br />";
$ret .= "$payvar{'ship_addr1'}<br />";
$ret .= "$payvar{'ship_addr2'}<br />" if $payvar{'ship_addr2'};
$ret .= "$payvar{'ship_city'}, $payvar{'ship_state'} $payvar{'ship_zip'}<br />";
if ($ctry ne "US") {
$ret .= $country{$ctry};
}
$ret .= "</div>";
$ret .= "<div class='lilorder'>[$cart]</div>";
$ret .= "</div>"; # end page
}
$ret .= "no orders found past $POST{'date'}" unless $ct;
return $ret;
}
_code?>
</body>
</html>

29
ljcom/htdocs/admin/accounts/unclaimed_payments.bml Normal file
View File

@@ -0,0 +1,29 @@
<?_code
my $dbh = LJ::get_db_writer();
my ($ret, $sth);
my $remote = LJ::get_remote();
unless (LJ::remote_has_priv($remote, "moneysearch") ||
LJ::remote_has_priv($remote, "moneyview"))
{
if ($remote) {
return "You don't have access to see this.";
} else {
return "You must first <A HREF=\"/login.bml?ret=1\">log in</A>.";
}
}
$sth = $dbh->prepare("SELECT p.payid, a.acid, ac.auth FROM acctcode ac, acctpay a, payments p WHERE p.userid=0 AND a.payid=p.payid AND ac.acid=a.acid");
$sth->execute;
while (my ($payid, $acid, $auth) = $sth->fetchrow_array)
{
my $code = LJ::acct_code_encode($acid, $auth);
$ret .= "<p><a href=\"paiddetails.bml?payid=$payid&userid=0\">#$payid</a> - $code\n";
}
return $ret;
_code?>

8
ljcom/htdocs/admin/accounts/xfer_remaining.bml Normal file
View File

@@ -0,0 +1,8 @@
<?_code
{
# tool used to live here, but was later change to offer
# non-admin capabilities as well for permanent account
# sales - whitaker
BML::redirect("$LJ::SITEROOT/tools/xfer_remaining.bml")
}
_code?>