[LON-CAPA-cvs] cvs: modules /raeburn/register register.pm
raeburn
lon-capa-cvs-allow@mail.lon-capa.org
Fri, 30 Mar 2007 22:49:21 -0000
This is a MIME encoded message
--raeburn1175294961
Content-Type: text/plain
raeburn Fri Mar 30 18:49:21 2007 EDT
Modified files:
/modules/raeburn/register register.pm
Log:
Dorm accommodation can be more than one type.
Tracking of number of nights etc. stored in separate table.
Allow refunds from credit in current transaction to be set against debits for new purchases.
Retrieve endcredit date which indicates the last date/time when refunds can be made.
--raeburn1175294961
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20070330184921.txt"
Index: modules/raeburn/register/register.pm
diff -u modules/raeburn/register/register.pm:1.10 modules/raeburn/register/register.pm:1.11
--- modules/raeburn/register/register.pm:1.10 Wed Mar 21 18:40:00 2007
+++ modules/raeburn/register/register.pm Fri Mar 30 18:49:20 2007
@@ -12,6 +12,7 @@
use Apache::LON::processform;
use Time::Local;
use Date::Manip;
+use POSIX "floor";
sub handler {
my $r = shift;
@@ -115,12 +116,14 @@
} else {
# check for fees
if ($fees) {
- $sth = $dbh->prepare("SELECT iid,description,cost,required FROM products WHERE event_id = '$event_id'");
+ $sth = $dbh->prepare("SELECT iid,description,cost,required,longdesc,type FROM products WHERE event_id = '$event_id'");
$sth->execute;
- while ( my ($iid,$desc,$cost,$reqd) = $sth->fetchrow_array) {
+ while ( my ($iid,$desc,$cost,$reqd,$longdesc,$type) = $sth->fetchrow_array) {
$feeinfo{$iid}{desc} = $desc;
$feeinfo{$iid}{cost} = $cost;
$feeinfo{$iid}{reqd} = $reqd;
+ $feeinfo{$iid}{longdesc} = $longdesc;
+ $feeinfo{$iid}{type} = $type;
}
$sth->finish;
}
@@ -359,6 +362,17 @@
} elsif (@curr_workshops == 1) {
$curr{'workshop'} = '"'.$curr_workshops[0].'"';
}
+# Is there accommodation data for this user?
+ $statement = "SELECT type,nights FROM event_accommodation WHERE user_id = $quoted_user AND event_id = '$event_id'";
+ $sth = $dbh->prepare("$statement");
+ $sth->execute();
+ while (my ($type,$nights) = $sth->fetchrow_array) {
+ if ($nights > 0) {
+ $curr{$type} = 'Y';
+ $curr{'dormroom'} = $type;
+ }
+ }
+ $sth->finish;
}
# Is there already user data?
@@ -376,7 +390,7 @@
}
}
-# Is there payment data?
+# Is there already payment data?
my $payinfo;
if ($fees) {
my (%total,%balance,%credit);
@@ -395,15 +409,27 @@
if ($status eq 'enroll' || $status eq 'cancel') {
foreach my $iid (sort(keys(%{$feeinfo}))) {
if ($$feeinfo{$iid}{reqd} eq 'Y') {
- if (!defined($total{$iid})) {
- $total{$iid} = 1;
+ if ($$feeinfo{$iid}{'type'} eq 'accomm') {
+ my $quoted_type = $dbh->quote( $$feeinfo{$iid}{desc} );
+ my $nights = $dbh->selectrow_array("SELECT nights FROM event_accommodation WHERE (user_id = $quoted_user AND $event_id = '$event_id' AND type = $quoted_type)");
+ $total{$iid} = $nights;
+ } else {
+ if ($total{$iid} eq '' || $total{$iid} == 0) {
+ $total{$iid} = 1;
+ }
}
if ($balance{$iid} eq '') {
$balance{$iid} = 0;
}
} elsif ($curr{$$feeinfo{$iid}{desc}} eq 'Y') {
- if ($total{$iid} eq '') {
- $total{$iid} = 1;
+ if ($$feeinfo{$iid}{'type'} eq 'accomm') {
+ my $quoted_type = $dbh->quote( $$feeinfo{$iid}{desc} );
+ my $nights = $dbh->selectrow_array("SELECT nights FROM event_accommodation WHERE (user_id = $quoted_user AND $event_id = '$event_id' AND type = $quoted_type)");
+ $total{$iid} = $nights;
+ } else {
+ if ($total{$iid} eq '' || $total{$iid} == 0) {
+ $total{$iid} = 1;
+ }
}
if ($balance{$iid} eq '') {
$balance{$iid} = 0;
@@ -419,29 +445,32 @@
foreach my $iid (sort(keys(%credit))) {
if (($$feeinfo{$iid}{'reqd'} eq 'Y') || ($curr{$$feeinfo{$iid}{'desc'}} eq 'Y')) {
if ($credit{$iid} == 0) {
- $payinfo .= 'You have paid the '.$$feeinfo{$iid}{desc}.' fee in full.';
+ if ($$feeinfo{$iid}{'cost'} > 0) {
+ $payinfo .= 'You have paid the '.$$feeinfo{$iid}{'longdesc'}.' fee in full.';
+ }
} elsif ($credit{$iid} > 0) {
- $payinfo .= 'You have overpaid for the '.$$feeinfo{$iid}{desc}.' - a credit of $'.$credit{$iid}.' will be credited to your credit card.';
+ $payinfo .= 'You have overpaid for the '.$$feeinfo{$iid}{'longdesc'}.' - a credit of $'.$credit{$iid}.' will be credited to you.';
} elsif ($credit{$iid} < 0) {
my $debt = -1 * $credit{$iid};
- $payinfo .= 'You owe $'.$debt.' for the '.$$feeinfo{$iid}{desc}.' fee.';
+ $debt = sprintf("%.2f",$debt);
+ $payinfo .= 'You owe $'.$debt.' for the '.$$feeinfo{$iid}{'longdesc'}.' fee.';
$modifybutton = 'Modify Registration/Pay Fee';
}
+ $payinfo .= '<br />';
} else {
if ($credit{$iid} > 0) {
- $payinfo .= 'A credit of $'.$credit{$iid}.' for the '.$$feeinfo{$iid}{desc}.' is due to you, as you are no longer registered for this program. Unless you choose to re-register, this amount will be credited to your credit card.';
+ $payinfo .= 'A credit of $'.$credit{$iid}.' for the '.$$feeinfo{$iid}{'longdesc'}.' is due to you, as you are no longer registered for this program. Unless you choose to re-register, this amount will be credited to you.<br />';
}
}
- $payinfo .= '<br />';
}
} elsif ($status eq 'cancel') {
foreach my $iid (sort(keys(%credit))) {
if ($credit{$iid} > 0) {
- $payinfo .= 'A credit of $'.$credit{$iid}.' for the '.$$feeinfo{$iid}{'desc'}.' is due to you, as you are no longer registered for the '.$event.' '.$year.'.';
+ $payinfo .= 'A credit of $'.$credit{$iid}.' for the '.$$feeinfo{$iid}{'longdesc'}.' is due to you, as you are no longer registered for the '.$event.' '.$year.'.';
if ($$feeinfo{$iid}{'reqd'} eq 'Y') {
- $payinfo .= ' Unless you choose to re-register, this amount will be credited to your credit card.';
+ $payinfo .= ' Unless you choose to re-register, this amount will be credited to you.';
} else {
- $payinfo .= ' Unless you choose to re-register, and choose to participate in the '.$$feeinfo{$iid}{'desc'}.' this amount will be credited to your credit card.';
+ $payinfo .= ' Unless you choose to re-register, and choose to participate in the '.$$feeinfo{$iid}{'longdesc'}.' this amount will be credited to you.';
}
$payinfo .'<br />';
}
@@ -449,16 +478,18 @@
}
}
-# Check if new registrations are allowed.
- my ($registeropen,$registerclose) = $dbh->selectrow_array("SELECT registeropen,registerclose FROM event_config WHERE event_id = '$event_id'");
- my ($regopen,$regclose,$opendate,$closedate);
+# Check if new registrations are allowed, and the last date/time for credits.
+ my ($registeropen,$registerclose,$creditclose) = $dbh->selectrow_array("SELECT registeropen,registerclose,endcredit FROM event_config WHERE event_id = '$event_id'");
+ my ($regopen,$regclose,$opendate,$closedate,$endcredit);
my $now = time;
my $regaccess = 'current';
if (defined($registeropen)) {
$regopen = &UnixDate($registeropen, "%s");
$opendate = localtime($regopen);
if ($now < $regopen) {
- $regaccess = 'future';
+ unless ($user eq 'raeburn:msu' || $user eq 'kortemey:msu' || $user eq 'astenger:uiuc' || $user eq 'mmichae:uiuc') {
+ $regaccess = 'future';
+ }
}
}
if (defined($registerclose)) {
@@ -722,7 +753,11 @@
if ($$feeinfo{$item}{reqd} eq 'N') {
$r->print('optional ');
}
- $r->print($$feeinfo{$item}{desc}.' - $'.$$feeinfo{$item}{cost}.'</li>');
+ $r->print($$feeinfo{$item}{longdesc}.' - $'.$$feeinfo{$item}{cost});
+ if ($$feeinfo{$item}{'type'} eq 'accomm') {
+ $r->print(' (per night)');
+ }
+ $r->print('</li>');
}
$r->print('</ul>');
}
@@ -919,7 +954,8 @@
unless (ref($$params{$_}) eq 'ARRAY') {
$quoted_params{$_} = $dbh->quote( $$params{$_} );
}
- }
+ }
+ my $now = time;
my $msg = '';
my $webmsg = '';
my $mailflag = 0;
@@ -929,6 +965,7 @@
my %curr = ();
my %userdata = ();
my @changes = ();
+ my @accomchgs;
my @removals = ();
my @infochanges = ();
my @additions = ();
@@ -938,7 +975,12 @@
} else {
@new_workshops = ("$$params{'workshop'}");
}
-
+# Check if new registrations are allowed, and the last date/time for credits.
+ my ($registeropen,$registerclose,$creditclose) = $dbh->selectrow_array("SELECT registeropen,registerclose,endcredit FROM event_config WHERE event_id = '$event_id'");
+ my $endcredit = 0;
+ if ($creditclose) {
+ $endcredit = &UnixDate($creditclose, "%s");
+ }
# Get form field types.
my $sth = $dbh->prepare("SELECT name,type FROM event_formfields WHERE event_id = '$event_id'");
$sth->execute();
@@ -953,13 +995,14 @@
# Get fee information
my %feehash;
if ($fees) {
- $sth = $dbh->prepare("SELECT iid,description,cost,required,longdesc FROM products WHERE event_id = '$event_id'");
+ $sth = $dbh->prepare("SELECT iid,description,cost,required,longdesc,type FROM products WHERE event_id = '$event_id'");
$sth->execute;
- while (my ($iid,$desc,$cost,$required,$longdesc)=$sth->fetchrow_array) {
+ while (my ($iid,$desc,$cost,$required,$longdesc,$type)=$sth->fetchrow_array) {
$feehash{$desc}{'iid'} = $iid;
$feehash{$desc}{'cost'} = $cost;
$feehash{$desc}{'reqd'} = $required;
$feehash{$desc}{'longdesc'} = $longdesc;
+ $feehash{$desc}{'type'} = $type;
}
$sth->finish;
}
@@ -994,17 +1037,21 @@
foreach my $type (keys %{$items}) {
foreach my $field (@{$$items{$type}}) {
- if ($$form_elements{$field}{tablename} eq 'event_registration')
-{
+ if ($$form_elements{$field}{tablename} eq 'event_registration') {
if ($$params{$field} ne $curr{$field}) {
push @changes, $field;
}
}
+ if ($$form_elements{$field}{tablename} eq 'event_accommodation') {
+ if ($$params{$field} ne $curr{$field}) {
+ push @accomchgs, $field;
+ }
+ }
}
}
$statement = "SELECT name from workshop_registration WHERE user_id = $quoted_user AND event_id = '$event_id'";
- my $sth = $dbh->prepare("$statement");
+ $sth = $dbh->prepare("$statement");
$sth->execute();
while (my @row = $sth->fetchrow_array) {
if (@row > 0) {
@@ -1075,6 +1122,13 @@
$dbh->do($statement);
}
+ $sth = $dbh->prepare("SELECT name,tablename FROM event_formfields WHERE event_id = '$event_id'");
+ $sth->execute;
+ while (my ($name,$tablename) = $sth->fetchrow_array) {
+ push @{$table_items{$tablename}}, $name;
+ }
+ $sth->finish;
+
if ($action eq 'add') {
my $newstatus = 'enroll';
if ($register == -1) {
@@ -1087,6 +1141,18 @@
}
$statement .= " WHERE user_id=$quoted_user AND event_id = '$event_id'";
$dbh->do($statement);
+ if (grep/^(accommodation|dormroom|arrival|departure)$/,@changes) {
+ if ($params->{'accommodation'} eq 'dorm') {
+ if (ref($table_items{'event_accommodation'}) eq 'ARRAY') {
+ if (@{$table_items{'event_accommodation'}} > 0) {
+ my $nights = $dbh->selectrow_array("select DATEDIFF(departure,arrival) from event_registration where event_id = '$event_id' AND user_id=$quoted_user");
+ $dbh->do("UPDATE event_accommodation SET nights='$nights',type=$quoted_params{'dormroom'} WHERE user_id=$quoted_user AND event_id ='$event_id'");
+ }
+ }
+ } else {
+ $dbh->do("UPDATE event_accommodation SET nights='0' WHERE user_id=$quoted_user AND event_id ='$event_id'");
+ }
+ }
foreach (@additions) {
$dbh->do("INSERT INTO workshop_registration (user_id,event_id,name) VALUES ($quoted_user,'$event_id','$_')");
}
@@ -1095,12 +1161,6 @@
$webmsg .= "<li>".$newmsg."</li>";
$mailflag = 1;
} elsif ($register == 0) {
- my $sth = $dbh->prepare("SELECT name,tablename FROM event_formfields WHERE event_id = '$event_id'");
- $sth->execute;
- while (my ($name,$tablename) = $sth->fetchrow_array) {
- push @{$table_items{$tablename}}, $name;
- }
- $sth->finish;
my $insertpart = "INSERT INTO event_registration (user_id,modified,status,event_id";
my $valuespart = "VALUES ($quoted_user,NOW(),'$newstatus','$event_id'";
if (@{$table_items{'event_registration'}} > 0) {
@@ -1116,6 +1176,14 @@
foreach (@additions) {
$dbh->do("INSERT INTO workshop_registration (user_id,event_id,name) VALUES ($quoted_user,'$event_id','$_')");
}
+ if ($params->{'accommodation'} eq 'dorm') {
+ if (ref($table_items{'event_accommodation'}) eq 'ARRAY') {
+ if (@{$table_items{'event_accommodation'}} > 0) {
+ my $nights = $dbh->selectrow_array("select DATEDIFF(departure,arrival) from event_registration where event_id = '$event_id' AND user_id=$quoted_user");
+ $dbh->do("INSERT INTO event_accommodation VALUES ($quoted_user,'$event_id','$nights',$quoted_params{dormroom})");
+ }
+ }
+ }
my $newmsg .= "Your registration for the $year LON-CAPA $event has been recorded";
$msg .= $newmsg."\n\n";
$webmsg .= "<li>".$newmsg."</li>";
@@ -1140,11 +1208,25 @@
}
$statement .= " WHERE user_id=$quoted_user AND event_id = '$event_id'";
$dbh->do($statement);
-
- my $newmsg .= "Your registration for the $year LON-CAPA $event has been updated.";
- $msg .= $newmsg."\n";
- $webmsg .= "<li>".$newmsg."</li>";
- $mailflag = 1;
+ if ((grep/^(accommodation|arrival|departure)$/,@changes) ||
+ (@accomchgs > 0)) {
+ if ($params->{'accommodation'} eq 'dorm') {
+ if (ref($table_items{'event_accommodation'}) eq 'ARRAY') {
+ if (@{$table_items{'event_accommodation'}} > 0) {
+ my $nights = $dbh->selectrow_array("select DATEDIFF(departure,arrival) from event_registration where event_id = '$event_id' AND user_id=$quoted_user");
+ $dbh->do("UPDATE event_accommodation SET nights='$nights',type=$quoted_params{'dormroom'} WHERE user_id=$quoted_user AND event_id ='$event_id'");
+ }
+ }
+ } else {
+ $dbh->do("UPDATE event_accommodation SET nights='0' WHERE user_id=$quoted_user AND event_id ='$event_id'");
+ }
+ }
+ if (@changes > 0 || @removals > 0 || @additions > 0) {
+ my $newmsg .= "Your registration for the $year LON-CAPA $event has been updated.";
+ $msg .= $newmsg."\n";
+ $webmsg .= "<li>".$newmsg."</li>";
+ $mailflag = 1;
+ }
foreach (@removals) {
$dbh->do("DELETE from workshop_registration WHERE user_id=$quoted_user AND event_id='$event_id' AND name='$_'");
}
@@ -1242,6 +1324,24 @@
}
}
+# Get accommodation status
+ my @final_accom;
+ my %finaldispaccom;
+ foreach my $item (keys %{$form_elements}) {
+ if ($$form_elements{$item}{tablename} eq 'event_accommodation') {
+ my ($nights,$longdesc,$name) = $dbh->selectrow_array("SELECT ea.nights,p.longdesc,p.description FROM event_accommodation ea, products p WHERE ea.user_id = $quoted_user AND ea.event_id = '$event_id' AND ea.type=p.description");
+ push(@final_accom,$name);
+ if ($nights) {
+ $finaldispdat{$name} = 'Y';
+ $finaldispaccom{$name}{msg} = $nights,' nights for '.$longdesc;
+ $finaldispaccom{$name}{quant} = $nights;
+ } else {
+ $finaldispdat{$name} = 'N';
+ $finaldispaccom{$name}{quant} = 0;
+ }
+ }
+ }
+
# Get payment data?
my (%total,%balance,%ccard,$payinfo,%costs,%quantities,%transactions,%credtrans);
my $order = 0;
@@ -1264,10 +1364,15 @@
if (ref($feehash{$key}) eq 'HASH') {
if (($feehash{$key}{reqd} eq 'Y') || ($finaldispdat{$key} eq 'Y')) {
if ($currstatus eq 'enroll') {
- $costs{$key} = $feehash{$key}{'cost'};
- $quantities{$key} ++;
+ if ($feehash{$key}{'type'} eq 'accomm') {
+ $quantities{$key} += $finaldispaccom{$key}{quant};
+ } else {
+ $quantities{$key} ++;
+ }
+ $costs{$key} = $feehash{$key}{'cost'} * $quantities{$key};
} else {
$costs{$key} = 0;
+ $quantities{$key} = 0;
}
}
}
@@ -1276,46 +1381,60 @@
my $desc = $$feeinfo{$iid}{'desc'};
if (!$costs{$desc}) {
$costs{$desc} = 0;
+ $quantities{$desc} = 0;
}
}
foreach my $key (keys(%costs)) {
$ccard{$key} = $balance{$feehash{$key}{'iid'}}-$costs{$key};
$ccard{$key} = sprintf("%.2f",$ccard{$key});
+ if ($ccard{$key} > 0) {
+ if ((!$endcredit) || ($now <= $endcredit)) {
+ $order -= $ccard{$key};
+ }
+ }
if ($ccard{$key} == 0) {
- if ($currstatus eq 'enroll') {
- $payinfo .= 'You have paid the '.$key.' fee in full.';
- } elsif ($currstatus eq 'cancel') {
- $payinfo .= 'There is no credit due for the '.$key.' as a result of cancellation.';
+ if ($quantities{$key} > 0) {
+ if ($currstatus eq 'enroll') {
+ $payinfo .= 'You have paid the '.$$feeinfo{$feehash{$key}{'iid'}}{'longdesc'}.' fee in full.<br />';
+ } elsif ($currstatus eq 'cancel') {
+ $payinfo .= 'There is no credit due for the '.$$feeinfo{$feehash{$key}{'iid'}}{'longdesc'}.' as a result of cancellation.<br />';
+ }
}
- } elsif ($ccard{$key} > 0) {
+ } elsif ($ccard{$key} > 0) {
$creditnum ++;
- my $credit = -1 * $ccard{$key};
- my $iid = $feehash{$key}{'iid'};
- $credtrans{$iid}{quantity} += -1 * $total{$feehash{$key}{'iid'}};
- $credtrans{$iid}{amount} = $credit;
- $credtrans{$iid}{status} = 'credit';
- $credtrans{$iid}{desc} = $key;
- if ($currstatus eq 'enroll') {
- if (($feehash{$key}{reqd} eq 'Y') || ($finaldispdat{$key} eq 'Y')) {
- $payinfo .= 'You have overpaid for '.$key.' - a credit of $'.$ccard{$key}.' will be credited to your credit card.';
- } else {
- $payinfo .= 'As you will not be attending the '.$key.' a credit of $'.$ccard{$key}.' will be credited to your credit card.';
+ if ((!$endcredit) || ($now <= $endcredit)) {
+ my $credit = -1 * $ccard{$key};
+ my $iid = $feehash{$key}{'iid'};
+ $credtrans{$iid}{quantity} += ($quantities{$key} - $total{$feehash{$key}{'iid'}});
+ $credtrans{$iid}{amount} = $credit;
+ $credtrans{$iid}{status} = 'credit';
+ $credtrans{$iid}{desc} = $key;
+ if ($currstatus eq 'enroll') {
+ if (($feehash{$key}{reqd} eq 'Y') || ($finaldispdat{$key} eq 'Y')) {
+ $payinfo .= 'You have overpaid for '.$$feeinfo{$feehash{$key}{'iid'}}{'longdesc'}.' - a credit of $'.$ccard{$key}.' will be credited to you.<br />';
+ } else {
+ if ($feehash{$key}{'type'} eq 'accomm') {
+ $payinfo .= 'As your dorm accommodation requirements have been reduced, a credit of $'.$ccard{$key}.' will be credited to you.<br />';
+ } else {
+ $payinfo .= 'As you will not be attending the '.$key.' a credit of $'.$ccard{$key}.' will be credited to you.<br />';
+ }
+ }
+ } elsif ($currstatus eq 'cancel') {
+ $payinfo .= 'As you have cancelled, a credit of $'.$ccard{$key}.' for the '.$$feeinfo{$feehash{$key}{'iid'}}{'longdesc'}.' will be credited to you.<br />';
}
- $payinfo .= ' This credit will be processed within 1 to 2 business days.';
- } elsif ($currstatus eq 'cancel') {
- $payinfo .= 'As you have cancelled, a credit of $'.$ccard{$key}.' for the '.$key.' will be credited to your credit card.';
}
} elsif ($ccard{$key} < 0) {
my $debt = -1 * $ccard{$key};
- $payinfo .= 'You owe $'.$debt.' for the '.$key.' fee.';
+ $debt = sprintf("%.2f",$debt);
+ my $iid = $feehash{$key}{'iid'};
+ $payinfo .= 'You owe $'.$debt.' for the '.$$feeinfo{$iid}{'longdesc'}.' fee.<br />';
$order += $debt;
$paynum ++;
my $iid = $feehash{$key}{'iid'};
- $transactions{$iid}{quantity} += $quantities{$key};
+ $transactions{$iid}{quantity} += ($quantities{$key} - $total{$feehash{$key}{'iid'}});
$transactions{$iid}{amount} = $debt;
$transactions{$iid}{status} = 'payment';
}
- $payinfo .= '<br />';
}
}
@@ -1335,8 +1454,8 @@
&error_exit($r,$page,$year,$event,"Can't fork for sendmail:$!\n",$contact_name,$contact_email,$sponsors,$sponsorinfo,$domain);
return;
}
- my $mailcopy = "To: $contact_email\n".
- "From: loncapa@loncapa.org\n".
+ my $mailcopy = "To: raeburn\@msu.edu\n".
+ "From: $contact_email\n".
"Subject: LON-CAPA conference/workshop change\n".
"The following transaction occurred for $user in the LON-CAPA events registration system: \n".
"$msg\n"."$statusmsg{mail}\n";
@@ -1408,70 +1527,125 @@
<td> </td>
<td class="LC_receipt">$payinfo
END_OF_C
+ $order = sprintf("%.2f",$order);
+ if ($order > 0) {
+ $r->print('Please click the payment button to pay the balance due of $'.$order);
+ } elsif ($order < 0) {
+ my $credittot = -1 * $order;
+ $credittot = sprintf("%.2f",$credittot);
+ $r->print('You are owed $'.$credittot.'.<br />This amount will be credited to the credit card you used for your original purchase in the next 1 to 2 days.');
+ }
+ my (%available,%oldbalance);
+ my $adminmsg;
+ if ($creditnum) {
+ if ((!$endcredit) || ($now <= $endcredit)) {
+ my (%drop,%refund);
+ if ($curr_pid) {
+ foreach my $iid (sort(keys(%credtrans))) {
+ if (ref($credtrans{$iid}) eq 'HASH') {
+ my $remaining = -1 *$credtrans{$iid}{'quantity'};
+ my $moneyback = -1 * $credtrans{$iid}{'amount'};
+ my $sth = $dbh->prepare("SELECT wid,quantity,amount FROM transactions WHERE (iid = '$iid' AND pid = '$curr_pid' AND status = 'payment') ORDER BY wid");
+ $sth->execute();
+ while ((my ($oldwid,$quantity,$amount) = $sth->fetchrow_array) && ($remaining > 0)) {
+ $drop{$oldwid}{$iid} = -1 * $remaining;
+ $refund{$oldwid}{$iid} = -1 * $moneyback;
+ $remaining -= $quantity;
+ $moneyback -= $amount;
+ if ($remaining > 0) {
+ $drop{$oldwid}{$iid} = -1 * $quantity;
+ }
+ if ($moneyback > 0) {
+ $refund{$oldwid}{$iid} = -1 * $amount;
+ }
+ }
+ $sth->finish;
+ }
+ }
+ foreach my $wid (sort(keys(%refund))) {
+ my ($orderid,$lastname,$firstname,$user_id) = $dbh->selectrow_array("SELECT w.orderid, su.lastname, su.firstname, su.user_id FROM webcredit w, support_user su, purchaser p WHERE (w.wid = '$wid' AND su.user_id = p.user_id AND p.pid = w.pid)");
+ my $totalrefund = 0;
+ my $oldbal = $dbh->selectrow_array("SELECT amount FROM webcredit WHERE wid = '$wid'");
+ my $newbal = $oldbal;
+ if (ref($refund{$wid}) eq 'HASH') {
+ foreach my $iid (keys(%{$refund{$wid}})) {
+ $newbal += $refund{$wid}{$iid};
+ $totalrefund += $refund{$wid}{$iid};
+ }
+ $newbal = sprintf("%.2f",$newbal);
+ $dbh->do("UPDATE webcredit SET modified=NOW(),state='C',amount='$newbal' WHERE wid='$wid'");
+ }
+ $oldbal = sprintf("%.2f",$oldbal);
+ my $showrefund = -1 * $totalrefund;
+ $showrefund = sprintf("%.2f",$showrefund);
+ if ($showrefund > 0.00) {
+ $available{$wid} = $showrefund;
+ }
+ if ($oldbal > 0.00) {
+ $oldbalance{$wid} = $oldbal;
+ }
+ $adminmsg .= 'This transaction includes a refund of $'.$showrefund.' to '."$firstname $lastname ($user_id)".' -webcredit item: '.$wid.' order#: '.$orderid.".\n";
+ }
+ foreach my $wid (sort(keys(%drop))) {
+ if (ref($drop{$wid}) eq 'HASH') {
+ foreach my $iid (keys(%{$drop{$wid}})) {
+ $dbh->do("INSERT INTO transactions (wid,pid,iid,quantity,status,amount) VALUES ('$wid','$curr_pid','$iid','$drop{$wid}{$iid}','$credtrans{$iid}{status}','$refund{$wid}{$iid}')");
+ }
+ }
+ }
+ }
+ } else {
+ $payinfo .= 'Credit for overpayment or cancellation ended on '.localtime($endcredit).'.';
+ }
+ }
if ($paynum) {
my $pid;
if ($curr_pid eq '') {
my $lastpid = $dbh->selectrow_array("SELECT LAST_INSERT_ID() FROM purchaser");
$dbh->do("INSERT INTO purchaser (user_id,event_id) VALUES ($quoted_user,'$event_id')");
- $pid = $dbh->selectrow_array("SELECT LAST_INSERT_ID() FROM purchaser");
+ $pid = $dbh->selectrow_array("SELECT LAST_INSERT_ID() FROM purchaser");
if ($pid - $lastpid > 1) {
print STDERR "Warning - strange behavior in puchaser table, last id before insert was $lastpid, last id after insert was $pid. This is for $event_id and $user\n";
}
} else {
$pid = $curr_pid;
}
- $dbh->do("INSERT INTO webcredit (pid,created) VALUES ($pid,NOW())");
- my $wid = $dbh->selectrow_array("SELECT LAST_INSERT_ID() FROM webcredit");
- foreach my $iid (sort(keys(%transactions))) {
- if (ref($transactions{$iid}) eq 'HASH') {
- $dbh->do("INSERT INTO transactions (wid,pid,iid,quantity,status,amount) VALUES ('$wid','$pid','$iid','$transactions{$iid}{quantity}','$transactions{$iid}{status}','$transactions{$iid}{amount}')");
+ my %remnants;
+ if ($creditnum) {
+ %remnants = &reusecredit($dbh,$pid,\%available,\%oldbalance,
+ \%transactions,\$adminmsg);
+ } else {
+ foreach my $iid (sort(keys(%transactions))) {
+ $remnants{$iid}{'topay'} = $transactions{$iid}{amount};
+ $remnants{$iid}{'toadd'} = $transactions{$iid}{quantity};
}
}
- my $redirect = '/register?year='.$year.'&event='.$enc_event.'&page=2&go=NextPage';
- my $webcreditform = &webcredit($paynum,$order,$wid,\%ccard,
- \%feehash,\%finaldispdat,\%costs,
- \%quantities,$redirect);
- $r->print('<br /><br />'.$webcreditform);
- }
- if ($creditnum) {
- my (%drop,%refund);
- if ($curr_pid) {
- foreach my $iid (sort(keys(%credtrans))) {
- if (ref($credtrans{$iid}) eq 'HASH') {
- my $remaining = -1 *$credtrans{$iid}{'quantity'};
- my $moneyback = -1 * $credtrans{$iid}{'amount'};
- my $sth = $dbh->prepare("SELECT wid,quantity,amount FROM transactions WHERE (iid = '$iid' AND pid = '$curr_pid' AND status = 'payment') ORDER BY wid");
- $sth->execute();
- while ((my ($oldwid,$quantity,$amount) = $sth->fetchrow_array) && ($remaining > 0)) {
- $drop{$oldwid}{$iid} = -1 * $remaining;
- $refund{$oldwid}{$iid} = -1 * $moneyback;
- $remaining -= $quantity;
- $moneyback -= $amount;
- if ($remaining > 0) {
- $drop{$oldwid}{$iid} = -1 * $quantity;
- }
- if ($moneyback > 0) {
- $refund{$oldwid}{$iid} = -1 * $amount;
- }
- }
- $sth->finish;
- }
- }
- foreach my $wid (sort(keys(%refund))) {
- my $newbal = $dbh->selectrow_array("SELECT amount FROM webcredit WHERE wid = '$wid'");
- if (ref($refund{$wid}) eq 'HASH') {
- foreach my $iid (keys(%{$refund{$wid}})) {
- $newbal += $refund{$wid}{$iid};
- }
- $dbh->do("UPDATE webcredit SET modified=NOW(),state='C',amount='$newbal' WHERE wid='$wid'");
+ if ($order > 0) {
+ $dbh->do("INSERT INTO webcredit (pid,created) VALUES ($pid,NOW())");
+ my $wid = $dbh->selectrow_array("SELECT LAST_INSERT_ID() FROM webcredit");
+ foreach my $iid (sort(keys(%remnants))) {
+ if (ref($transactions{$iid}) eq 'HASH') {
+ $dbh->do("INSERT INTO transactions (wid,pid,iid,quantity,status,amount) VALUES ('$wid','$pid','$iid','$remnants{$iid}{toadd}','$transactions{$iid}{status}','$remnants{$iid}{topay}')");
}
}
- foreach my $wid (sort(keys(%drop))) {
- if (ref($drop{$wid}) eq 'HASH') {
- foreach my $iid (keys(%{$drop{$wid}})) {
- $dbh->do("INSERT INTO transactions (wid,pid,iid,quantity,status,amount) VALUES ('$wid','$curr_pid','$iid','drop{$wid}{$iid}','$credtrans{$iid}{status}','$refund{$wid}{$iid}')");
- }
- }
+ my $redirect = '/register?year='.$year.'&event='.$enc_event.'&page=2&go=NextPage';
+ my $webcreditform = &webcredit($paynum,$order,$wid,\%ccard,\%total, \%feehash,\%finaldispdat,\%costs,
+ \%quantities,$redirect);
+ $r->print('<br /><br />'.$webcreditform);
+ }
+ }
+ if ($creditnum) {
+ if ($adminmsg ne '') {
+ $adminmsg = "To: raeburn\@msu.edu\n".
+ "From: $contact_email\n".
+ "Subject: LON-CAPA refund(s)\n".
+ "$adminmsg\n";
+ if (open(MAIL, "|/usr/lib/sendmail -oi -t -odb")) {
+ print MAIL $adminmsg;
+ close(MAIL);
+ } else {
+ &error_exit($r,$page,$year,$event,"Can't fork for sendmail:$!\n",$contact_name,$contact_email,$sponsors,$sponsorinfo,$domain);
+ return;
}
}
}
@@ -1480,7 +1654,7 @@
</tr>
END_OF_D
}
- if (!$paynum) {
+ if ($order < 0) {
$r->print(<<"END_OF_E");
<tr>
<td colspan="2"> </td>
@@ -1600,9 +1774,10 @@
}
sub webcredit {
- my ($paynum,$order,$wid,$ccard,$feehash,$finaldat,$costs,$quantities,
+ my ($paynum,$order,$wid,$ccard,$total,$feehash,$finaldat,$costs,$quantities,
$redirect) = @_;
my %sort_by_id;
+ $order = sprintf("%.2f",$order);
my $checksum1 = (($order*300)+1)%307;
my $checksum2 = (($order*4200)+8)%1039;
my $name = $finaldat->{'firstname'}.' '.$finaldat->{'lastname'}.' '.$finaldat->{'generation'};
@@ -1641,11 +1816,15 @@
my $item = $sort_by_id{$iid};
$n ++;
my $debt = -1 * $ccard->{$item};
+ $debt = sprintf("%.2f",$debt);
+ my $prodprice = $feehash->{$item}{'cost'};
+ $prodprice = sprintf("%.2f",$prodprice);
+ my $quant = $quantities->{$item} - $total->{$feehash->{$item}{'iid'}};
$output .= <<END_B;
<input type="hidden" NAME="Prod_SKU$n" Value="$iid">
-<input type="hidden" NAME="Prod_Qty$n" Value="$quantities->{$item}">
+<input type="hidden" NAME="Prod_Qty$n" Value="$quant">
<input type="hidden" NAME="Prod_Name$n" Value="$feehash->{$item}{'longdesc'}">
-<input type="hidden" NAME="Prod_Price$n" Value="$costs->{$item}">
+<input type="hidden" NAME="Prod_Price$n" Value="$prodprice">
<input type="hidden" NAME="Prod_TotalPrice$n" Value="$debt">
END_B
}
@@ -1656,6 +1835,77 @@
return $output;
}
+sub reusecredit {
+ my ($dbh,$pid,$available,$oldbalance,$transactions,$adminmsg) = @_;
+ my @sortedwids;
+ my (%remnants,%floats,%origrefunds);
+ foreach my $wid (keys(%{$available})) {
+ $origrefunds{$wid} = $available->{$wid};
+ push(@{$floats{$available->{$wid}}},$wid);
+ }
+ my @sorted = sort {$b <=> $a} keys(%floats);
+ my $totalspare = 0;
+ foreach my $spare (@sorted) {
+ foreach my $wid (@{$floats{$spare}}) {
+ push(@sortedwids,$wid);
+ $totalspare ++;
+ }
+ }
+ my $widcount = 0;
+ my $lastused = 0;
+ my $currwid;
+ my ($topay,$toadd);
+ foreach my $iid (sort(keys(%{$transactions}))) {
+ if (!$lastused) {
+ if (ref($transactions->{$iid}) eq 'HASH') {
+ $toadd = $transactions->{$iid}{quantity};
+ $topay = $transactions->{$iid}{amount};
+ while ($topay > 0.00 && $widcount < $totalspare) {
+ $currwid = $sortedwids[$widcount];
+ my $curramount;
+ my $currquant;
+ if ($topay - $available->{$currwid} > 0) {
+ $curramount = $available->{$currwid};
+ $available->{$currwid} = 0;
+ $$adminmsg .= "refund of $origrefunds{$currwid} for webcredit item: $currwid all used for new purchases\n";
+ $dbh->do("UPDATE webcredit SET modified=NOW(),state='D',amount='$oldbalance->{$currwid}' WHERE wid='$currwid'");
+ $toadd -= $currquant;
+ $widcount ++;
+ } else {
+ $curramount = $topay;
+ $available->{$currwid} -= $curramount;
+ }
+ $currquant = floor($transactions->{$iid}{quantity} * $curramount/$transactions->{$iid}{amount});
+ $toadd -= $currquant;
+ $topay -= $curramount;
+ if ($topay == 0.00) {
+ if ($toadd > 0) {
+ $currquant += $toadd;
+ $toadd = 0;
+ }
+ }
+ $dbh->do("INSERT INTO transactions (wid,pid,iid,quantity,status,amount) VALUES ('$currwid','$pid','$iid','$currquant','$transactions->{$iid}{status}','$curramount')");
+ }
+ if ($topay > 0.00) {
+ $remnants{$iid}{'topay'} = $topay;
+ $remnants{$iid}{'toadd'} = $toadd;
+ $lastused = 1;
+ }
+ }
+ } else {
+ $remnants{$iid}{'topay'} = $transactions->{$iid}{amount};
+ $remnants{$iid}{'toadd'} = $transactions->{$iid}{quantity};
+ }
+ }
+ if ($topay == 0) {
+ my $newbal = $oldbalance->{$currwid} - $available->{$currwid};
+ $newbal = sprintf("%.2f",$newbal);
+ $dbh->do("UPDATE webcredit SET modified=NOW(),state='C',amount='$newbal' WHERE wid='$currwid'");
+ $$adminmsg .= "refund of $origrefunds{$currwid} for webcredit item: $currwid partially used for new purchases - amount to refund is $available->{$currwid}\n";
+ }
+ return %remnants;
+}
+
sub error_exit() {
my ($r,$page,$year,$event,$error_msg,$contact_name,$contact_email,$sponsors,$sponsorinfo,$domain) = @_;
$r->print(<<"END_OF_TOP");
--raeburn1175294961--