init
This commit is contained in:
30
ljcom/htdocs/admin/abuse/index.bml
Normal file
30
ljcom/htdocs/admin/abuse/index.bml
Normal file
@@ -0,0 +1,30 @@
|
||||
<?_code
|
||||
use strict;
|
||||
use vars qw($body $title);
|
||||
|
||||
$title = "Abuse Center";
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
unless (LJ::check_priv($remote, "supportread", "abuse")) {
|
||||
$title = "Restricted";
|
||||
$body .= "<?p This tool is for members of our abuse team.<br />
|
||||
If you need to file an abuse request, please do so at:
|
||||
<a href='/abuse/report.bml'>http://www.livejournal.com/abuse/report.bml</a> p?>";
|
||||
} else {
|
||||
$body .= <<"BLURB";
|
||||
<strong>Current Tools:</strong><br />
|
||||
<ul>
|
||||
<li><a href="./send_mail.bml">Send an Email</a></li>
|
||||
<li><a href="./query.bml">Query Sent Emails</a></li>
|
||||
</ul>
|
||||
BLURB
|
||||
}
|
||||
|
||||
return;
|
||||
_code?><?page
|
||||
title=><?_code return $title; _code?>
|
||||
body=> <?_code return $body; _code?>
|
||||
page?><?_c <LJDEP>
|
||||
link: htdocs/admin/abuse/mail.bml
|
||||
link: htdocs/support/submit.bml
|
||||
</LJDEP> _c?>
|
||||
10
ljcom/htdocs/admin/abuse/query.bml
Normal file
10
ljcom/htdocs/admin/abuse/query.bml
Normal file
@@ -0,0 +1,10 @@
|
||||
<?page
|
||||
body<=
|
||||
<?_code
|
||||
|
||||
# This file is now out of date!
|
||||
BML::redirect('/admin/sendmail/query.bml');
|
||||
|
||||
_code?>
|
||||
<=body
|
||||
page?>
|
||||
12
ljcom/htdocs/admin/abuse/send_mail.bml
Normal file
12
ljcom/htdocs/admin/abuse/send_mail.bml
Normal file
@@ -0,0 +1,12 @@
|
||||
<?page
|
||||
body<=
|
||||
<?_code
|
||||
|
||||
# This file is now out of date!
|
||||
BML::redirect('/admin/sendmail/send.bml');
|
||||
|
||||
_code?>
|
||||
<=body
|
||||
page?><?_c <LJDEP>
|
||||
link: htdocs/admin/abuse/index.bml
|
||||
</LJDEP> _c?>
|
||||
309
ljcom/htdocs/admin/accounts/acctedit.bml
Normal file
309
ljcom/htdocs/admin/accounts/acctedit.bml
Normal 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> </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 .= " ";
|
||||
}
|
||||
$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
43
ljcom/htdocs/admin/accounts/delivernow.bml
Normal 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
88
ljcom/htdocs/admin/accounts/depositslip.bml
Normal 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
115
ljcom/htdocs/admin/accounts/enterbatch.bml
Normal 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
371
ljcom/htdocs/admin/accounts/enternew.bml
Normal 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> </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> </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> </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> </td></tr>";
|
||||
|
||||
$ret .= "</table>";
|
||||
|
||||
return $ret;
|
||||
}
|
||||
_code?>
|
||||
66
ljcom/htdocs/admin/accounts/fraud_suspects.bml
Normal file
66
ljcom/htdocs/admin/accounts/fraud_suspects.bml
Normal 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
3
ljcom/htdocs/admin/accounts/notes.html
Normal 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
213
ljcom/htdocs/admin/accounts/paiddetails.bml
Normal 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
161
ljcom/htdocs/admin/accounts/paidsearch.bml
Normal 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
209
ljcom/htdocs/admin/accounts/paidsummary.bml
Normal 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}) . "\"><< 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 >></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
199
ljcom/htdocs/admin/accounts/rr.bml
Normal 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
82
ljcom/htdocs/admin/accounts/shipping_finish.bml
Normal 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
193
ljcom/htdocs/admin/accounts/shipping_labels.bml
Normal 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
29
ljcom/htdocs/admin/accounts/unclaimed_payments.bml
Normal 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
8
ljcom/htdocs/admin/accounts/xfer_remaining.bml
Normal 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?>
|
||||
172
ljcom/htdocs/admin/codetrace.bml
Normal file
172
ljcom/htdocs/admin/codetrace.bml
Normal file
@@ -0,0 +1,172 @@
|
||||
<?_code
|
||||
|
||||
use strict;
|
||||
use vars qw(%FORM);
|
||||
|
||||
my $dbr = LJ::get_db_reader();
|
||||
|
||||
my ($ev, $sth, $ret);
|
||||
my $mode = "intro";
|
||||
|
||||
sub p { $ret .= join('', @_); }
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
return "<b>Error:</b> You don't have finduser(codetrace) priv."
|
||||
unless LJ::check_priv($remote, "finduser", "codetrace");
|
||||
|
||||
if ($FORM{'user'} ne "") { $mode = "user"; $FORM{'code'} = ""; }
|
||||
elsif ($FORM{'code'}) { $mode = "code"; }
|
||||
|
||||
p("<h1>code tracer</h1>\n");
|
||||
p("<form method='get'>");
|
||||
$ev = LJ::ehtml($FORM{'user'});
|
||||
p("User: <input name='user' size='15' value='$ev'> or ");
|
||||
$ev = LJ::ehtml($FORM{'code'});
|
||||
p("Code: <input name='code' size='15' value='$ev'> <input type='submit' value=\"Trace\">");
|
||||
p("</form>");
|
||||
return $ret if $mode eq "intro";
|
||||
|
||||
my $do_how = sub {
|
||||
my $self = shift;
|
||||
my $u = shift;
|
||||
|
||||
my $whyhere = $dbr->selectrow_hashref(qq{
|
||||
SELECT acid, userid FROM acctcode WHERE rcptid=$u->{'userid'} LIMIT 1
|
||||
});
|
||||
$whyhere->{'user'} = LJ::get_username($whyhere->{'userid'})
|
||||
if $whyhere && $whyhere->{'userid'};
|
||||
|
||||
p("How $u->{'user'} joined: ");
|
||||
unless ($whyhere) {
|
||||
p("<i>No invite code</i>");
|
||||
} else {
|
||||
my $acid = LJ::acid_encode($whyhere->{'acid'});
|
||||
p("<a href='codetrace.bml?code=$acid'>$acid</a>");
|
||||
|
||||
my $reason = $dbr->selectrow_array(qq{
|
||||
SELECT reason FROM acctinvite WHERE acid=$whyhere->{'acid'}
|
||||
});
|
||||
p(" ($reason)") if defined $reason;
|
||||
|
||||
if (exists $whyhere->{'user'}) {
|
||||
p(" from <a href='codetrace.bml?user=$whyhere->{'user'}'><b>$whyhere->{'user'}</b></a>.");
|
||||
p("<br />");
|
||||
$self->($self, $whyhere);
|
||||
return;
|
||||
}
|
||||
}
|
||||
p("<br />");
|
||||
};
|
||||
|
||||
if ($mode eq "user")
|
||||
{
|
||||
my $user = LJ::canonical_username($FORM{'user'});
|
||||
my $u = LJ::load_user($user) if $user;
|
||||
return "Unknown user" unless $u;
|
||||
$do_how->($do_how, $u);
|
||||
|
||||
my %invite;
|
||||
$sth = $dbr->prepare(qq{
|
||||
SELECT acid, reason, dateadd FROM acctinvite WHERE userid=$u->{'userid'}
|
||||
LIMIT 5000
|
||||
});
|
||||
$sth->execute;
|
||||
$invite{$_->{'acid'}} = $_ while $_ = $sth->fetchrow_hashref;
|
||||
|
||||
my $total_children = 0;
|
||||
|
||||
# limit recursion
|
||||
my %did_userid;
|
||||
my $total_calls = 0;
|
||||
|
||||
my $rec_user = sub {
|
||||
my $self = shift;
|
||||
my $userid = shift;
|
||||
my $unused = shift;
|
||||
|
||||
# limit recursion (we were seeing runaways)
|
||||
return if ++$total_calls > 50;
|
||||
return if $did_userid{$userid}++;
|
||||
|
||||
my $sth = $dbr->prepare(qq{
|
||||
SELECT a.acid, a.rcptid, u.user FROM acctcode a LEFT JOIN useridmap u ON a.rcptid=u.userid
|
||||
WHERE a.userid=$userid
|
||||
LIMIT 5000
|
||||
});
|
||||
$sth->execute;
|
||||
my $open;
|
||||
while (my ($acid, $rcptid, $user) = $sth->fetchrow_array)
|
||||
{
|
||||
next unless $unused || $user;
|
||||
$total_children++ if defined $user;
|
||||
unless ($open++) { p("<ul>"); }
|
||||
my $acide = LJ::acid_encode($acid);
|
||||
p("<li>");
|
||||
p("<a href='codetrace.bml?user=$user'><b>$user</b></a> ") if $user;
|
||||
p("(<a href='codetrace.bml?code=$acide'>$acide</a>)");
|
||||
if ($invite{$acid}) {
|
||||
p(" ($invite{$acid}->{'reason'}; $invite{$acid}->{'dateadd'})");
|
||||
}
|
||||
$self->($self, $rcptid, 0) if $rcptid;
|
||||
p("</li>");
|
||||
}
|
||||
p("</ul>") if $open;
|
||||
};
|
||||
|
||||
p("<p>Codes made/used by $user:");
|
||||
$rec_user->($rec_user, $u->{'userid'}, 1);
|
||||
p("<p><b>Total children:</b> $total_children");
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
if ($mode eq "code")
|
||||
{
|
||||
my $code = $FORM{'code'};
|
||||
my $acid;
|
||||
if ($code =~ /^\#(\d+)$/) {
|
||||
$acid = $1;
|
||||
$code = LJ::acid_encode($acid);
|
||||
} else {
|
||||
return "Bogus code." if length($code) != 7 && length($code) != 12;
|
||||
$code =~ s/^.....(.......)$/$1/;
|
||||
$acid = LJ::acid_decode($code);
|
||||
}
|
||||
p("Code: $code = $acid<br />");
|
||||
|
||||
my $ac = $dbr->selectrow_hashref("SELECT userid, rcptid FROM acctcode WHERE acid=$acid");
|
||||
unless ($ac) {
|
||||
p("Code doesn't exist");
|
||||
return $ret;
|
||||
}
|
||||
my $ai = $dbr->selectrow_hashref("SELECT reason, dateadd FROM acctinvite WHERE acid=$acid");
|
||||
$ac->{'user'} = LJ::get_username($ac->{'userid'})
|
||||
if $ac->{'userid'};
|
||||
$ac->{'ruser'} = LJ::get_username($ac->{'rcptid'})
|
||||
if $ac->{'rcptid'};
|
||||
|
||||
p("Creator of code: <a href='codetrace.bml?user=$ac->{'user'}'>$ac->{'user'}</a> ($ai->{'reason'}, $ai->{'dateadd'})<br />")
|
||||
if $ac->{'user'};
|
||||
unless ($ac->{'userid'}) {
|
||||
my $ap = $dbr->selectrow_hashref(qq{
|
||||
SELECT p.userid, p.payid FROM payments p, acctpay ap
|
||||
WHERE ap.payid=p.payid AND ap.acid=$acid
|
||||
});
|
||||
$ap ||= $dbr->selectrow_hashref(qq{
|
||||
SELECT p.userid, p.payid FROM payments p, payitems pi, acctpayitem api
|
||||
WHERE api.piid=pi.piid AND api.acid=$acid AND pi.payid=p.payid
|
||||
});
|
||||
if ($ap) {
|
||||
p("Payment which generated code: <a href='/admin/accounts/paiddetails.bml?payid=$ap->{'payid'}&userid=$ap->{'userid'}'>$ap->{'payid'}</a><br />");
|
||||
}
|
||||
}
|
||||
|
||||
p("Code recipient: <a href='codetrace.bml?user=$ac->{'ruser'}'>$ac->{'ruser'}</a><br />");
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
$ret;
|
||||
|
||||
_code?>
|
||||
139
ljcom/htdocs/admin/feedback/index.bml
Normal file
139
ljcom/htdocs/admin/feedback/index.bml
Normal file
@@ -0,0 +1,139 @@
|
||||
<?_code
|
||||
{
|
||||
use strict;
|
||||
use vars qw($body $title %GET);
|
||||
|
||||
$title = "Feedback Survey Results";
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
unless (LJ::check_priv($remote, "siteadmin", "feedback") || LJ::check_priv($remote, "siteadmin", "*")) {
|
||||
$title = "Restricted";
|
||||
$body = "<?p This is the feedback review tool for LiveJournal administrators. p?>";
|
||||
return BML::redirect("/feedback/");
|
||||
}
|
||||
|
||||
$body .= "<?h1 Retrieve Surveys h1?>\n";
|
||||
$body .= '<form method="GET" action="./"><input type="hidden" name="mode" value="list" />';
|
||||
$body .= "<table cellpadding='4' cellspacing='2' class='search'>";
|
||||
$body .= "<tr><th>URL:</th><td>" .
|
||||
LJ::html_text({ 'name' => 'url',
|
||||
'value' => $GET{'url'},
|
||||
'size' => 30, 'maxlength' => 50 }) . "</td></tr>";
|
||||
|
||||
$body .= "<tr><th>Username:</th><td>" .
|
||||
LJ::html_text({ 'name' => 'username',
|
||||
'value' => $GET{'username'},
|
||||
'size' => 15, 'maxlength' => 15 }) . "</td></tr>";
|
||||
|
||||
$body .= "<tr><th>State:</th><td>" .
|
||||
LJ::html_select({'name' => 'state', 'selected' => $GET{'state'}},
|
||||
'', "", 'N', "New", 'D', "Deleted", 'Z', "Zilla item") . "</td></tr>";
|
||||
|
||||
$body .= "<tr><td></td><td>" . LJ::html_submit("", "Search") . "</td></tr>";
|
||||
|
||||
$body .= "</table></form>";
|
||||
|
||||
return unless $GET{'mode'};
|
||||
|
||||
if ($GET{'mode'} eq "list") {
|
||||
my @where;
|
||||
my $dbr = LJ::get_db_reader();
|
||||
$body .= "<?hr?><?h1 Results h1?>";
|
||||
if ($GET{'viewall'} ne "") {
|
||||
# Do nothing extra
|
||||
}
|
||||
if ($GET{'username'} ne "") {
|
||||
my $userid = LJ::get_userid($GET{'username'});
|
||||
unless ($userid)
|
||||
{
|
||||
$body .= "<?h2 Error: h2?> <?p No results for '$GET{'username'}'. p?>";
|
||||
return;
|
||||
}
|
||||
push @where, "userid=$userid";
|
||||
}
|
||||
if ($GET{'url'} ne "") {
|
||||
my $qvalue = $dbr->quote($GET{'url'});
|
||||
push @where, "url=$qvalue";
|
||||
}
|
||||
if ($GET{'state'} ne "") {
|
||||
my $qvalue = $dbr->quote($GET{'state'});
|
||||
push @where, " state=$qvalue";
|
||||
}
|
||||
|
||||
my $where; my $i;
|
||||
if (@where > 0) {
|
||||
$where = "WHERE ";
|
||||
foreach (@where) {
|
||||
$i++;
|
||||
$where .= $i == 1 ? $_ : " && " . $_;
|
||||
}
|
||||
}
|
||||
|
||||
my $sth = $dbr->prepare("SELECT * FROM fotobilder_feedback $where");
|
||||
$sth->execute;
|
||||
|
||||
my $show_total = 50;
|
||||
my $row_ct = 0;
|
||||
my $row_show = 0;
|
||||
my $row_skip = 0;
|
||||
my $row_html;
|
||||
my @rows; while (my $row = $sth->fetchrow_hashref) { push @rows, $row; }
|
||||
foreach my $row ( reverse @rows ) {
|
||||
next if LJ::trim($row->{'body'}) eq "";
|
||||
$row_ct++;
|
||||
next if $GET{'skip'} && ++$row_skip <= $GET{'skip'};
|
||||
if ($row_show < $show_total) {
|
||||
$row_show++;
|
||||
my $username = LJ::get_username($row->{'userid'});
|
||||
$row_html .= "<tr><td style='white-space: nowrap'>" . LJ::ljuser($username) . "<br /><br />";
|
||||
if ($row->{'datetime'} ne "0000-00-00 00:00:00") {
|
||||
$row_html .= "<strong>Filed at:</strong> $row->{'datetime'}<br />";
|
||||
}
|
||||
$row_html .= "<ul><li><a href='./?mode=list&url=" . LJ::ehtml($row->{'url'}) . "'>$row->{'url'}</a></li>";
|
||||
$row_html .= "<li><a href='./?mode=list&username=$username'>Other feedback</a></li>";
|
||||
$row_html .= "<li><a href='./?mode=list&state=$row->{'state'}'>State: $row->{'state'}</a></li></ul></td>";
|
||||
$row_html .= "<td style='border: 1px solid #000' valign='top'>";
|
||||
my $abstract = LJ::ehtml($row->{'body'});
|
||||
$abstract =~ s/\n/<br \/>/g;
|
||||
$row_html .= "$abstract</td></tr>";
|
||||
}
|
||||
}
|
||||
if ($row_ct eq 0) { $body .= "<?p No Results Returned p?>"; return; }
|
||||
|
||||
$body .= "<table cellpadding='4' cellspacing='1' border='0' class='feedback'>";
|
||||
$body .= "<tr><th style='width: 175px;'>Links</th><th>Feedback</th></tr>";
|
||||
$body .= $row_html;
|
||||
my $slinks;
|
||||
if ($GET{'skip'}) {
|
||||
$slinks .= "<a href=\"" . BML::self_link({ 'skip' => $GET{'skip'} - $show_total}) . "\"><< 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'} + $show_total}) . "\">Forward >></a> ";
|
||||
}
|
||||
$body .= "</table>";
|
||||
if ($slinks ne "") { $body .= "<?h1 Tally h1?> <?p $slinks p?>"; }
|
||||
} else {
|
||||
$body .= "<?p Please select a search criteria p?>";
|
||||
}
|
||||
return;
|
||||
}
|
||||
_code?>
|
||||
<?page
|
||||
title=><?_code return $title; _code?>
|
||||
body=> <?_code return $body; _code?>
|
||||
head<=
|
||||
<style type='text/css'>
|
||||
.feedback {
|
||||
width: 100%;
|
||||
}
|
||||
.feedback th, .search th {
|
||||
text-align: left;
|
||||
}
|
||||
</style>
|
||||
<=head
|
||||
page?>
|
||||
230
ljcom/htdocs/admin/sendmail/query.bml
Normal file
230
ljcom/htdocs/admin/sendmail/query.bml
Normal file
@@ -0,0 +1,230 @@
|
||||
<?page
|
||||
title=>Query Sent Mail
|
||||
body<=
|
||||
<?_code
|
||||
use strict;
|
||||
use vars qw(%GET);
|
||||
|
||||
my ($ret, $sth, $where, $body);
|
||||
my $status = {
|
||||
'S' => "Sent (does not guarantee that the message didn't bounce)",
|
||||
'F' => "Failed to send", };
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
my %canview;
|
||||
$canview{'abuse'} = 1 if (LJ::check_priv($remote, "supportread", "abuse"));
|
||||
$canview{'support'} = 1 if (LJ::check_priv($remote, "supportread", "support"));
|
||||
|
||||
# Grouping this check for now, but leaving it so
|
||||
# it could be split up in the future should a need
|
||||
# arise
|
||||
if (LJ::check_priv($remote, "supportread", "accounts")) {
|
||||
$canview{'accounts'} = 1;
|
||||
$canview{'coppa'} = 1;
|
||||
}
|
||||
|
||||
unless ($canview{'abuse'} || $canview{'support'} || $canview{'accounts'}) {
|
||||
return "<?p This tool is for members of our abuse and support teams.<br />
|
||||
If you need to file an abuse request, please do so at:
|
||||
<a href='/abuse/report.bml'>$LJ::SITEROOT/abuse/report.bml</a> <br />
|
||||
If you need to file a support request, please do so at:
|
||||
<a href='/support/submit.bml'>$LJ::SITEROOT/support/submit.bml</a> p?>";
|
||||
}
|
||||
|
||||
if ($GET{'mode'} eq "view") {
|
||||
my $dbr = LJ::get_db_reader();
|
||||
my $qmailid = $dbr->quote($GET{'mailid'});
|
||||
$sth = $dbr->prepare("SELECT mailid, userid, spid, status, timesent, mailto, " .
|
||||
"subject, message, type FROM abuse_mail " .
|
||||
"WHERE mailid=$qmailid");
|
||||
$sth->execute;
|
||||
|
||||
my $mail = $sth->fetchrow_hashref;
|
||||
if ($canview{$mail->{'type'}}) {
|
||||
$ret .= "<?h1 Viewing Message #$mail->{'mailid'} h1?>";
|
||||
|
||||
$ret .= "<table style='border-spacing: 5px'>";
|
||||
|
||||
$ret .= "<tr><th style='text-align: left; white-space: nowrap'>Mail ID:</th>";
|
||||
$ret .= "<td>$mail->{'mailid'}</td></tr>";
|
||||
|
||||
$ret .= "<tr><th style='text-align: left'>Status:</th>";
|
||||
$ret .= "<td>$status->{$mail->{'status'}}</td></tr>";
|
||||
|
||||
$ret .= "<tr><th style='text-align: left; white-space: nowrap'>Request #:</th>";
|
||||
if ($mail->{'spid'} != 0) {
|
||||
$ret .= "<td><a href='/support/see_request.bml?id=$mail->{'spid'}'>";
|
||||
$ret .= "$mail->{'spid'}</a></td>";
|
||||
} else {
|
||||
$ret .= "<td>N/A</td>";
|
||||
}
|
||||
$ret .= "</tr>";
|
||||
|
||||
$ret .= "<tr><th style='text-align: left; white-space: nowrap'>Sent By:</th>";
|
||||
$ret .= "<td>" . LJ::ljuser(LJ::get_username($mail->{'userid'})) . "</td></tr>";
|
||||
|
||||
$ret .= "<tr><th style='text-align: left'>From:</th>";
|
||||
$ret .= "<td>$mail->{'type'}\@$LJ::DOMAIN</td></tr>";
|
||||
|
||||
$ret .= "<tr><th style='text-align: left'>Recipient:</th>";
|
||||
$ret .= "<td>$mail->{'mailto'}</td></tr>";
|
||||
|
||||
$ret .= "<tr><th style='text-align: left'>Sent:</th>";
|
||||
$ret .= "<td>$mail->{'timesent'}</td></tr>";
|
||||
|
||||
$ret .= "<tr><th style='text-align: left'>Subject:</th>";
|
||||
$ret .= "<td>$mail->{'subject'}</td></tr>";
|
||||
|
||||
$ret .= "<tr><th style='text-align: left; vertical-align: top'>Message:</th>";
|
||||
my $message = $mail->{message};
|
||||
$message = LJ::auto_linkify($message);
|
||||
$message =~ s/\r?\n/<br \/>\n/g;
|
||||
|
||||
$ret .= "<td>$message</td></tr>";
|
||||
|
||||
$ret .= "</table>";
|
||||
|
||||
$ret .= "<?hr?><a href='/admin/sendmail/query.bml' onclick='history.back();return false;'>";
|
||||
$ret .= "<< View Results</a>";
|
||||
} else {
|
||||
$ret .= LJ::bad_input('You are not authorized to view this message');
|
||||
}
|
||||
} else {
|
||||
$ret .= "<?h1 Search Sent Emails h1?>\n";
|
||||
$ret .= '<form method="GET" action="query.bml">';
|
||||
$ret .= '<input type="hidden" name="mode" value="list" />';
|
||||
|
||||
$ret .= "<table cellpadding='4' cellspacing='2'><tr valign='top'>";
|
||||
$ret .= "<tr valign='top'><th align='right'>Restrict:</th><td>";
|
||||
|
||||
my @type = ("", "All");
|
||||
push @type, ('abuse' => "abuse\@$LJ::DOMAIN") if $canview{'abuse'};
|
||||
push @type, ('accounts' => "accounts\@$LJ::DOMAIN") if $canview{'accounts'};
|
||||
push @type, ('coppa' => "coppa\@$LJ::DOMAIN") if $canview{'coppa'};
|
||||
push @type, ('support' => "support\@$LJ::DOMAIN") if $canview{'support'};
|
||||
$ret .= LJ::html_select({ 'name' => 'restrict', 'selected' => $GET{'restrict'} }, @type);
|
||||
|
||||
|
||||
$ret .= "</td></tr><tr valign='top'><th align='right'>Method:</th><td>";
|
||||
$ret .= LJ::html_select({'name' => 'method', 'selected' => $GET{'method'}},
|
||||
'sender' => "Username of Sender",
|
||||
'spid' => "Tied to Request #",
|
||||
'mailto' => "Sent to address or user",
|
||||
);
|
||||
$ret .= "</td></tr><tr valign='top'><th align='right'>Value:</th><td>";
|
||||
$ret .= LJ::html_text({ 'name' => 'value',
|
||||
'value' => $GET{'value'},
|
||||
'size' => 30 });
|
||||
$ret .= "</td></tr>";
|
||||
$ret .= "<tr><td align='right'> </td><td><input type='submit' value='Search'></td>";
|
||||
$ret .= "</tr></table></form>";
|
||||
|
||||
return $ret unless $GET{'mode'};
|
||||
|
||||
if ($GET{'mode'} eq "list") {
|
||||
my $dbr = LJ::get_db_reader();
|
||||
$ret .= "<?hr?><?h1 Results h1?>";
|
||||
|
||||
# Default condition of nothing versus everything
|
||||
my $where = "WHERE 0";
|
||||
|
||||
if ($GET{'method'} eq "sender") {
|
||||
my $userid = LJ::get_userid($GET{'value'});
|
||||
unless ($userid) {
|
||||
$ret .= "<?h2 Error: h2?> <?p The username '$GET{'value'}' is not currently in use. p?>";
|
||||
return $ret;
|
||||
}
|
||||
$where = "WHERE userid=$userid";
|
||||
} elsif ($GET{'method'} eq "spid") {
|
||||
$where = "WHERE spid=" . $dbr->quote($GET{'value'});
|
||||
} elsif ($GET{'method'} eq "mailto") {
|
||||
my $email;
|
||||
|
||||
my $u = LJ::load_user($GET{'value'});
|
||||
if ($u) {
|
||||
$email = $u->{'email'};
|
||||
} else { # Assume we got an email address
|
||||
$email = $GET{'value'};
|
||||
my @email_errors;
|
||||
LJ::check_email($email, \@email_errors);
|
||||
if (@email_errors) {
|
||||
$ret .= "<?h2 Error: h2?> <?p " . join(', ', @email_errors) . " p?>";
|
||||
return $ret;
|
||||
}
|
||||
}
|
||||
|
||||
$where = "WHERE mailto=" . $dbr->quote($email);
|
||||
}
|
||||
|
||||
# See if they are limiting the search and
|
||||
# make sure they are able to view that type
|
||||
if ($GET{'restrict'} ne '') {
|
||||
return LJ::bad_input('Not authorized to view that type')
|
||||
unless $canview{$GET{'restrict'}};
|
||||
my $r = $dbr->quote($GET{'restrict'});
|
||||
$where .= " AND type=$r";
|
||||
} else { #Limit them to the types they can see
|
||||
$where .= " AND type IN(" . join(',', map { $dbr->quote($_) } keys %canview) . ')';
|
||||
}
|
||||
|
||||
$sth = $dbr->prepare("SELECT mailid, userid, spid, status, " .
|
||||
"timesent, mailto, subject, type " .
|
||||
"FROM abuse_mail $where");
|
||||
$sth->execute;
|
||||
|
||||
my $show_total = 50;
|
||||
my $row_ct = 0;
|
||||
my $row_show = 0;
|
||||
my $row_skip = 0;
|
||||
my $row_html;
|
||||
while (my $row = $sth->fetchrow_hashref) {
|
||||
$row_ct++;
|
||||
next if $GET{'skip'} && ++$row_skip <= $GET{'skip'};
|
||||
|
||||
if ($row_show < $show_total) {
|
||||
$row_show++;
|
||||
$row_html .= "<tr><td><a href='./query.bml?mode=view&mailid=$row->{'mailid'}'>(link)</a></td>";
|
||||
|
||||
my $username = LJ::get_username($row->{'userid'});
|
||||
$row_html .= "<td>" . LJ::ljuser($username) . "</td>";
|
||||
|
||||
if ($row->{'spid'} != 0) {
|
||||
$row_html .= "<td><a href='/support/see_request.bml?id=$row->{'spid'}'>$row->{'spid'}</a></td>";
|
||||
} else {
|
||||
$row_html .= "<td>N/A</td>";
|
||||
}
|
||||
$row_html .= "<td>$row->{'status'}</td>";
|
||||
$row_html .= "<td>$row->{'type'}</td>";
|
||||
$row_html .= "<td>$row->{'timesent'}</td><td>$row->{'mailto'}</td>";
|
||||
$row_html .= "<td>$row->{'subject'}</td></tr>";
|
||||
}
|
||||
}
|
||||
if ($row_ct eq 0) { $ret .= "<?p No Results Returned p?>"; return $ret; }
|
||||
|
||||
$ret .= "<?p <table cellpadding='4' cellspacing='1' border='1'>";
|
||||
$ret .= "<tr><th>Details</th><th>Sent By</th><th>Request #</th>";
|
||||
$ret .= "<th>Status</th><th>From</th><th>Sent</th><th>Recipient</th><th>Subject</th></tr>";
|
||||
$ret .= $row_html;
|
||||
my $slinks;
|
||||
if ($GET{'skip'}) {
|
||||
$slinks .= "<a href=\"" . BML::self_link({ 'skip' => $GET{'skip'} - $show_total}) . "\"><< 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'} + $show_total}) . "\">Forward >></a> ";
|
||||
}
|
||||
$ret .= "</table> p?>";
|
||||
if ($slinks ne "") { $ret .= "<?h1 Tally h1?> <?p $slinks p?>"; }
|
||||
} else {
|
||||
$ret .= "<?p Please select a search criteria p?>";
|
||||
}
|
||||
}
|
||||
return $ret;
|
||||
_code?>
|
||||
<=body
|
||||
page?>
|
||||
381
ljcom/htdocs/admin/sendmail/send.bml
Normal file
381
ljcom/htdocs/admin/sendmail/send.bml
Normal file
@@ -0,0 +1,381 @@
|
||||
<?page
|
||||
head<=
|
||||
<script language='javascript'>
|
||||
function form_switch()
|
||||
{
|
||||
var form = document.getElementById('preview');
|
||||
form.action='send.bml?action=edit';
|
||||
form.submit();
|
||||
}
|
||||
|
||||
function fill_subject()
|
||||
{
|
||||
var request = document.getElementById('request');
|
||||
var subject = document.getElementById('subject');
|
||||
|
||||
var id = request.value;
|
||||
|
||||
subject.value = 'Your <?_code return LJ::ejs($LJ::SITENAMESHORT); _code?> Account [##-'+id+']';
|
||||
}
|
||||
</script>
|
||||
<=head
|
||||
|
||||
body<=
|
||||
|
||||
<?_code
|
||||
{
|
||||
use strict;
|
||||
|
||||
my $body = "";
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
my %cansend;
|
||||
$cansend{'abuse'} = 1 if LJ::check_priv($remote, "supportread", "abuse");
|
||||
$cansend{'support'} = 1 if LJ::check_priv($remote, "supportread", "support");
|
||||
|
||||
# Grouping this check for now, but leaving it so
|
||||
# it could be split up in the future should a need
|
||||
# arise
|
||||
if (LJ::check_priv($remote, "supportread", "accounts")) {
|
||||
$cansend{'accounts'} = 1;
|
||||
$cansend{'coppa'} = 1;
|
||||
}
|
||||
|
||||
unless (%cansend) {
|
||||
return "<?p This tool is for members of our abuse and support teams.<br />
|
||||
If you need to file an abuse request, please do so at:
|
||||
<a href='/abuse/report.bml'>$LJ::SITEROOT/abuse/report.bml</a> <br />
|
||||
If you need to file a support request, please do so at:
|
||||
<a href='/support/submit.bml'>$LJ::SITEROOT/support/submit.bml</a> p?>";
|
||||
}
|
||||
|
||||
my $compose = sub {
|
||||
my $edit_mode = shift;
|
||||
|
||||
$body .= "<?h1 Compose Message h1?>\n";
|
||||
$body .= "<form action='send.bml?action=preview' method='post'>\n";
|
||||
|
||||
$body .= "<table>\n";
|
||||
$body .= "<tr><td><label for='from'>From:</label></td><td>";
|
||||
|
||||
my @from = ("", "-- Select One --");
|
||||
push @from, ('abuse' => "abuse\@$LJ::DOMAIN") if $cansend{'abuse'};
|
||||
push @from, ('accounts' => "accounts\@$LJ::DOMAIN") if $cansend{'accounts'};
|
||||
push @from, ('coppa' => "coppa\@$LJ::DOMAIN") if $cansend{'coppa'};
|
||||
push @from, ('support' => "support\@$LJ::DOMAIN") if $cansend{'support'};
|
||||
|
||||
my $selfrom = $edit_mode == 1 ? $POST{'from'} : $GET{'from'};
|
||||
$selfrom = "abuse" if !$selfrom && $cansend{'abuse'};
|
||||
$selfrom = "support" if !$selfrom && $cansend{'support'};
|
||||
$selfrom = "accounts" if !$selfrom && $cansend{'accounts'};
|
||||
|
||||
$body .= LJ::html_select({ 'name' => 'from', 'selected' => $selfrom }, @from);
|
||||
$body .= "<br /><br /></td></tr>";
|
||||
|
||||
$body .= "<tr><td>Mail to:</td><td>";
|
||||
$body .= "<table><tr><td>";
|
||||
|
||||
# Since we expose the address we'd be sending to
|
||||
# don't let them mail by user or community maints
|
||||
# if they couldn't go look it up themselves
|
||||
if (LJ::check_priv($remote, 'finduser')) {
|
||||
$body .= "<label for='user'>User:</label></td><td>";
|
||||
|
||||
my $user = $edit_mode == 1 ? $POST{'user'} : $GET{'user'};
|
||||
$body .= LJ::html_text({ 'name' => 'user', 'type' => 'text',
|
||||
'raw' => 'style="background: url('.$LJ::IMGPREFIX.'/userinfo.gif) no-repeat; background-position: 0px 1px; padding-left: 18px;" size="37"',
|
||||
'value' => $user});
|
||||
$body .= "<font color='gray'> (OR)</font>";
|
||||
$body .= "</td></tr>";
|
||||
|
||||
$body .= "<tr><td><label for='user'>Maints:</label></td><td>";
|
||||
|
||||
my $maints = $edit_mode == 1 ? $POST{'maints'} : $GET{'maints'};
|
||||
$body .= LJ::html_text({ 'name' => 'maints', 'type' => 'text',
|
||||
'raw' => 'style="background: url('.$LJ::IMGPREFIX.'/community.gif) no-repeat; background-position: 0px 1px; padding-left: 18px;" size="37"',
|
||||
'value' => $maints});
|
||||
$body .= "<font color='gray'> (OR)</font>";
|
||||
$body .= "</td></tr><tr><td>";
|
||||
}
|
||||
|
||||
$body .= "<label for='email'>Email:</label></td><td>";
|
||||
|
||||
my $email = $edit_mode == 1 ? $POST{'email'} : $GET{'email'};
|
||||
$body .= LJ::html_text({ 'name' => 'email', 'type' => 'text',
|
||||
'raw' => 'size="40"', 'value' => $email});
|
||||
$body .= "</td></tr></table>";
|
||||
$body .= "<br /></td></tr>";
|
||||
|
||||
$body .= "<tr><td><label for='bcc'>BCC:</label></td><td>";
|
||||
|
||||
my $bcc = $edit_mode == 1 ? $POST{'bcc'} : $GET{'bcc'};
|
||||
if ($edit_mode == 0 && ! $bcc) {
|
||||
$bcc = $remote->{'email'};
|
||||
}
|
||||
$body .= LJ::html_text({'name' => 'bcc', 'type' => 'text',
|
||||
'raw' => "size='45' maxlength='100'",
|
||||
'value' => $bcc});
|
||||
$body .= " <font color='gray'>Limit One</font></td></tr>";
|
||||
|
||||
$body .= "<tr><td><label for='request'>Request #:</label></td><td>";
|
||||
my $request = $edit_mode == 1 ? $POST{'request'} : $GET{'request'};
|
||||
$body .= LJ::html_text({'name' => 'request', 'type' => 'text',
|
||||
'raw' => "size='45' maxlength='100'",
|
||||
'value' => $request,
|
||||
'id' => 'request'});
|
||||
$body .= " <input type='button' value='Fill Subject' onclick='fill_subject()' />";
|
||||
$body .= "</td></tr>";
|
||||
|
||||
$body .= "<tr><td><label for='subject'>Subject:</label></td><td>";
|
||||
my $subject = $edit_mode == 1 ? $POST{'subject'} : $GET{'subject'};
|
||||
$body .= LJ::html_text({'name' => 'subject', 'type' => 'text',
|
||||
'raw' => "size='45' maxlength='100'",
|
||||
'value' => $subject,
|
||||
'id' => 'subject'});
|
||||
$body .= "</td></tr>";
|
||||
|
||||
$body .= "<tr><td valign='top'><label for='body'>Message:</label></td><td>";
|
||||
my $message = $edit_mode == 1 ? $POST{'message'} : $GET{'message'};
|
||||
$body .= LJ::html_textarea({'name' => 'message',
|
||||
'raw' => "rows='20' cols='80' wrap='soft'",
|
||||
'value' => $message});
|
||||
$body .= "</td></tr>";
|
||||
|
||||
$body .= "<tr><td> </td><td>";
|
||||
my $extra = $edit_mode == 1 ? $POST{'extra'} : $GET{'extra'};
|
||||
$body .= LJ::html_hidden('extra', $extra) if $extra;
|
||||
$body .= LJ::html_submit ('reset', '<- Reset', {'type' => 'reset'});
|
||||
$body .= " ";
|
||||
$body .= LJ::html_submit ('submit', 'Preview ->');
|
||||
$body .= "</td></tr>";
|
||||
|
||||
$body .= "</table>";
|
||||
$body .= "</form>";
|
||||
};
|
||||
|
||||
my $preview = sub {
|
||||
|
||||
my $errors = 0;
|
||||
|
||||
$body .= "<table style='border-spacing: 5px'>";
|
||||
$body .= "<tr><th style='text-align: left'>From:</th><td>";
|
||||
|
||||
my $from = LJ::trim($POST{'from'});
|
||||
if ($cansend{$from}) {
|
||||
$body .= "$from\@$LJ::DOMAIN";
|
||||
} else {
|
||||
$errors = 1;
|
||||
$body .= "<font color='red'>Invalid address chosen</font>";
|
||||
}
|
||||
|
||||
$body .= "</tr><tr><th style='text-align: left'>To:</th><td>";
|
||||
|
||||
my @to;
|
||||
if (LJ::trim($POST{'user'}) ne '') {
|
||||
my $u = LJ::load_user($POST{'user'});
|
||||
unless ($u) {
|
||||
$errors = 1;
|
||||
$body .= "<font color='red'>Invalid username $POST{user}</font>";
|
||||
} else {
|
||||
push @to, $u->{'email'};
|
||||
$body .= LJ::ljuser($u) . " ($u->{email})";;
|
||||
}
|
||||
} elsif (LJ::trim($POST{'maints'}) ne '') {
|
||||
my $u = LJ::load_user($POST{'maints'});
|
||||
if ($u->{journaltype} ne 'C') {
|
||||
$body .= "<font color='red'>Community specified is not a community</font>";
|
||||
} else {
|
||||
my $ids = LJ::load_rel_user($u->{userid}, 'A');
|
||||
foreach (@$ids) {
|
||||
my $maint = LJ::load_userid($_);
|
||||
push @to, $maint->{'email'}
|
||||
}
|
||||
$body .= "Maintainers of ";
|
||||
$body .= LJ::ljuser($u) . " (";
|
||||
$body .= join(", ", @to) . ")";
|
||||
}
|
||||
} elsif (LJ::trim($POST{'email'}) ne '') {
|
||||
my $addr = LJ::trim($POST{'email'});
|
||||
my @email_errors;
|
||||
LJ::check_email($addr, \@email_errors);
|
||||
if (@email_errors) {
|
||||
$errors = 1;
|
||||
$body .= "<font color='red'>";
|
||||
$body .= join(", ", @email_errors);
|
||||
$body .= "</font>";
|
||||
} else {
|
||||
push @to, $addr;
|
||||
$body .= $addr;
|
||||
}
|
||||
} else {
|
||||
$errors = 1;
|
||||
$body .= "<font color='red'>You must enter a recipient</font>";
|
||||
}
|
||||
|
||||
my $bcc = LJ::trim($POST{'bcc'});
|
||||
if ($bcc ne '') {
|
||||
$body .= "<tr><th style='text-align: left'>Bcc:</th><td>";
|
||||
|
||||
my @bcc_errors;
|
||||
LJ::check_email($bcc, \@bcc_errors);
|
||||
if (@bcc_errors) {
|
||||
$errors = 1;
|
||||
$body .= "<font color='red'>";
|
||||
$body .= join(", ", @bcc_errors);
|
||||
$body .= "</font>";
|
||||
} else {
|
||||
$body .= $bcc;
|
||||
}
|
||||
|
||||
$body .= "</td></tr>";
|
||||
}
|
||||
|
||||
my $request = LJ::trim($POST{'request'});
|
||||
$body .= "<tr><th style='text-align: left; white-space: nowrap'>Request #:</th><td>";
|
||||
if ($request ne '') {
|
||||
unless ($request =~ /^\d+$/) {
|
||||
$body .= "<font color='red'>Request id must be numeric</font>";
|
||||
$errors = 1;
|
||||
} else {
|
||||
$body .= $request;
|
||||
}
|
||||
} else {
|
||||
$body .= "<font color='orange'>No request specified</font>";
|
||||
}
|
||||
$body .= "</td></tr>";
|
||||
|
||||
my $subject = LJ::trim($POST{'subject'});
|
||||
$body .= "<tr><th style='text-align: left'>Subject:</th><td>";
|
||||
if ($subject eq '') {
|
||||
$body .= "<font color='red'>You must specify a subject</font>";
|
||||
$errors = 1;
|
||||
} else {
|
||||
$body .= $subject;
|
||||
}
|
||||
$body .= "</td></tr>";
|
||||
|
||||
my $message = LJ::trim($POST{'message'});
|
||||
$body .= "<tr><th style='vertical-align: top; text-align: left'>Message:</th><td>";
|
||||
if ($message eq '') {
|
||||
$body .= "<font color='red'>You must specify a message</font>";
|
||||
$errors = 1;
|
||||
} else {
|
||||
my $tmp_mess = $message;
|
||||
$tmp_mess =~ s/\r?\n/<br \/>\n/g;
|
||||
$body .= $tmp_mess;
|
||||
}
|
||||
$body .= "</td></tr>";
|
||||
|
||||
$body .= "<tr><td colspan='2'>";
|
||||
|
||||
$body .= "<form action='send.bml?action=send' method='post' id='preview'>";
|
||||
$body .= LJ::html_hidden('from', $from, 'to', join(',', @to), 'bcc', $bcc,
|
||||
'subject', $subject, 'message', $message, 'email', $POST{'email'},
|
||||
'maints', $POST{'maints'}, 'user', $POST{'user'}, 'request',
|
||||
$request);
|
||||
$body .= LJ::html_hidden('extra', $POST{'extra'}) if $POST{'extra'};
|
||||
$body .= LJ::form_auth();
|
||||
|
||||
$body .= '<br />';
|
||||
|
||||
$body .= LJ::html_submit('edit', '<- Edit', {'raw' => "onclick='form_switch()'"});
|
||||
$body .= LJ::html_submit('send', 'Send ->', {'disabled' => $errors});
|
||||
|
||||
$body .= "</form>";
|
||||
$body .= "</table>";
|
||||
|
||||
};
|
||||
|
||||
my $send = sub {
|
||||
my @errors;
|
||||
my $dbh = LJ::get_db_writer();
|
||||
return $body = LJ::bad_input('No database connection present. Please go back and try again.')
|
||||
unless $dbh;
|
||||
|
||||
return $body = LJ::bad_input($ML{'error.invalidform'})
|
||||
unless LJ::check_form_auth();
|
||||
|
||||
return $body = LJ::bad_input('Invalid sender')
|
||||
unless $cansend{$POST{'from'}};
|
||||
|
||||
# Already did sanity checking in the previous step
|
||||
my @addrs = split(',', $POST{'to'});
|
||||
|
||||
my %prettynames;
|
||||
$prettynames{'abuse'} = "$LJ::SITENAMESHORT Abuse Team";
|
||||
$prettynames{'accounts'} = "$LJ::SITENAMESHORT Accounts";
|
||||
$prettynames{'coppa'} = "$LJ::SITENAMESHORT COPPA Enforcement";
|
||||
$prettynames{'support'} = "$LJ::SITENAMESHORT Support Team";
|
||||
|
||||
my $fromname = $prettynames{$POST{'from'}};
|
||||
|
||||
foreach my $email (@addrs) {
|
||||
my $status = "S";
|
||||
# status "S" means send_mail returned true, but this does *not* guarantee
|
||||
# that the message didn't bounce, only that the sendmail process didn't croak
|
||||
|
||||
if(!LJ::send_mail({
|
||||
'to' => $email,
|
||||
'bcc' => $POST{'bcc'},
|
||||
'from' => "$POST{'from'}\@$LJ::DOMAIN",
|
||||
'fromname' => $fromname,
|
||||
'charset' => "utf-8",
|
||||
'subject' => $POST{'subject'},
|
||||
'body' => $POST{'message'},
|
||||
}))
|
||||
{
|
||||
$status = "F";
|
||||
push @errors, "<strong>Error:</strong><br />Mail not sent to $email";
|
||||
}
|
||||
|
||||
my $query = "INSERT INTO abuse_mail (mailid, userid, spid, status, timesent, mailto, " .
|
||||
"subject, message, type) " .
|
||||
"VALUES (NULL, ?, ?, ?, NOW(), ?, ?, ?, ?)";
|
||||
|
||||
$dbh->do($query, undef, $remote->{'userid'}, $POST{'request'}, $status,
|
||||
$email, $POST{'subject'}, $POST{'message'}, $POST{'from'});
|
||||
|
||||
if ($dbh->err) {
|
||||
my $error = $dbh->errstr;
|
||||
push @errors, "<strong>Error:</strong> Unable to record mailing to $email<br />$error";
|
||||
}
|
||||
|
||||
# take extra actions if necessary
|
||||
if ($POST{'extra'} =~ /^spam-notification;(\d+)$/) {
|
||||
my $u = LJ::load_userid($1+0);
|
||||
|
||||
push @errors, "<?h1 Error h1?><?p Invalid userid passed. " .
|
||||
"<b>Email was sent, statushistory not logged.</b> p?>"
|
||||
unless $u;
|
||||
|
||||
LJ::statushistory_add($u->{userid}, $remote->{userid}, 'spam_warning', 'Sent email warning')
|
||||
if $u;
|
||||
}
|
||||
}
|
||||
|
||||
if (@errors) {
|
||||
$body .= join("<br /><br />", @errors);
|
||||
} else {
|
||||
$body .= "Email(s) sent succesfully";
|
||||
}
|
||||
};
|
||||
|
||||
|
||||
# What to do aka "What it is"
|
||||
if (LJ::did_post()) {
|
||||
if ($GET{'action'} eq 'preview') {
|
||||
$preview->();
|
||||
} elsif ($GET{'action'} eq 'edit') {
|
||||
$compose->(1);
|
||||
} elsif ($GET{'action'} eq 'send') {
|
||||
$send->();
|
||||
}
|
||||
} else {
|
||||
$compose->(0);
|
||||
}
|
||||
}
|
||||
_code?>
|
||||
<=body
|
||||
title=>Send User Mail
|
||||
page?>
|
||||
151
ljcom/htdocs/admin/servers.bml
Normal file
151
ljcom/htdocs/admin/servers.bml
Normal file
@@ -0,0 +1,151 @@
|
||||
<?_code
|
||||
{
|
||||
use strict;
|
||||
use vars qw(%GET);
|
||||
use YAML ();
|
||||
use Storable ();
|
||||
use Data::Dumper ();
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
return "<b>Error:</b> You don't have access to see servers."
|
||||
unless LJ::check_priv($remote, "siteadmin", "serverview");
|
||||
|
||||
# YAML parser is slow as fuck.
|
||||
my $realfile = "$LJ::HOME/cgi-bin/servers.yaml";
|
||||
my $cached = "$LJ::HOME/var/servers.yaml.cache";
|
||||
|
||||
my $servers;
|
||||
|
||||
if (-e $cached && (stat(_))[9] > (stat($realfile))[9]) {
|
||||
# use the pre-parsed version from Storable, which doesn't suck.
|
||||
$servers = Storable::retrieve($cached);
|
||||
} else {
|
||||
$servers = YAML::LoadFile($realfile);
|
||||
Storable::store($servers, $cached);
|
||||
}
|
||||
|
||||
my $ret;
|
||||
$ret .= "<h1>Servers</h1>";
|
||||
|
||||
my $name = $GET{'name'};
|
||||
my $mode = $GET{'mode'};
|
||||
my $job = $GET{'job'};
|
||||
$mode = "1job" if $job;
|
||||
$mode = "1name" if $name;
|
||||
|
||||
foreach (['', 'By Name'],
|
||||
['job', 'By Job'],
|
||||
['ip', 'By IP'],
|
||||
['cab', 'By Cabinet'],
|
||||
) {
|
||||
if ($mode eq $_->[0]) {
|
||||
$ret .= "[<b>$_->[1]</b>]\n";
|
||||
} else {
|
||||
$ret .= "[<a href='servers.bml?mode=$_->[0]'>$_->[1]</a>]\n";
|
||||
}
|
||||
}
|
||||
|
||||
# sanitize the data structure a bit, and pick up on jobs/etc
|
||||
my %jobs;
|
||||
my %ip;
|
||||
foreach my $name (keys %$servers) {
|
||||
my $s = $servers->{$name};
|
||||
$s->{'jobs'} = [ $s->{'jobs'} ] unless ref $s->{'jobs'} eq "ARRAY";
|
||||
foreach (@{$s->{'jobs'}}) { $jobs{$_}->{$name} = 1; }
|
||||
|
||||
my $ip = $s->{'ip'};
|
||||
my $hip = join(':', map { sprintf("%02x", $_) } split(/\./, $ip));
|
||||
$ip{$hip} = $name;
|
||||
}
|
||||
|
||||
# show a single server
|
||||
if ($name) {
|
||||
unless ($servers->{$name}) { $ret .= "bogus name"; return $ret; }
|
||||
my $dp = Data::Dumper::Dumper($servers->{$name});
|
||||
my $link = sub {
|
||||
my $roles = shift;
|
||||
$roles =~ s/\'(.+?)\'/\'<a href="servers.bml?job=$1">$1<\/a>\'/g;
|
||||
return "'jobs' => [$roles]";
|
||||
};
|
||||
$dp =~ s/\'jobs\' => \[(.+?)\]/$link->($1)/se;
|
||||
$ret .= "<h2>$name</h2><pre>$dp</pre>";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
my $serv_line = sub {
|
||||
my $name = shift;
|
||||
my $text = shift;
|
||||
unless ($text) {
|
||||
my $s = $servers->{$name};
|
||||
my $pip = $s->{'ip'};
|
||||
my $jobs = join(', ', map { "<a href='servers.bml?job=$_'>$_</a>" } @{$s->{'jobs'}});
|
||||
$text = "[$pip] $jobs";
|
||||
}
|
||||
return "<p><b><a href='servers.bml?name=$name'>$name</a></b> $text</p>\n";
|
||||
};
|
||||
|
||||
# show a single job
|
||||
if ($job) {
|
||||
unless ($jobs{$job}) { $ret .= "bogus job"; return $ret; }
|
||||
$ret .= "<h2>Job: $job</h2><ul>";
|
||||
foreach my $name (sort keys %{$jobs{$job}}) {
|
||||
$ret .= $serv_line->($name);
|
||||
}
|
||||
$ret .= "</ul>";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
# by job
|
||||
if ($mode eq "job") {
|
||||
foreach my $job (sort keys %jobs) {
|
||||
$ret .= "<h2>Job: $job</h2><ul>\n";
|
||||
foreach my $name (sort keys %{$jobs{$job}}) {
|
||||
$ret .= $serv_line->($name);
|
||||
}
|
||||
$ret .= "</ul>";
|
||||
}
|
||||
return $ret;
|
||||
}
|
||||
|
||||
# by cabinet
|
||||
if ($mode eq "cab") {
|
||||
my %cab;
|
||||
my %u;
|
||||
foreach my $name (keys %$servers) {
|
||||
my $s = $servers->{$name};
|
||||
next unless $s->{'rack'};
|
||||
$cab{$s->{'rack'}->{'cabinet'}}->{$name} = 0; # not sure where for now
|
||||
next unless $s->{'rack'}->{'size'} =~ /\d+/;
|
||||
$u{$s->{'rack'}->{'cabinet'}} += $&;
|
||||
}
|
||||
foreach my $cab (sort { $a <=> $b } keys %cab) {
|
||||
$ret .= "<h2>Cabinet: $cab ($u{$cab}U)</h2><ul>\n";
|
||||
my $ch = $cab{$cab};
|
||||
foreach my $name (sort { $ch->{$a} <=> $ch->{$b} } keys %$ch) {
|
||||
my $s = $servers->{$name};
|
||||
$ret .= $serv_line->($name, $s->{'rack'}->{'size'});
|
||||
}
|
||||
$ret .= "</ul>";
|
||||
}
|
||||
return $ret;
|
||||
}
|
||||
|
||||
# by ip
|
||||
if ($mode eq "ip") {
|
||||
foreach my $ip (sort keys %ip) {
|
||||
my $dip = join('.', map { hex $_ } split(/:/, $ip));
|
||||
my $name = $ip{$ip};
|
||||
$ret .= $serv_line->($name, "[$dip]");
|
||||
}
|
||||
return $ret;
|
||||
}
|
||||
|
||||
# by name
|
||||
foreach my $name (sort keys %$servers) {
|
||||
$ret .= $serv_line->($name);
|
||||
}
|
||||
|
||||
return $ret;
|
||||
}
|
||||
_code?>
|
||||
70
ljcom/htdocs/admin/support/index.bml
Normal file
70
ljcom/htdocs/admin/support/index.bml
Normal file
@@ -0,0 +1,70 @@
|
||||
<?page
|
||||
title=>LiveJournal Support Tools
|
||||
body<=
|
||||
<?_code
|
||||
{
|
||||
use strict;
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
my $canhelp = LJ::check_priv($remote, 'supporthelp') ||
|
||||
LJ::check_priv($remote, 'supportviewscreened');
|
||||
|
||||
return "This page is intended for LiveJournal Support" .
|
||||
" Volunteer use only. If you need support, please" .
|
||||
" visit <a href='http://www.livejournal.com/support/'>" .
|
||||
"http://www.livejournal.com/support/</a>." unless $remote && $canhelp;
|
||||
|
||||
my $ret;
|
||||
|
||||
$ret .= "<?p This is a collection of various tools and communities used by LiveJournal Support Volunteers. You may not have privileges for all tools listed. p?>";
|
||||
|
||||
$ret .= "<?h2 General Tools h2?>";
|
||||
$ret .= "<ul>";
|
||||
$ret .= "<li><a href='/support/help.bml?state=youreplied'>You Replied Filter</a></li>";
|
||||
$ret .= "<li><a href='/admin/console/'>Admin Console</a> (<a href='/admin/console/reference.bml'>Reference</a>)</li>";
|
||||
$ret .= "<li><a href='/support/changenotify.bml'>Change Notification Options</a></li>";
|
||||
$ret .= "<li><a href='/support/see_overrides.bml'>See Overrides</a></li>";
|
||||
$ret .= "<li><a href='/support/history.bml'>User Request History</a></li>";
|
||||
$ret .= "<li><a href='/betatest.bml'>Beta Test Options</a></li>";
|
||||
$ret .= "<li><a href='/admin/faq/index.bml'>FAQ Edit</a></li>";
|
||||
$ret .= "<li><a href='/admin/memcache_purge.bml'>Memcache Purge</a></li>";
|
||||
$ret .= "<li><a href='/admin/clusterstatus.bml'>Cluster Status</a></li>";
|
||||
$ret .= "<li><a href='/tools/recent_emailposts.bml'>Email Post History</a></li>";
|
||||
$ret .= "</ul>";
|
||||
|
||||
|
||||
my @scomms = (
|
||||
'lj_support', 'helpscreening', 'support_interim',
|
||||
'support_clients', 'support_comms', 'support_embed',
|
||||
'support_general', 'support_mobile', 'support_ssystem',
|
||||
'support_syn', 'support_upi', 'support_web', 'web_ui',
|
||||
'web_training', 'lj_supportadmin'
|
||||
);
|
||||
|
||||
$ret .= "<?h2 Support Communities h2?>";
|
||||
$ret .= "<ul>";
|
||||
|
||||
foreach (@scomms) {
|
||||
$ret .= "<li>" . LJ::ljuser("$_") .
|
||||
" (<a href='/update.bml?usejournal=$_'>Post</a>)</li>";
|
||||
}
|
||||
$ret .= "</ul>";
|
||||
|
||||
|
||||
$ret .= "<?h2 Support Admin Tools h2?>";
|
||||
$ret .= "<ul>";
|
||||
$ret .= "<li><a href='/admin/priv/index.bml'>Privilege Management</a></li>";
|
||||
$ret .= "<li><a href='/support/stock_answers.bml'>Manage Stock Answers</a></li>";
|
||||
$ret .= "<li><a href='/admin/statushistory.bml'>Status History</a></li>";
|
||||
$ret .= "<li><a href='/admin/fileedit/index.bml?file=support-currentproblems'>Edit BBB</a></li>";
|
||||
$ret .= "<li><a href='/admin/sendmail/send.bml?from=support'>Send Support Note</a></li>";
|
||||
$ret .= "<li><a href='/admin/sendmail/query.bml?restrict=support'>Query Support Notes</a></li>";
|
||||
$ret .= "</ul>";
|
||||
|
||||
return $ret;
|
||||
|
||||
|
||||
}
|
||||
_code?>
|
||||
<=body
|
||||
page?>
|
||||
Reference in New Issue
Block a user