#!/usr/bin/perl # ****S4.pl**** # 4/26/01 1:31PM # This program is called from (RRS_validate.htm). It first checks the # the validity of the password passed by the source HTML document. Next, # a table is constructed, showing current service submissions. Each table # has a reference key assigned from the database which is used as part of a link # and data parameter. This information is used by the ( ) program to change the # status of a requisition use CGI qw/:standard/; use Win32::ODBC; print header, start_html('S-4 RRS Management'), h1(''); if (param()) { my $response = param('ACTION'); my $record = param('REQ'); my $valid = 0; if ($response eq "NONE") { $valid = validate(param('PASSWORD')); if ($valid == 0) { print h1('
Invalid Password!
'); die ("Aborted"); } } display_intro(); handle_response($response, $record); generate_table(); } # validate the password passed to the program sub validate { my $compare = shift; if ($compare eq "s4admin") { return(1); } else { return(0); } } # display information table to user sub generate_table { print "
"; print "
UNITID#TYPEQTYUNITSPURPOSEREPORT DATEREPORT TIMEPENDINGAPPROVEDCANCEL"; my ($database) = new Win32::ODBC('RRS'); $database->Sql("SELECT * FROM REQUESTS"); while ($database->FetchRow()) { my (%data) = $database->DataHash(); my $id = $data{'ID'}; print "
$data{'UNIT'}"; # Here docs (EOT) must be terminated without tabs, hence the identention error! print <<"EOT"; $id EOT print "$data{'TYPE'}"; print "$data{'QTY'}"; print "$data{'UNITS'}"; print "$data{'PURPOSE'}"; print "$data{'REPORTDATE'}"; print "$data{'REPORTTIME'}"; print "$data{'PENDING'}"; print "$data{'APPROVED'}"; print "$data{'CANCEL'}"; } print "
"; $database->Close(); } sub display_intro { print h1('
S-4 Management Screen for the RRS
'), hr, h3('
To manipulate a request, click on the link provided in the table below.'); } sub handle_response { my $response = shift; my $record = shift; if ($response eq "APPROVE") { approve($record); return; } elsif ($response eq "PEND") { pend($record); return; } elsif ($response eq "REMOVE") { remove($record); return; } else { cancel($record); return; } } sub approve { my $record = shift; my ($database) = new Win32::ODBC('RRS'); if ($database->Sql("UPDATE REQUESTS SET APPROVED='TRUE', CANCEL='FALSE', PENDING='FALSE' WHERE ID=$record")) { print "something went wrong " . $database->Error(); } $database->Close(); return; } sub pend { my $record = shift; my ($database) = new Win32::ODBC('RRS'); $database->Sql("UPDATE REQUESTS SET CANCEL = 'FALSE', PENDING = 'TRUE', APPROVED = 'FALSE' WHERE ID = $record"); $database->Close(); return; } sub cancel { my $record = shift; my ($database) = new Win32::ODBC('RRS'); $database->Sql("UPDATE REQUESTS SET CANCEL = 'TRUE', PENDING = 'FALSE', APPROVED = 'FALSE' WHERE ID = $record"); $database->Close(); return; } sub remove { my $record = shift; my ($database) = new Win32::ODBC('RRS'); $database->Sql("DELETE FROM REQUESTS WHERE ID = $record"); $database->Close(); return; }