#!/usr/bin/perl # # schedule.pl # # This perl script sifts through the UAH class schedule data and outputs # only a small portion of the data - hopefully the precise part the user # is interested in. # # The script presumes that all pertinant segments begin with a # tag and the tag is not split across lines. # # Data before any appears in the document will be # displayed as the header of all pages served. tags # thereafter delimit segments (their starting AND stopping points). # # The script receives a request for a particular segment on its URL # like this example which would list data between the tag # and the next tag: # # http://www.uah.edu/cgi-bin/schedules.pl?file=xxxxx&segment=xxxx # # The default segment is specified in $segment, and it's intended to be # an index to the other segments. # # The data file to be examined will be selected by the user upon the first # call to the script (i.e., one with no arguments). # # AUTHOR # Jim Scarborough # 608-J South Loop Rd. # Huntsville, AL 35805 # (205) 830-4470 # # REVISION HISTORY # 14 Dec 1995 First edition (JS) # 08 Mar 1996 Die a graceful death in case the file isn't there (JHMc) # 02 Apr 1996 Major revision. With the summer term comes the need to # allow a user to query more than one schedule file. Now, # when this script is called with no arguments, it will look # in the defined path at all files with the extension of # .html. When it finds one, look for the line # and construct a hyperlink with that description to # the specified file. (JHMc) # 21 Mar 2001 When sending the initial screen with a list of terms # available, we display then in whatever order Solaris # returns the file names. Let's pretty it up a bit by # displaying in term order instead. (JHMc) # # 17 Oct 2001 Give users a chance to look at old schedule files without # cluttering up the main menu. This depends upon the old # files being moved to the archive dir. Some department # chairs like to have old schedule info available when # scheduling classes for an upcoming term. (JHMc) # # 26 Jul 2002 When Malcolm creates the source files, he includes <pre> # and </pre> tags in case someone wants to load the raw # schedule file in a browser. Because we would sometimes add # our own <pre> tag, we could wind up with a <pre> tag without # a matching </pre> tag. Because this confuses the Opera # browser, just discard any <pre> and </pre> tags we see when # reading a schedule file. (JHMc) # # 12 Aug 2002 Additional tuning of the <pre> tags. Opera does not render # the page correctly unless the <pre> tag follows any <Hx> # tag. Look for the department name <H2> tag that Malcolm # puts in, and insert a <pre> tag after it. # # 18 Mar 2005 The schedule file is now coming from Banner. They are no # longer putting a space at the beginning of each line, so # accommodate that in looking for <H2> tags. Has it really # been almost three years since I last changed this? Wow... # # 13 May 2005 Some very conscientious user pointed out to me that he # was able to read our /etc/passwd file by entering a file= # parameter on the URL that has several ../../ paths in it. # I thought I checked for that. Fixed. # # 20 May 2008 Change logo to UAHuntsville. Gag. # # # $schedpath contains the path to the schedule files... # $schedpath="/webdata/schedules"; # # $segment comtains the name of the default segment of the file to display. # The value will be replaced with the name of the actual segment of the file # to display if one was specified. # $segment="NDX"; # # Get the WWW address of this script # $myurl=$ENV{"SCRIPT_NAME"}; # # The next line *MUST* be printed for the script to work # properly, and it has to be printed first - so here it is before # any real code appears. # print "Content-type: text/html\n\n"; &main; # Call the main routine # # # un_webify deals with arguments from WWW # # # sub un_webify { # Split the name-value pairs @pairs = split(/&/, $ENV{'QUERY_STRING'}); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); # Un-Webify plus signs and %-encoding $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # Stop people from using subshells to execute commands # Not a big deal when using sendmail, but very important # when using UCB mail (aka mailx). # $value =~ s/~!/ ~!/g; # Uncomment for debugging purposes # print "Setting $name to $value<P>"; $ARG{$name} = $value; } # foreach $pair } # un_webify # # # This will sort the <TITLE> tags by term. Assume tags will have values like # UAH: Spring 2001 Course Listing # sub by_term { %TermSortOrder = (Spring,1,Summer,2,Fall,3); # # An incoming record to sort will look something like this: # # UAH: Spring 2000 Course Listing # or # UAH: Summer 2001 1st Mini-Session Course Listing # # Split into fields so can compare year, then term, then whatever is # left (summer terms only) # my @fields1 = split(/ /,$a); my @fields2 = split(/ /,$b); # # Now return the sort value. First value to check will be year. If # they match, try term. If they match (which will happen only for # summer terms), try the 3rd field. # $fields1[2] <=> $fields2[2] # compare the years or $TermSortOrder{$fields1[1]} <=> $TermSortOrder{$fields2[1]} # yr match, do term or $fields1[3] cmp $fields2[3]; # year and term match (summer) do next word }# sub by_term # This will send a menu of all schedule files available. We do this if the # script gets called without a "file=" argument # sub send_menu { # print "<title>UAH: Course Schedule Menu\n"; print " $\"The$ \n"; print "

$descriptor Class Schedules

\n"; print "

$descriptor class schedules available on this web server are:

\n"; print "

\n"; while ($nextname = <$schedpath/*.html>) { # get next .html file # print "the next file is $nextname
\n"; unless (open(SKED,"$nextname")) { # skip if can't open the file $admin = $ENV{"SERVER_ADMIN"}; print "Cannot open file $nextname - notify $admin
\n"; } else { # if I can open the file, continue... $_=; # grab a line chop; while ( ! ( m//) && ($_)) { # is it the <TITLE> line? $_=<SKED>; # no, get next line and loop chop; } # yes, I found the title!!! s/<TITLE>//; # remove title tag s^^^; # remove trailing /title tag s/^\s*//; # remove leading spaces $filename = $nextname; # grab file name we're looking at $filename =~ s^$schedpath/^^; # strip off path # Put values into array to store for later $schedfile{"$_"} = $filename; } # else } # while # # At this point, we have the TITLE tags and filenames in an associative # array, with the TITLE tag as the key. These, we want to sort in a more # term-friendly order. Then retrieve them and construct the links. # @sortedlist = sort by_term keys(%schedfile); foreach $titletag (@sortedlist) { $filename = $schedfile{$titletag}; print "

$titletag
\n"; } # foreach $titletag print "

\n"; # # If not in the archive dir, tell user there may be archived scheds. # If we are in the archive dir, give the user a way to get back to real dir # if($ARG{"dir"}) { print"

Back to Current Schedules
\n"; } else { if (-d "$schedpath/archived") { print"

Archived schedules can be found here

\n"; } # Here, we are still printing the "main" menu page. Put some # extra links requested by Enrollment Services print <<_EOF_;

Important Registration Information, Dates and Deadlines for Students

\n"; print "Fall
\n"; print "
\n"; print "Spring
\n"; print "
\n"; print "Summer
\n"; print "

_EOF2_ } } #sub send_menu # # Print out environment variables and the likes to keep track # of what's going on... # sub debug_env { foreach (keys (%ARG)) { print "$_ = $ARG{$_}
\n"; } print "$myurl
"; } # debug_env # # Main Processing Starts Here ****************************** # sub main { &un_webify; # get arguments off the URL # &debug_env; $descriptor = "Current"; if ($ARG{"dir"}) { # # Make sure that the argument doesn't have any shell metachars # my $dir = $ARG{"dir"}; my $value = $dir; $value =~ tr/A-Za-z0-9._-/ /cs; # strip all but legal filename chars if (! ($value eq $dir)) { # bad char found print"An invalid character was found in the requested dir name\n"; die; } $schedpath = $schedpath . "/" . $ARG{"dir"}; $descriptor = "Archived"; $urlappenddir = "&dir=" . $ARG{"dir"}; } $schedfile=$ARG{"file"}; # get the file to work on if ( ! $schedfile) { # did a file name get passed? &send_menu; # no, must be top level call. Send menu... exit; # ...and exit } # check for illegal attempt to traverse directories... $value = $schedfile; $value =~ tr/A-Za-z0-9._-/ /cs; # strip all but legal filename chars if (! ($value eq $schedfile)) { # bad char found print"An invalid character was found in the requested filename\n"; die; } $tmp= $ARG{"segment"}; # get which department to look at $segment=$tmp if ($tmp); # if there was a dep't specified, use it $schedule="$schedpath/$schedfile"; # prepend the path # print "About to open $schedule
\n"; # debug unless (open(SKED, "$schedule")) { # good return from open attempt? print "Unable to access the schedule file...script terminated\n"; print "
Attempted to open $schedule \n"; print "
Please notify the webmaster....thanks!\n"; die } # display the header (which is everything up to the first # tag). while (( ! ( m//i ))) { print; $_=; } # Skip over segments that don't have the name we're looking for while (( ! ( m//i )) && ($_)) { $_=; if (/

/i || /<\/pre>/i) { $_= } # skip pre tags in source
   }

   print;   # print out the tag in question
   if ($segment eq "NDX")  { print"\n" }
   $_=;  # go on to the next line
   if (//i || /<\/pre>/i) { $_= } # skip pre tags in source

   # Print everything up to the next  tag.
   while (( ! ( m//i )) && ($_)) {
       s!!\n"; # yes, print a  tag (fix Opera problem)
       }
       $_=;
       if (//i || /<\/pre>/i) { $_= } # skip pre tags in source
   }

   print "\n"; # End preformatted text
   $urlappenddir =~ s/&//;  # dont need the ampersand in the following URL
   print "Back to index of schedules
\n";
   close(SKED);  # close the schedule file
} # main