| Line 1... |
Line 1... |
| 1 |
#!/usr/bin/perl
|
1 |
#!/usr/bin/perl
|
| Line -... |
Line 2... |
| - |
|
2 |
|
| - |
|
3 |
# Redirect error messages to a log of my choosing. (it's annoying to filter for errors in the shared env)
|
| - |
|
4 |
my $error_log_path = $ENV{SERVER_NAME} eq "volunteers.rollercon.com" ? "/home3/rollerco/logs/" : "/tmp/";
|
| - |
|
5 |
close STDERR;
|
| - |
|
6 |
open STDERR, '>>', $error_log_path.'vorc_error.log' or warn "Failed to open redirected logfile ($0): $!";
|
| - |
|
7 |
#warn "Redirecting errors to ${error_log_path}vorc_error.log";
|
| - |
|
8 |
|
| - |
|
9 |
# Redirect error messages to a log of my choosing. (it's annoying to filter for errors in the shared env)
|
| - |
|
10 |
my $error_log_path = $ENV{SERVER_NAME} eq "volunteers.rollercon.com" ? "/home3/rollerco/logs/" : "/tmp/";
|
| - |
|
11 |
close STDERR;
|
| - |
|
12 |
open STDERR, '>>', $error_log_path.'vorc_error.log' or warn "Failed to open redirected logfile ($0): $!";
|
| - |
|
13 |
#warn "Redirecting errors to ${error_log_path}vorc_error.log";
|
| 2 |
|
14 |
|
| Line 3... |
Line 15... |
| 3 |
#if ($ENV{SHELL}) { die "This script shouldn't be executed from the command line!\n"; }
|
15 |
#if ($ENV{SHELL}) { die "This script shouldn't be executed from the command line!\n"; }
|
| 4 |
|
16 |
|
| 5 |
use strict;
|
17 |
use strict;
|
| Line 11... |
Line 23... |
| 11 |
our $h = HTML::Tiny->new( mode => 'html' );
|
23 |
our $h = HTML::Tiny->new( mode => 'html' );
|
| Line 12... |
Line 24... |
| 12 |
|
24 |
|
| 13 |
my $cookie_string = authenticate (1) || die;
|
25 |
my $cookie_string = authenticate (1) || die;
|
| 14 |
our ($EML, $PWD, $LVL) = split /&/, $cookie_string;
|
26 |
our ($EML, $PWD, $LVL) = split /&/, $cookie_string;
|
| 15 |
my $user = getUser ($EML);
|
27 |
my $user = getUser ($EML);
|
| 16 |
my $username = $h->a ({ href=>"/schedule/manage_user.pl?submit=View&RCid=$user->{RCid}" }, $user->{derby_name});
|
28 |
my $username = $h->a ({ href=>"/schedule/view_user.pl?submit=View&RCid=$user->{RCid}" }, $user->{derby_name});
|
| 17 |
my $RCid = $user->{RCid};
|
29 |
my $RCid = $user->{RCid};
|
| Line 42... |
Line 54... |
| 42 |
# If we need to modify line item values, create a subroutine named "modify_$columnname"
|
54 |
# If we need to modify line item values, create a subroutine named "modify_$columnname"
|
| 43 |
# It will receive a hashref to the object lineitem
|
55 |
# It will receive a hashref to the object lineitem
|
| Line 44... |
Line 56... |
| 44 |
|
56 |
|
| 45 |
sub modify_derby_name {
|
57 |
sub modify_derby_name {
|
| 46 |
my $li = shift;
|
58 |
my $li = shift;
|
| 47 |
return $h->a ({ href=>"manage_user.pl?RCid=$li->{RCid}" }, $li->{derby_name});
|
59 |
return $h->a ({ href=>"view_user.pl?RCid=$li->{RCid}" }, $li->{derby_name});
|
| Line 48... |
Line 60... |
| 48 |
}
|
60 |
}
|
| Line 73... |
Line 85... |
| 73 |
foreach (param()) {
|
85 |
foreach (param()) {
|
| 74 |
$FORM{$_} = param($_); # Retrieve all of the FORM data submitted
|
86 |
$FORM{$_} = param($_); # Retrieve all of the FORM data submitted
|
| Line 75... |
Line 87... |
| 75 |
|
87 |
|
| 76 |
if ((/^filter/) and ($FORM{$_} ne '')) { # Build a set of filters to apply
|
88 |
if ((/^filter/) and ($FORM{$_} ne '')) { # Build a set of filters to apply
|
| 77 |
my ($filter,$field) = split /-/, $_;
|
89 |
my ($filter,$field) = split /-/, $_;
|
| 78 |
$FILTER->{$field} = $FORM{$_};
|
90 |
$FILTER->{$field} = $FORM{$_} unless notInArray ($field, \@allFields);
|
| 79 |
} elsif ($FORM{$_} eq "true") # Compile list of fields to display
|
91 |
} elsif ($FORM{$_} eq "true") # Compile list of fields to display
|
| 80 |
{ push @displayFields, $_; }
|
92 |
{ push @displayFields, $_; }
|
| Line 109... |
Line 121... |
| 109 |
$FORM{autoload} = 1; # And turn aut0load on by default.
|
121 |
$FORM{autoload} = 1; # And turn aut0load on by default.
|
| 110 |
}
|
122 |
}
|
| 111 |
}
|
123 |
}
|
| Line 112... |
Line 124... |
| 112 |
|
124 |
|
| 113 |
# let's just make sure the columns are in the right order (and there aren't any missing)
|
125 |
# let's just make sure the columns are in the right order (and there aren't any missing)
|
| Line 114... |
Line 126... |
| 114 |
@displayFields = sort byfield uniq @displayFields, @staticFields;
|
126 |
@displayFields = grep { inArray($_, \@allFields) } sort byfield uniq @displayFields, @staticFields;
|
| 115 |
|
127 |
|
| Line 116... |
Line 128... |
| 116 |
# If the field isn't in the displayFields list, then add it to the hideFields list
|
128 |
# If the field isn't in the displayFields list, then add it to the hideFields list
|
| Line 168... |
Line 180... |
| 168 |
$radiobutton = $h->div ({ class=>'autoload' },
|
180 |
$radiobutton = $h->div ({ class=>'autoload' },
|
| 169 |
["Autoload Changes: ",
|
181 |
["Autoload Changes: ",
|
| 170 |
$h->input ({ type=>"radio", name=>'autoload', class=>'accent', value=>1, onClick=>'submit();', checked=>[] }), "On ",
|
182 |
$h->input ({ type=>"radio", name=>'autoload', class=>'accent', value=>1, onClick=>'submit();', checked=>[] }), "On ",
|
| 171 |
$h->input ({ type=>"radio", name=>'autoload', class=>'accent', value=>0, onClick=>'submit();' }), "Off ",
|
183 |
$h->input ({ type=>"radio", name=>'autoload', class=>'accent', value=>0, onClick=>'submit();' }), "Off ",
|
| 172 |
]);
|
184 |
]);
|
| - |
|
185 |
$refreshbutton = "";
|
| 173 |
$sortby = $h->select ({name=>"sortby", onChange=>'submit();' }, [ map { $FORM{sortby} eq $_ ? $h->option ({ value=>$_, selected=>[] }, $NAME{$_}) : $h->option ({ value=>$_ }, $NAME{$_}) } @displayFields ]);
|
186 |
$sortby = $h->select ({name=>"sortby", onChange=>'submit();' }, [ map { $FORM{sortby} eq $_ ? $h->option ({ value=>$_, selected=>[] }, $NAME{$_}) : $h->option ({ value=>$_ }, $NAME{$_}) } @displayFields ]);
|
| 174 |
} else {
|
187 |
} else {
|
| 175 |
$onClick = "";
|
188 |
$onClick = "";
|
| 176 |
$onChange = "";
|
189 |
$onChange = "";
|
| 177 |
$radiobutton = $h->div ({ class=>'autoload' },
|
190 |
$radiobutton = $h->div ({ class=>'autoload' },
|
| Line 263... |
Line 276... |
| 263 |
|
276 |
|
| 264 |
foreach my $t (@ProductList) { # Unt now we print the things!
|
277 |
foreach my $t (@ProductList) { # Unt now we print the things!
|
| 265 |
my @tmprow;
|
278 |
my @tmprow;
|
| 266 |
foreach my $f (@displayFields)
|
279 |
foreach my $f (@displayFields)
|
| - |
|
280 |
{
|
| 267 |
{
|
281 |
$t->{$f} = "" unless $t->{$f}; # HTML::Tiny throws a warning for null fields from the DB, so give it an empty string instead
|
| 268 |
# Look to see if there's a function named modify_<fieldname>() defined for this field
|
282 |
# Look to see if there's a function named modify_<fieldname>() defined for this field
|
| 269 |
no strict;
|
283 |
no strict;
|
| 270 |
if (exists &{"modify_".$f}) {
|
284 |
if (exists &{"modify_".$f}) {
|
| 271 |
$t->{$f} = &{"modify_".$f} ($t);
|
285 |
$t->{$f} = &{"modify_".$f} ($t);
|