Source Code
#!/usr/local/bin/perl -w
########################################################################
#
# rooms.cgi : "Group study room schedule"
#
# Version: 0.1 for Unix
#
# Created by Michael Doran
# doran@uta.edu
# 817-272-5326
#
# University of Texas at Arlington Libraries
# Box 19497, Arlington, TX 76019, USA
#
# This script queries the Voyager database and
# displays a one day schedule of the group study
# rooms that can be reserved via Short Loans.
#
########################################################################
use strict;
use DBI;
use Date::Calc qw(Add_Delta_Days);
# Some useful environment variables
my $this_script = "/cgi-bin/rooms.cgi";
######################################################
# Voyager Oracle database parameters
#
$ENV{ORACLE_SID} = "LIBR";
$ENV{ORACLE_HOME} = "/oracle/app/oracle/product/8.0.5";
my $username = "xxxxxx";
my $password = "xxxxxx";
my $db_name = "xxxdb";
######################################################
# Read in and parse the form parameters
#
&ReadParse;
my %formdata;
# This value should be an integer that indicates
# how may days from today's date you want info
# on room reservations.
my $date_offset = $formdata{'date'};
######################################################
# Calculations to output a date formatted for use in
# the SQL query and a formatted for display as a page
# header.
my ($sec, $min, $hour, $mday, $mon, $year,
$wday, $yday, $isdat) = localtime(time);
my $today_year = $year;
my $today_mon = $mon;
my $today_mday = $mday;
if ($date_offset && ($date_offset =~ /^[1]*?[0-9]{1}$/)) {
$date_offset = "+" . $date_offset;
($year, $mon, $mday)
= Add_Delta_Days($year, $mon, $mday, $date_offset);
}
$mon += 1;
$mon = sprintf("%02d", $mon);
my $mpday = sprintf("%02d", $mday);
$year += 1900;
my $sql_date = "$year$mon$mpday";
my %months = ('01' => 'Jan', '02' => 'Feb', '03' => 'Mar',
'04' => 'Apr', '05' => 'May', '06' => 'June',
'07' => 'July','08' => 'Aug', '09' => 'Sept',
'10' => 'Oct', '11' => 'Nov', '12' => 'Dec');
sub TextMonth {
my ($mon) = @_;
my %months = ('01' => 'Jan', '02' => 'Feb', '03' => 'Mar',
'04' => 'Apr', '05' => 'May', '06' => 'June',
'07' => 'July','08' => 'Aug', '09' => 'Sept',
'10' => 'Oct', '11' => 'Nov', '12' => 'Dec');
foreach my $month_number (keys (%months)){
if ($mon == $month_number) {
return($months{$month_number});
}
}
}
my $display_date = &TextMonth($mon). " $mday";
my (%sams_a,%sams_a_charge,
%sams_b,%sams_b_charge,
%room_414,%room_414_charge,
%room_417,%room_417_charge);
print "Content-type: text/html\n\n";
&PrintInc ("./rooms/head.inc");
&DoQuery;
&PrintTop($display_date);
&PrintTable;
print qq(</table>\n\n);
&PrintInc ("./rooms/tail.inc");
sub DoQuery {
# Connect to Oracle database
my $dbh = DBI->connect('dbi:Oracle:', $username, $password)
|| die "Could not connect: $DBI::errstr";
# Prepare the SQL statement
my $sth = $dbh->prepare(&ConstructReserveSQL)
|| die $dbh->errstr;
# Run the SQL query
$sth->execute
|| die $dbh->errstr;
while( my (@entry) = $sth->fetchrow_array() ) {
my $room = $entry[0];
my $time_start = $entry[1];
my $time_end = $entry[2];
if ($room) {
$room =~ s/Group Study Room Key//;
if ($room =~ /Sam's A/) {
$sams_a{$time_start} = $time_end;
} elsif ($room =~ /Sam's B/) {
$sams_b{$time_start} = $time_end;
} elsif ($room =~ /414/) {
$room_414{$time_start} = $time_end;
} elsif ($room =~ /417/) {
$room_417{$time_start} = $time_end;
}
}
}
$sth->finish;
# Prepare the SQL statement
$sth = $dbh->prepare(&ConstructChargeSQL)
|| die $dbh->errstr;
# Run the SQL query
$sth->execute
|| die $dbh->errstr;
while( my (@entry) = $sth->fetchrow_array() ) {
my $room = $entry[0];
my $time_start = $entry[1];
my $time_end = $entry[2];
if ($room) {
$room =~ s/Group Study Room Key//;
if ($room =~ /Sam's A/) {
$sams_a_charge{$time_start} = $time_end;
} elsif ($room =~ /Sam's B/) {
$sams_b_charge{$time_start} = $time_end;
} elsif ($room =~ /414/) {
$room_414_charge{$time_start} = $time_end;
} elsif ($room =~ /417/) {
$room_417_charge{$time_start} = $time_end;
}
}
}
$sth->finish;
$dbh->disconnect;
}
sub PrintTable {
my $column_head;
my %reserved_slots;
print qq(
<table cellpadding="3" border="1">
<tr>
<th rowspan="2">Time Slot</th>
<th colspan="4">Room</th>
</tr>\n <tr>\n);
foreach my $room ("Sam's A", "Sam's B", "Room 414A", "Room 417") {
print qq( <th width="90">$room</th>\n);
}
print qq( </tr>\n);
# Take out the early morning time slots, which according
# to the policy, can't be reserved anyway.
# my @time_slots = ('00', '01', '02', '03', '04', '05',
my @time_slots = ('06', '07', '08', '09', '10', '11',
'12', '13', '14', '15', '16', '17',
'18', '19', '20', '21', '22', '23');
foreach my $slot (@time_slots) {
my ($start_slot,$slot_plus,$end_slot,$display_start_slot,$display_end_slot);
$slot_plus = "$slot" + 1;
$slot_plus = sprintf("%02d", $slot_plus);
$start_slot = "$mon$mpday$slot";
$end_slot = "$mon$mpday$slot_plus";
if ($slot < '12') {
$display_start_slot = "$slot:00am";
} elsif ($slot == '12') {
$display_start_slot = "$slot:00pm";
} else {
$slot -= 12;
$slot = sprintf("%02d", $slot);
$display_start_slot = "$slot:00pm";
}
if ($slot_plus < '12') {
$display_end_slot = "$slot_plus:00am";
} elsif ($slot_plus == '12') {
$display_end_slot = "$slot_plus:00pm";
} else {
$slot_plus -= 12;
$slot_plus = sprintf("%02d", $slot_plus);
$display_end_slot = "$slot_plus:00pm";
}
print qq( <tr>\n <td>$display_start_slot-$display_end_slot</td>\n);
my $color_free = "#eeeeee";
my $text_free = " ";
my $color_reserved = "#bbbbbb";
my $text_reserved = "Reserved";
my $color_charged = "#bbbbbb";
my $text_charged = "In Use";
my $cell_color = $color_free;
my $cell_text = $text_free;
if (%sams_a) {
foreach my $reserve_start (keys (%sams_a)) {
my $reserve_end = $sams_a{$reserve_start};
if (($reserve_start <= $start_slot) &&
($reserve_end >= $end_slot)) {
$cell_color = $color_reserved;
$cell_text = $text_reserved;
last;
}
}
}
if (%sams_a_charge) {
foreach my $reserve_start (keys (%sams_a_charge)) {
my $reserve_end = $sams_a_charge{$reserve_start};
if (($reserve_start <= $start_slot) &&
($reserve_end >= $end_slot)) {
$cell_color = $color_charged;
$cell_text = $text_charged;
last;
}
}
}
print qq( <td align="center" bgcolor="$cell_color"> $cell_text </td>\n);
$cell_color = $color_free;
$cell_text = $text_free;
if (%sams_b) {
foreach my $reserve_start (keys (%sams_b)) {
my $reserve_end = $sams_b{$reserve_start};
if (($reserve_start <= $start_slot) &&
($reserve_end >= $end_slot)) {
$cell_color = $color_reserved;
$cell_text = $text_reserved;
last;
}
}
}
if (%sams_b_charge) {
foreach my $reserve_start (keys (%sams_b_charge)) {
my $reserve_end = $sams_b_charge{$reserve_start};
if (($reserve_start <= $start_slot) &&
($reserve_end >= $end_slot)) {
$cell_color = $color_charged;
$cell_text = $text_charged;
last;
}
}
}
print qq( <td align="center" bgcolor="$cell_color"> $cell_text </td>\n);
$cell_color = $color_free;
$cell_text = $text_free;
if (%room_414) {
foreach my $reserve_start (keys (%room_414)) {
my $reserve_end = $room_414{$reserve_start};
if (($reserve_start <= $start_slot) &&
($reserve_end >= $end_slot)) {
$cell_color = $color_reserved;
$cell_text = $text_reserved;
last;
}
}
}
if (%room_414_charge) {
foreach my $reserve_start (keys (%room_414_charge)) {
my $reserve_end = $room_414_charge{$reserve_start};
if (($reserve_start <= $start_slot) &&
($reserve_end >= $end_slot)) {
$cell_color = $color_charged;
$cell_text = $text_charged;
last;
}
}
}
print qq( <td align="center" bgcolor="$cell_color"> $cell_text </td>\n);
$cell_color = $color_free;
$cell_text = $text_free;
if (%room_417) {
foreach my $reserve_start (keys (%room_417)) {
my $reserve_end = $room_417{$reserve_start};
if (($reserve_start <= $start_slot) &&
($reserve_end >= $end_slot)) {
$cell_color = $color_reserved;
$cell_text = $text_reserved;
last;
}
}
}
if (%room_417_charge) {
foreach my $reserve_start (keys (%room_417_charge)) {
my $reserve_end = $room_417_charge{$reserve_start};
if (($reserve_start <= $start_slot) &&
($reserve_end >= $end_slot)) {
$cell_color = $color_charged;
$cell_text = $text_charged;
last;
}
}
}
print qq( <td align="center" bgcolor="$cell_color"> $cell_text </td>\n);
print qq( </tr>\n);
}
}
sub RunThroughArray {
my ($start_slot,$end_slot,%passed_array) = @_;
foreach my $reserve_start (keys (%passed_array)) {
my $reserve_end = $passed_array{$reserve_start};
if (($reserve_start <= $start_slot) &&
($reserve_end >= $end_slot)) {
print qq( <td align="center" bgcolor="red"> Reserved </td>\n);
} else {
print qq( <td align="center" bgcolor="#eeeeee"> Free </td>\n);
}
}
}
sub ConstructReserveSQL {
return ("
select
$db_name.bib_text.title,
to_char($db_name.short_loan.start_time,'MMDDHH24'),
to_char($db_name.short_loan.end_time, 'MMDDHH24')
from
$db_name.bib_text,
$db_name.short_loan
where
$db_name.bib_text.bib_id = $db_name.short_loan.bib_id and
(to_char($db_name.short_loan.start_time,'YYYYMMDD') = $sql_date or
to_char($db_name.short_loan.end_time, 'YYYYMMDD') = $sql_date)
");
}
sub ConstructChargeSQL {
return ("
select
$db_name.bib_text.title,
to_char($db_name.circ_transactions.charge_date, 'MMDDHH24'),
to_char($db_name.circ_transactions.current_due_date, 'MMDDHH24')
from
$db_name.bib_text,
$db_name.bib_item,
$db_name.item,
$db_name.circ_transactions
where
$db_name.bib_text.bib_id = $db_name.bib_item.bib_id and
$db_name.bib_item.item_id = $db_name.item.item_id and
$db_name.item.item_id = $db_name.circ_transactions.item_id and
$db_name.item.item_type_id = '17'
");
}
############################################################
# FutureDaysForm
############################################################
#
sub FutureDaysForm {
my ($today_year,$today_mon,$today_mday) = @_;
my $form_html = qq(\n\n<form name="SelectDay" method="post" action="$this_script">\n);
$form_html .= qq( Get schedule for:\n);
$form_html .= qq( <select onChange="document.forms['SelectDay'].submit()" name="date">\n);
my $selected = "";
foreach my $i (0,1,2,3,4,5,6,7,8,9,10,11,12,13) {
my ($year, $mon, $mday)
= Add_Delta_Days($today_year, $today_mon, $today_mday, $i);
$date_offset =~ s/[\+\-]//;
if ($date_offset == $i){
$selected = qq(selected="selected");
}
$mon += 1;
my $text_month = &TextMonth($mon);
$form_html .= qq( <option $selected value="$i">$text_month $mday</option>\n);
$selected = "";
};
$form_html .= qq( </select>\n);
# Apparently can't have onChange submit *and* a submit button.
# $form_html .= qq( <input type="submit" name="submit" value="Get Schedule">\n);
$form_html .= qq(</form>\n);
return($form_html);
}
############################################################
# PrintInc
############################################################
#
# Prints "include" files.
# Usage: &PrintInc ("./relative-path-to/somefile.inc");
sub PrintInc {
my ($inc_file) = @_;
open (INCLUDE, "$inc_file") || die "Can't open file.\n";
while (<INCLUDE>) {
print;
}
close (INCLUDE);
}
############################################################
# PrintTop
############################################################
#
sub PrintTop {
my ($display_date) = @_;
print qq(
<h1>Enhanced Group Study Rooms</h1>
<h2>Schedule for $display_date</h2>);
print &FutureDaysForm($today_year,$today_mon,$today_mday);
}
##########################################################
# ReadParse
##########################################################
#
# ReadParse reads in and parses the CGI input.
# It reads / QUERY_STRING ("get" method)
# \ STDIN ("post" method)
sub ReadParse {
my ($meth, $formdata, $pair, $name, $value);
# Retrieve useful ENVIRONMENT VARIABLES
$meth = $ENV{'REQUEST_METHOD'};
# If method unspecified or if method is GET
if ($meth eq '' || $meth eq 'GET') {
# Read in query string
$formdata = $ENV{'QUERY_STRING'};
}
# If method is POST
elsif ($meth eq 'POST') {
read(STDIN, $formdata, $ENV{'CONTENT_LENGTH'});
}
else {
die "Unknown request method: $meth\n";
}
# name-value pairs are separated and put into a list array
my @pairs = split(/&/, $formdata);
foreach $pair (@pairs) {
# names and values are split apart
($name, $value) = split(/=/, $pair);
# pluses (+'s) are translated into spaces
$value =~ tr/+/ /;
# hex values (%xx) are converted to alphanumeric
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# The code below attempts to ferret out shell meta-characters
# in the form input. It replaces them with spaces.
# looking for the presence of shell meta-characters in $name
$name =~ s/[{}\!\$;><&\*'\|]/ /g;
# looking for the presence of shell meta-characters in $value
$value =~ s/[{}\!\$;><&\*'\|]/ /g;
# associative array of names and values created
$formdata{$name} = $value;
}
}