[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1883
  • Last Modified:

IIS7 500 Error with certain CGI Perl script, racking my brain for days!

Let me try starting at the beginning and hopefully it'll all make some sense and I won't forget much info.

Running Win2k8 SP1 with IIS7, ActiveState Perl 5.10.0.1004.  I've added script handler mapping for *.pl and *.cgi files.  

The following code works fine:

#!e:/perl/bin/perl
# hello.pl  - sends a greeting to the world
#

use Cwd;

$currentDir = getcwd();
# Live or Working
#$currentDir =~ /cgi-bin/;
#$live_or_working = $`;
$live_or_working = $currentDir;
print "Content-type: text/html\n\n";      # Send the header describing
                  # the MIME content type
print "<HTML>\n";            # The HTML element
print "<HEAD><TITLE>\n";            # The mandatory HTML head element
                  # and title element
print "Hello!\n";            # This is the title, used to
                  # distinguish between web pages
print "</TITLE></HEAD>\n";      # Terminate the HTML title and
print "<BODY>\n";            # body element

                  # head elements
print "Hello, world!\n<BR>\n<BR>";      # The print statement sends
                  # characters to the standard output
                  # with our actual message

print "Current Working directory is:->$live_or_working<-\n";

print "</BODY></HTML>\n";      # Terminate the HTML body and
                  # html elements
______________________________________________________________

But I get an HTTP 500 Internal Server Error when trying to run this:

app.pl:

#!/usr/bin/perl

use CGI::Carp qw(fatalsToBrowser);
use UGDBApp;

my $dbapp = UGDBApp->new();
$dbapp->run();

UGDBApp.pm:
#!/usr/bin/perl
#
# UGDBApp.pm
#
# This package encapsulates all server-side functionality of the
# Undergrad DB: interacting with the database, handling user
# interaction, and feeding output to the user with templated HTML.
#
# The fairly standard CGI::Application module is employed to organize
# the application into "run modes", and better manage data that must
# be persistent across multiple modes (i.e., session information).
#
# The thought has occurred to me to break down the application into
# separate modules, but it's looking like that won't really be
# necessary; however, I will probably externalize specific DB utility
# functions (inserting/selecting a student record, for example), since
# they can be quite messy.
#

package UGDBApp;

use CGI::Carp qw(fatalsToBrowser);

use strict;
use base 'CGI::Application';
use DBI;
use DBD::ODBC;
use Digest::MD5;
use POSIX qw/ceil strftime/;
use Spreadsheet::WriteExcel;
use Template;
use Cwd;
use File::Basename;

####################################################################
# Set global variables here
####################################################################
      
# Get root directory and format for web use.
# This will allow both the testing and
# live directories to use the same code.
my $currentDir = getcwd();
my($filename, $directories, $suffix) = fileparse($currentDir);
my $rootDir = basename($directories);

####################################################################
####################################################################
##      
## Utility/administrative routines
##
## These are all called internally, but are not used as actual
## modes/screens in the CGI application.
##
####################################################################
####################################################################

####################################################################
sub setup
####################################################################
# Initial application setup, called during object construction.
#
# This configures the CGI::Application object, specifying the
# different run modes and opening our database connection.
# Also we configure a new Template object for use with all of the
# run modes.
####################################################################
{
      my $self = shift;

      # Set starting mode to the login screen
      $self->start_mode('main');
      
      # Name the variable that will contain the current mode name
      $self->mode_param('appmode');
      
      # Here we give CGI::Application our list of possible run modes.
      # Each of these represents a "screen" with which the user will
      # be presented.
      $self->run_modes(
            # This is the login screen.
            'login'            => 'do_login',

            # Verifies login.  Redirect to login screen (with error) or main screen (on success).
            'login_verify'      => 'do_login_verify',

            # Main screen.
            'main'            => 'do_main',
            
            # Main switch mode.  Branches from main to other modes interactively.
            # Dummy mode, when cgiapp_prerun() sees this as the current mode, it uses
            # the new_mode param to determine the actual new mode, which it then sets
            # with prerun_mode.
            'main_switch'      => 'do_main_switch',
            
            # Add Student form
            'add_pre'      => 'do_add_pre',
            
            # Change Password form
            'passwd'      => 'do_passwd',

            # View Student
            'view'            => 'do_view',
            
            # Search form
            'search_pre'      => 'do_search_pre',
            
            # Search results
            'search'      => 'do_search',
            
            # Report generation
            'report'      => 'do_report',

            # Dummy mode names; these "modes" are just handled by cgiapp_prerun
            'add'            => '',
            'chpass'      => '',
            'logout'      => '',
            'update'      => 'handle_update',
            'termgpa'      => '',
            'comments'      => '',
            'awards'      => '',
      );

      my $dbh = DBI->connect("DBI:ODBC:UndergradDB","undergraddb","*********",{RaiseError=>1}) or die "Database connection not made: $DBI::errstr";

      $self->param('mydbh' => $dbh);
      $dbh->{LongReadLen} = 10 * 1024 * 1024;
      # Configuration for a Template object
      my $config = {
            INCLUDE_PATH => '..',
      };

      my $template = Template->new($config);
      $self->param('template' => $template);
 }

####################################################################
sub teardown
####################################################################
# Called during the destruction of our Application object.
# This closes the database connection.
####################################################################
{
      my $self = shift;
      
      # Close the database connection.
      $self->param('mydbh')->disconnect();
}

####################################################################
sub validate_session
####################################################################
# Verifies that the globally stored uid/sid pair is valid.
# If not, the user is taken to an error page.
# If so, the sub returns, letting the caller finish.
#
# This should be called ONLY by the cgiapp_prerun method, as it
# changes the run mode with prerun_mode.
####################################################################
{
      my $self = shift;
      
      # Grab the database connection handle
      my $dbh  = $self->param('mydbh');

      # Try to grab the record from the sessions table
      my $sth = $dbh->prepare('SELECT * FROM U00_SESSIONS WHERE ID_USER = ? AND TAG = ?');
      $sth->execute($self->param('uid'), $self->param('sid'));
      my $row_ref  = $sth->fetchrow_hashref();
      my $result   = defined $row_ref;
      my $old_time = $row_ref->{'LAST_ACCESS_TIME'};
      $sth->finish();

      # Session didn't exist.  Take to login screen
      if(!$result) {
            $self->prerun_mode('login');
      }
      # Session exists, test age
      else {
            # More than an hour has passed.  Timeout!
            if(time > ($old_time + 3600)) {
                  # Delete session record
                  my $sth = $dbh->prepare('DELETE FROM U00_SESSIONS WHERE TAG = ?');
                  $sth->execute($self->param('sid'));
                  $sth->finish();
                  
                  # Take user to login screen with error
                  $self->param('login_error' => 'Session timed out');
                  $self->prerun_mode('login');
            }
      }
      
      # At this point, the session exists and is not timed out,
      # so we can update the last access time and continue with the
      # current run-mode.
      $sth = $dbh->prepare('UPDATE U00_SESSIONS SET LAST_ACCESS_TIME = ? WHERE TAG = ?');
      $sth->execute(time, $self->param('sid'));
      $sth->finish();
}


####################################################################
sub cgiapp_prerun
####################################################################
# Called by Application before entering a run-mode.  We just verify
# that the user has logged in and that their session is valid.
####################################################################
{
      my $self = shift;

      my $q = $self->query();

      # Don't attempt validation in login_verify mode.
      return if $self->get_current_runmode() eq 'login_verify';

      # No uid or sid set, take user to login screen.
      if(!$self->param('uid') or !$self->param('sid')) {
            $self->prerun_mode('login');
      }
      
      # Validate the uid/sid pair
      validate_session($self);

      $self->param('username' => $q->param('username'));
        $self->param('admin' => $q->param('ADMIN'));
      $self->param('jumpanchor' => '');

      if ($self->get_current_runmode() eq 'main_switch') {
            # Handle add appropriately.
            if ($q->param('new_mode') eq 'add') {
                  handle_add($self);
                  $self->prerun_mode('main');
            }
            # Handle search
            elsif ($q->param('new_mode') eq 'search') {
                  $self->prerun_mode('search');
            }
            # Handle report generation
            elsif ($q->param('new_mode') eq 'report') {
                  $self->prerun_mode('report');
            }
            # Change password
            elsif ($q->param('new_mode') eq 'chpass') {
                  $self->prerun_mode('main') if !handle_chpass($self);
            }
            # Logout mode
            elsif ($q->param('new_mode') eq 'logout') {
                  handle_logout($self);
                  $self->prerun_mode('login');
            }
            # Update mode
            elsif ($q->param('new_mode') eq 'update') {
                  handle_update($self);
                  $self->prerun_mode('view');
            }
            # Delete student
            elsif ($q->param('new_mode') eq 'delete') {
                  handle_delete($self);
                  $self->prerun_mode('main');
            }
            # Per-term GPAs
            elsif ($q->param('new_mode') eq 'termgpa') {
                  handle_termgpa($self);
                  $self->param('jumpanchor' => '#GPAS');
                  $self->prerun_mode('view');
            }
            # Add comment mode
            elsif ($q->param('new_mode') eq 'comments') {
                  handle_comments($self);
                  $self->param('jumpanchor' => '#COMMENTS');
                  $self->prerun_mode('view');
            }
            # Add award
            elsif ($q->param('new_mode') eq 'awards') {
                  handle_awards($self);
                  $self->param('jumpanchor' => '#AWARDS');
                  $self->prerun_mode('view');
            }
            # Delete GPA
            elsif ($q->param('new_mode') eq 'del_gpa') {
                  handle_del_gpa($self);
                  $self->param('jumpanchor' => '#GPAS');
                  $self->prerun_mode('view');
            }
            # Delete award
            elsif ($q->param('new_mode') eq 'del_awd') {
                  handle_del_awd($self);
                  $self->param('jumpanchor' => '#AWARDS');
                  $self->prerun_mode('view');
            }
            # Delete comment
            elsif ($q->param('new_mode') eq 'del_com') {
                  handle_del_com($self);
                  $self->param('jumpanchor' => '#COMMENTS');
                  $self->prerun_mode('view');
            }
            # Edit GPA
            elsif ($q->param('new_mode') eq 'edit_gpa') {
                  handle_edit_gpa($self);
                  $self->param('jumpanchor' => '#GPAS');
                  $self->prerun_mode('view');
            }
            # Edit award
            elsif ($q->param('new_mode') eq 'edit_awd') {
                  handle_edit_awd($self);
                  $self->param('jumpanchor' => '#AWARDS');
                  $self->prerun_mode('view');
            }
            # Edit comment
            elsif ($q->param('new_mode') eq 'edit_com') {
                  handle_edit_com($self);
                  $self->param('jumpanchor' => '#COMMENTS');
                  $self->prerun_mode('view');
            }
            # All other cases act as a simple prerun redirect.
            else {
                  $self->prerun_mode($q->param('new_mode')) if
                        $self->get_current_runmode() eq 'main_switch';
            }
      }
}

####################################################################
sub cgiapp_postrun
####################################################################
# Post-processing, pre-output filter.
# Appends footer.html to the output.
####################################################################
{
      my $self = shift;
      my $q = $self->query();

      # no header/footer for printable report
      return if ($self->get_current_runmode() eq 'report') and ( $q->param('Print') or $q->param('PeopleSoft') );
            
      my $output_ref = shift;
      my $vars = {
            'APPMODE'      => $self->param('next_runmode'),
            'USERNAME'      => $self->param('username'),
            'TITLEPREFIX'      => $self->param('titleprefix'),
            'ROOTDIR'      => $rootDir
      };

      my $template;
      my ($header, $footer);
      $template = $self->param('template');
      $template->process('header.html', $vars, \$header);
      $template->process('footer.html', $vars, \$footer);

      my $output = $header . $$output_ref . $footer;
      $$output_ref = $output;
}

####################################################################
####################################################################
##
## Screens
##
####################################################################
####################################################################


####################################################################
sub do_login
####################################################################
# Displays the login screen.  Uses login.html.
####################################################################
{
      my $self = shift;

      my $q = $self->query();

      my $vars = {
            'ERROR_MESSAGE'      => $self->param('login_error'),
      };
      
      # If a login error message was set before, empty it.
      $self->param('login_error' => '');

      my $template = $self->param('template');
      my $output;
      $template->process('login.html', $vars, \$output);

      $self->param('next_runmode' => 'login_verify');

      return $output;
}

####################################################################
sub do_login_verify
####################################################################
# Verifies the username/password pair.  If the password or username
# is not found in the users table, we display an error page.
# Otherwise, we jump to main mode.
####################################################################
{
      my $self = shift;
      
      my $q = $self->query();
      
      # Get database connection handle
      my $dbh = $self->param('mydbh');
      my $username = $q->param('username');

      # Find user record in database
      my $sth = $dbh->prepare('SELECT * FROM U00_USERS WHERE USERNAME = ?');
      $sth->execute($username);
      my $row = $sth->fetchrow_hashref();
      if(!$row) {
            # Display the login screen with an error
            # Note that we are technically still in login_verify mode,
            # but we output the login mode screen anyway.  It gets
            # the job done.
            $self->param('login_error'  => 'Invalid username or password.');
            $self->param('next_runmode' => 'login_verify');
            return do_login($self);
      }
      
      # Get MD5 digest of given password
      my $md5 = Digest::MD5->new();
      $md5->add($q->param('password'));
      my $digest = $md5->b64digest;

      # Compare new and stored digests
      if($digest ne $row->{'PASSWORD'}) {
            # Display login screen with error.
            $self->param('login_error' => 'Invalid username or password.');
            $self->param('next_runmode' => 'login_verify');
            return do_login($self);
      }

      # Grab the user ID and finish the query
      my $uid = $row->{'ID_USER'};
      $sth->finish();
      
      # Create a new session for the user
      my $sid  = sprintf '%.13d-%.13d', ceil(rand(2 ** 31)), ceil(rand(2 ** 31));
      my $time = time;
      $sth = $dbh->prepare('INSERT INTO U00_SESSIONS (ID_USER, LAST_ACCESS_TIME, TAG) VALUES (?, ?, ?)');
      $sth->execute($uid, $time, $sid);
      $sth->finish();

      # Store uid, sid and username as global parameters of our CGI app
      $self->param('uid' => $uid);
      $self->param('sid' => $sid);
      $self->param('username' => $username);

      # Display main mode
      return do_main($self);
}

####################################################################
sub do_main
####################################################################
# Main application view.  Uses main.html.
####################################################################
{
      my $self = shift;
      
      my $q = $self->query();

      # Get database connection handle
      my $dbh = $self->param('mydbh');

      my $list_mode = 'C';
      if( $q->param( 'ID_MISC' ) ) {
            $list_mode = $q->param( 'ID_MISC' );
      }

      my $sth;
      if( $list_mode eq 'G' ) {
            $sth = $dbh->prepare( "SELECT * FROM S00_STUDENTS WHERE GRADUATED = 'Y' ORDER BY LAST_NAME, FIRST_NAME" );
      }
      elsif( $list_mode eq 'T' ) {
            $sth = $dbh->prepare( "SELECT * FROM S00_STUDENTS WHERE TRANSFERRED_OUT = 'Y' ORDER BY LAST_NAME, FIRST_NAME" );
      }
      elsif( $list_mode eq 'I' ) {
                  $sth = $dbh->prepare( "SELECT * FROM S00_STUDENTS WHERE TRANSFERRED_IN = 'Y'  ORDER BY LAST_NAME, FIRST_NAME" );
      }
      elsif( $list_mode eq 'D' ) {
            $sth = $dbh->prepare( "SELECT * FROM S00_STUDENTS WHERE DISMISSAL = 'Y' ORDER BY LAST_NAME, FIRST_NAME" );
      }
      elsif( $list_mode eq 'S' ) {
            $sth = $dbh->prepare( "SELECT * FROM S00_STUDENTS WHERE SUSPENSION = 'Y' ORDER BY LAST_NAME, FIRST_NAME" );
      }
      else {
            $list_mode = 'C';
            $sth = $dbh->prepare( "SELECT * FROM S00_STUDENTS WHERE GRADUATED <> 'Y' AND TRANSFERRED_OUT <> 'Y' AND DISMISSAL <> 'Y'  AND SUSPENSION <> 'Y' ORDER BY LAST_NAME, FIRST_NAME" );
      }
      $sth->execute;
      my @students = ();
      while(my $hr = $sth->fetchrow_hashref) {
            my %hash = %$hr;
            push @students, \%hash if $hr->{'DELETED'} ne 'Y';
      }
      $sth->finish;
      
      my $sth = $dbh->prepare('SELECT * FROM U00_USERS WHERE USERNAME = ?');
      $sth->execute($self->param('username'));
      my $is_admin = '0';
      while(my $hr = $sth->fetchrow_hashref()) {
            $is_admin = '1' if $hr->{'ADMIN'} eq 'Y'
      }
        $self->param('admin' => $is_admin);

      my $break = $students[@students / 2]->{'ID_STUDENT'};
      my $vars = {
            'USERNAME'            => $self->param('username'),
            'STUDENTS'            => \@students,
            'ID_BREAK_STUDENT'      => $break,
            'LIST_MODE'            => $list_mode,
            'ADMIN'                  => $is_admin
      };

      my $template = $self->param('template');
      my $output;
      $template->process('main.html', $vars, \$output);

      $self->param('next_runmode' => 'main_switch');

      return $output;
}

####################################################################
sub do_add_pre
####################################################################
# Add Student form.  Uses add_pre.html for a template.
####################################################################
{
      my $self = shift;
      
      my $q = $self->query();

      my $vars = {
            'USERNAME'      => $self->param('username'),
      };

      my $template = $self->param('template');
      my $output;
      $template->process('add_pre.html', $vars, \$output);

      $self->param('next_runmode' => 'main_switch');
      
      return $output;
}

####################################################################
sub do_search_pre
####################################################################
# Search form.  Uses search_pre.html for a template.
####################################################################
{
      my $self = shift;
      
      my $q = $self->query();

      my $vars = {
            'USERNAME'      => $self->param('username'),
      };

      my $template = $self->param('template');
      my $output;
      $template->process('search_pre.html', $vars, \$output);

      $self->param('next_runmode' => 'main_switch');
      
      return $output;
}

####################################################################
sub do_search
####################################################################
# Search form.  Uses search_pre.html for a template.
####################################################################
{
      my $self = shift;
      my $q = $self->query();
      my $dbh = $self->param('mydbh');

      my $sql = 'SELECT * FROM S00_STUDENTS';

      my @critsql = ();
      my @crit = ();
        my @english;

      my $debug = '';

      # Check starting and expected graduation dates.
      for my $par ('START', 'EXP_GRAD') {
            my $type = $q->param("${par}_DATE_TYPE");
            my $term = $q->param("${par}_TERM");
            my $year = $q->param("${par}_YEAR");
            if($type and $term and $year) {
      my %ops = (
            'exactly'   =>  "(CONVERT(int, ${par}_TERM) = ?) AND (CONVERT(int, ${par}_YEAR) = ?) AND (CONVERT(int, ${par}_YEAR) = ?)",
            'before'    => "((CONVERT(int, ${par}_TERM) < ?) AND (CONVERT(int, ${par}_YEAR) = ?)) OR (CONVERT(int, ${par}_YEAR) < ?)",
            'after'     => "((CONVERT(int, ${par}_TERM) > ?) AND (CONVERT(int, ${par}_YEAR) = ?)) OR (CONVERT(int, ${par}_YEAR) > ?)",
            'inbefore'  => "((CONVERT(int, ${par}_TERM) <= ?) AND (CONVERT(int, ${par}_YEAR) = ?)) OR (CONVERT(int, ${par}_YEAR) < ?)",
            'inafter'   => "((CONVERT(int, ${par}_TERM) >= ?) AND (CONVERT(int, ${par}_YEAR) = ?)) OR (CONVERT(int, ${par}_YEAR) > ?)",
      );
      my %words = (
        'exactly'   => 'of',
        'before'    => 'before',
        'after'     => 'after',
        'inbefore'  => 'in or before',
        'inafter'   => 'in or after',
      );
      my %realnames = (
        'START'   => 'a Starting Date',
        'EXP_GRAD'=> 'an Expected Graduation Date',
      );
      my @terms = (0, 'Fall', 'Spring', 'Summer', 'August', 'April', 'December');
      my $ayear = sprintf "%d", $year + 1996;
                  push @critsql,  $ops{$type};
                  push @crit, $term, $year, $year;
      push @english, "have $realnames{$par} $words{$type} $terms[$term] $ayear";
            }
      }

      # Check all the Yes/No parameters since they are all handled similarly
      for my $par ('WARNING', 'PROBATION', 'SUSPENSION', 'DISMISSAL', 'GRADUATED', 'TRANSFERRED_OUT',
      'TRANSFERRED_IN', 'INACTIVE') {
             if(index('YN', $q->param($par)) >= 0) {
                  push @critsql, "$par = ?";
                  push @crit, $q->param($par);
                  my $verb = ( $q->param($par) eq 'Y' ) ? 'have' : 'have not';
      my %words = (
        'WARNING' => "$verb received a warning letter",
        'PROBATION' => "$verb been placed on probation",
        'SUSPENSION' => "$verb been suspended",
        'DISMISSAL' => "$verb been dismissed",
        'GRADUATED' => "$verb graduated",
        'TRANSFERRED_OUT' => "$verb TRANSFERRED out",
        'TRANSFERRED_IN' => "$verb TRANSFERRED in",
       );
      push @english, $words{$par};
            }
      }

      # Check GPA criteria
      my $cumgpa_type = $q->param('CUMGPA_TYPE');
      my $cumgpa      = $q->param('CUMGPA');
      if($cumgpa and $cumgpa_type) {
            my %ops = ('at least' => '>=', 'at most' => '<=');
            my $op  = $ops{$cumgpa_type};
    $cumgpa += 0.0;
            push @critsql, "CONVERT(float, CUMGPA) $op ?";
            # assure it's a float comparison
            push @crit, $cumgpa;
    push @english, (sprintf "have a Cumulative GPA of $cumgpa_type %1.2f", $cumgpa);
      }
      
      # check pre-med status
      my $premed = $q->param('PRE_MED');
      if($premed and $premed ne ' ') {
            push @critsql, "PRE_MED = ?";
            push @crit, $premed;
          push @english, {'U'=>'are unsure of pre-med status', 'Y'=>'are pre-med', 'N'=>'are not pre-med'}->{$premed};
      }
      
      # check co-op status
#      my $coop = $q->param('COOP');
#      if($coop and $premed ne ' ') {
#            push @critsql, "COOP = ?";
#            push @crit, $coop;
#      push @english, {'Y'=>'are co-op', 'N'=>'are not co-op'}->{$coop};
#      }
      
      # check class
      my $class = $q->param('YEAR');
            if($class and $class ne ' ') {
            push @critsql, "YEAR = ?";
            push @crit, $class;
      push @english, {'o'=>'are Sophmore', 'j'=>'are Junior', 's'=>'are Senior'}->{$class};
      }
      
      # check gender
      my $gender = $q->param('GENDER');
            if($gender and $gender ne ' ') {
            push @critsql, "GENDER = ?";
            push @crit, $gender;
      push @english, {'m'=>'are male', 'f'=>'are female'}->{$gender};
      }
      
      # text-only, substring matches
      for my $par ('EMAIL', 'DUAL_DEGREE', 'CONCENTRATION', 'ADVISOR', 'LAST_NAME', 'POSTGRAD') {
            my $val = $q->param($par);
            if($val) {
                  push @critsql, "$par LIKE ?";
                  push @crit, "\%$val\%";
      push @english,
      {
            'EMAIL'=>'have an e-mail address containing',
            'DUAL_DEGREE' => 'have a dual degree containing',
            'CONCENTRATION' => 'are in the concentration',
            'ADVISOR' => 'have the academic advisor',
            'LAST_NAME' => 'have the last name',
            'POSTGRAD' => 'have post-graduation info matching'
      }->{$par} . " \"$val\"";
            }
      }
      
      # handle Comment and Awards search
      for my $par ('COMMENT', 'AWARD') {
            my $data = $q->param($par);
            if($data) {
                  my @words = split /\s/, $data;

                  my %fields = ('COMMENT' => 'COMMENT', 'AWARD' => 'NAME');
                  my %tables = ('COMMENT' => 'S00_COMMENTS', 'AWARD' => 'S00_AWARDS');
                  my $field  = $fields{$par};
                  my $table  = $tables{$par};

                  # Form criteria to match records containing all of the search words
                  map { $_ = "\%$_\%" } @words;
                  my $crit = join ' AND ', (("$field LIKE ?") x scalar(@words));
            
                  # Get all student IDs associated with a record containing the given search text
                  my $sth = $dbh->prepare("SELECT ID_STUDENT FROM $table WHERE $crit");
                  $sth->execute(@words);

                  # Eliminiate redundant IDs by using a hash as a set container
                  my @ids; my @ar;
                  push @ids, $ar[0] while (@ar = $sth->fetchrow_array());
                  my %students;
                  $students{$_} = 1 for @ids;
                  $sth->finish();
            
                  # Setup search query criteria for these students
                  my $crit = join ' OR ', (('ID_STUDENT = ?') x scalar(keys %students));
                  push @critsql, $crit;
                  push @crit, (keys %students);
      push @english, {'COMMENT' => 'have comments containing', 'AWARD' => 'have awards containing'}->{$par} . " \"$data\""
            }
      }

      # Append search criteria if we have any
      if(@critsql) {
            $sql .= (' WHERE (' . (join ') AND (', @critsql) . ')');
      }

      
      # run the search query
      my $sth = $dbh->prepare("$sql AND DELETED = 'N' ORDER BY LAST_NAME, FIRST_NAME");
      $sth->execute(@crit);
      my @students = ();
      while(my $hr = $sth->fetchrow_hashref()) {
            my %hash = %$hr;
            push @students, \%hash;
      }
      $sth->finish();

  # format the english search description nicely
  $english[$#english] = 'and ' . $english[$#english] if scalar(@english) > 1;
  my $english = join ', ', @english;

  my $vars = {
      'USERNAME'    => $self->param('username'),
      'STUDENTS'    => \@students,
          'SEARCH_SQL'  => $sql,
         'SEARCH_CRIT' => (join "\n", @crit),
          'ENGLISH'     => $english,
          'ROOTDIR'     => $rootDir,
          'SQL'            => $sql,
      };

      my $template = $self->param('template');
      my $output;
      $template->process('search.html', $vars, \$output);

      $self->param('next_runmode' => 'main_switch');
      
      return $output;
}

####################################################################
sub do_report
####################################################################
# Report generation.  Either outputs an Excel file for download, or
# uses report.html as a template for an HTML report.
####################################################################
{
  my $self = shift;
  my $q = $self->query();
  my $dbh = $self->param('mydbh');
  my $output;

  my $sql  = $q->param('SEARCH_SQL');
  my $crit = $q->param('SEARCH_CRIT');
  my @crit = split /\r?\n\r?/s, $crit;

  my $sth = $dbh->prepare("$sql AND DELETED = 'N' ORDER BY LAST_NAME, FIRST_NAME");
  $sth->execute(@crit);
  my @students;
  while(my $hr = $sth->fetchrow_hashref()) {
    my %hash = %$hr;
    my @terms = (0, 'Fall', 'Spring', 'Summer', 'August', 'April', 'December');
    $hash{'START_DATE'} = sprintf "%s %d", $terms[$hash{'START_TERM'}], ($hash{'START_YEAR'}) + 1996;
    $hash{'EXP_GRAD_DATE'} = sprintf "%s %d", $terms[$hash{'EXP_GRAD_TERM'}], ($hash{'EXP_GRAD_YEAR'}) + 1996;
    $hash{'PREMED'} = {'' => '', 'Y' => 'Yes', 'N' => 'No', 'U' => 'Unsure'}->{$hash{'PRE_MED'}};
    $hash{'YEAR'} = { 'o' => 'Sophomore', 'j' => 'Junior', 's' => 'Senior' }->{$hash{'YEAR'}};
    my ($yyyy, $mm, $dd) = $hash{'LAST_MODIFIED'} =~ /^(....)-(..)-(..).*$/;
    $hash{'LAST_MODIFIED_STR'} = "$mm/$dd/$yyyy";
    ($hash{'RESEARCH_SEMESTER_TERM'},
    $hash{'RESEARCH_SEMESTER_YEAR'}) = split /-/,
    $hash{'RESEARCH_SEMESTER'};
    $hash{'STUDY_ABROAD'} = uc $hash{'STUDY_ABROAD'};
    $hash{'BMES'} = uc $hash{'BMES'};
    $hash{'SEMESTER_AT_SEA'} = uc $hash{'SEMESTER_AT_SEA'};
    $hash{'COOP'} = uc $hash{'COOP'};
    $hash{'RESEARCH'} = uc $hash{'RESEARCH'};
    push @students, \%hash;
  }
  $sth->finish();
 
  for my $student (@students) {
      my $comments = get_student_info( $self, $student );
      $student->{'COMMENTS'} = $comments;
  }

  # Determine what kind of report to generate
  if($q->param('Web')) {
        my $vars = {
      'USERNAME'         => $self->param('username'),
      'STUDENTS'           => \@students,
      'SHOW_ID'            => $q->param('studentid') ? 1 : 0,
      'SHOW_NAME'          => $q->param('name') ? 1 : 0,
      'SHOW_EMAIL'         => $q->param('email') ? 1 : 0,
      'SHOW_GENDER'         => $q->param('gender') ? 1 : 0,
      'SHOW_STARTDATE'     => $q->param('startdate') ? 1 : 0,
      'SHOW_EXGRADDATE'    => $q->param('exgraddate') ? 1 : 0,
      'SHOW_CONCENTRATION' => $q->param('concentration') ? 1 : 0,
      'SHOW_ADVISOR'         => $q->param('advisor') ? 1 : 0,
      'SHOW_PREMED'        => $q->param('premed') ? 1 : 0,
      'SHOW_DUALDEGREE'    => $q->param('dualdegree') ? 1 : 0,
      'SHOW_CUMGPA'        => $q->param('cumgpa') ? 1 : 0,
      'ENGLISH'            => $q->param('ENGLISH'),
      'SHOW_PEOPLESOFT_ID' => $q->param('peoplesoft_id') ? 1 : 0,
      'SHOW_POSTGRAD'         => $q->param('postgrad') ? 1 : 0,
      'SHOW_COURSES'         => $q->param('courses') ? 1 : 0,
      'SHOW_COMMENTS'          => $q->param('comments') ? 1 : 0,
      'ROOTDIR'               => $rootDir
        };

        my $template = $self->param('template');
        $template->process('report.html', $vars, \$output);
  }

      if($q->param('Print')) {
            # get course info for each student in the report
            for my $student (@students) {
                  my( $categories, $requirements, $courses, $gpas, $awards, $comments ) = get_student_info( $self, $student );
                  $student->{'CATEGORIES'} = $categories;
                  $student->{'REQUIREMENTS'} = $requirements;
                  $student->{'COURSES'} = $courses;
                  $student->{'GPAS'} = $gpas;
                  $student->{'AWARDS'} = $awards;
                  $student->{'COMMENTS'} = $comments;
            }
            my $vars = {
                  'USERNAME' => $self->param('username'),
                  'STUDENTS' => \@students,
                  'SHOW_COMMENTS' => $q->param('comments') ? 1 : 0,
                  'SHOW_POSTGRAD' => $q->param('postgrad') ? 1 : 0,
                    'SHOW_COURSES'       => $q->param('courses') ? 1 : 0,
                    'ROOTDIR'      => $rootDir
            };
            my $template = Template->new( { 'INCLUDE_PATH' => '..' } );
            $template->process('print_report.html', $vars, \$output);
      }

      if($q->param('PeopleSoft')) {
            my $vars = {
                  'USERNAME' => $self->param('username'),
                  'STUDENTS' => \@students,
            };
            my $template = Template->new( { 'INCLUDE_PATH' => '..' } );
            $template->process('peoplesoft_report.html', $vars, \$output);
      }

      $self->param('next_runmode' => 'main_switch');
      
      return $output;
}

####################################################################
sub handle_add
####################################################################
# Adds student to database.  Not a runmode.  Called by cgiapp_prerun
####################################################################
{
      my $self = shift;
      my $q = $self->query();
      my $dbh = $self->param('mydbh');
      my $output;

      if ($q->param('Add')) {
            my @keys = (
                  'LAST_NAME', 'FIRST_NAME', 'MIDDLE_INITIAL',
                  'PEOPLESOFT_ID', 'GENDER',
                  'CONCENTRATION', 'ADVISOR', 'PRE_MED', 'DUAL_DEGREE',
                  'START_TERM', 'START_YEAR',
                  'EXP_GRAD_TERM', 'EXP_GRAD_YEAR',
                  'EMAIL', 'CUMGPA',
                  'GRE_A', 'GRE_V', 'GRE_Q', 'MCAT_V', 'MCAT_PS', 'MCAT_BS', 'LSAT',
                  'YEAR', 'RESEARCH', 'RESEARCH_SEMESTER', 'RESEARCH_LAB',
                  'RESEARCH_PROJECT', 'SEMESTER_AT_SEA', 'STUDY_ABROAD',
                  'COOP', 'BMES'
            );

            my $names  = join (', ', @keys);
            my $places = ('?, ' x $#keys) . '?';

            my $sth = $dbh->prepare("INSERT INTO S00_STUDENTS ($names, LAST_MODIFIED) VALUES ($places, ?)");

            my $rsterm = $q->param('RESEARCH_SEMESTER_TERM');
            my $rsyear = $q->param('RESEARCH_SEMESTER_YEAR');
            $q->param( 'RESEARCH_SEMESTER' => "$rsterm-$rsyear" );

            my @values;
            push @values, $q->param($_) for @keys;

            # push on last_modified (current) date
            push @values, (strftime '%Y-%m-%d', localtime);

            $sth->execute(@values);
            $sth->finish();
      }
}

####################################################################
sub handle_chpass
####################################################################
# Change user password
####################################################################
{
      my $self = shift;
      my $q = $self->query();
      my $dbh = $self->param('mydbh');
      my $output;

      if ($q->param('change')) {
            my $old  = $q->param('oldpassword');
            my $new  = $q->param('newpassword');
            my $cnew = $q->param('cnewpassword');
            
            # Get MD5 digest of given passwords
            my $md5 = Digest::MD5->new();
            $md5->add($old);
            my $oldd = $md5->b64digest;
            my $md5 = Digest::MD5->new();
            $md5->add($new);
            my $newd = $md5->b64digest;
            
            # error: new passwords do not match
            if($new ne $cnew) {
                  # Display password screen with error.
                  $self->param('chpass_error' => 'New passwords do not match.');
                  $self->param('next_runmode' => 'passwd');
                  #do_passwd($self);
                  $self->prerun_mode('passwd');
                  return 1;
            }

            my $sth = $dbh->prepare('SELECT * FROM U00_USERS WHERE USERNAME = ?');
            $sth->execute($self->param('username'));
            my $row = $sth->fetchrow_hashref();
            my %user = %$row;
            $sth->finish();

            # Compare new and stored digests
            if($oldd ne $user{'PASSWORD'}) {
                  # Display password screen with error.
                  $self->param('chpass_error' => 'Old password incorrect.');
                  $self->param('next_runmode' => 'passwd');
                  #do_passwd($self);
                  $self->prerun_mode('passwd');
                  return 1;
            }

            $sth = $dbh->prepare("UPDATE U00_USERS SET PASSWORD = ? WHERE USERNAME = ?");
            $sth->execute($newd, $self->param('username'));
            $sth->finish();
            
            return 0;
      }
}

####################################################################
sub get_student_info
####################################################################
# Utility function to retrieve and digest
# course information and comments
####################################################################
{
      my $self = shift;
      my $q = $self->query();
      my $dbh = $self->param('mydbh');

      my $student = shift;

      # Grab per-requirement notes
      my $sth = $dbh->prepare('SELECT * FROM S00_CATNOTES WHERE ID_STUDENT = ?');
      $sth->execute($student->{'ID_STUDENT'});
      my %catnotes;
      while(my $hr = $sth->fetchrow_hashref) {
            $catnotes{$hr->{'ID_CATEGORY'}} = $hr->{'NOTE'};
      }
      $sth->finish();

      # Grab requirements categories
      my $sth = $dbh->prepare('SELECT * FROM R00_CATEGORIES WHERE ID_CURRICULUM = ? ORDER BY SORT_INDEX');
      $sth->execute($student->{'ID_CURRICULUM'});
      my @categories;
      while(my $hr = $sth->fetchrow_hashref) {
            my %hash = %$hr;
            $hash{'NOTES'} = $catnotes{$hash{'ID_CATEGORY'}};
            push @categories, \%hash;
      }
      $sth->finish();
      
      # Get completion records for this student
      my $sth = $dbh->prepare('SELECT * FROM S00_COMPLETIONS WHERE ID_STUDENT = ?');
      $sth->execute($student->{'ID_STUDENT'});
      my @completions;
      while(my $hr = $sth->fetchrow_hashref) {
            my %hash = %$hr;
            push @completions, \%hash;
      }
      $sth->finish();
      
      # Get all required courses for the student's assigned curriculum.  Also retrieve any "expired"
      # requirements -- ones that are no longer in the core requirements but may have been taken
      # already as such.
      my $sth = $dbh->prepare('SELECT * FROM R00_REQUIREMENTS WHERE ID_CURRICULUM = ? OR ID_CURRICULUM = 99 ORDER BY NUMBER');
      $sth->execute($student->{'ID_CURRICULUM'});
      my @requirements;
      REQ: while(my $hr = $sth->fetchrow_hashref) {
            next REQ if $hr->{'ID_CURRICULUM'} == 99 and not grep { $_->{'ID_REQUIREMENT'} == $hr->{'ID_REQUIREMENT'} } @completions;
            my %hash = %$hr;
            $hash{ 'CHECKED'  } = '';
            $hash{ 'T_CHECKED'} = '';
            $hash{ 'H_CHECKED'} = '';
            $hash{ 'G_CHECKED'} = '';
            $hash{'AP_CHECKED'} = '';
            $hash{ 'W_CHECKED'} = '';
            push @requirements, \%hash;
      }
      $sth->finish();

      # Get all other courses
      my $sth = $dbh->prepare('SELECT * FROM C00_COURSES');
      $sth->execute();
      my @courses;
      while(my $hr = $sth->fetchrow_hashref) {
            my %hash = %$hr;
            $hash{ 'T_CHECKED'} = '';
            $hash{ 'H_CHECKED'} = '';
            $hash{ 'G_CHECKED'} = '';
            $hash{'AP_CHECKED'} = '';
            $hash{ 'W_CHECKED'} = '';
            $hash{ 'COMPLETED'} = '';
            push @courses, \%hash;
      }
      $sth->finish();
      
      # Determine completed courses and mark their records
      for my $comp (@completions) {
            # general course
            if($comp->{'TYPE'} eq '1') {
                  # find the corresponding course entry
                  for my $crs (@courses) {
                        if($comp->{'ID_COURSE'} eq $crs->{'ID_COURSE'}) {
                              $crs->{ 'T_CHECKED'} = 'CHECKED' if $comp->{'FLAG_T'};
                              $crs->{ 'H_CHECKED'} = 'CHECKED' if $comp->{'FLAG_H'};
                              $crs->{ 'G_CHECKED'} = 'CHECKED' if $comp->{'FLAG_G'};
                              $crs->{'AP_CHECKED'} = 'CHECKED' if $comp->{'FLAG_AP'};
                              $crs->{ 'W_CHECKED'} = 'CHECKED' if $comp->{'FLAG_W'};
                              $crs->{ 'COMPLETED'} = 1;
                        }
                  }
            }
            # requirement course
            elsif($comp->{'TYPE'} eq '2') {
                  # find the corresponding requirements entry
                  for my $req (@requirements) {
                        if($comp->{'ID_REQUIREMENT'} eq $req->{'ID_REQUIREMENT'}) {
                              $req->{   'CHECKED'} = 'CHECKED';
                              $req->{ 'T_CHECKED'} = 'CHECKED' if $comp->{'FLAG_T'};
                              $req->{ 'H_CHECKED'} = 'CHECKED' if $comp->{'FLAG_H'};
                              $req->{ 'G_CHECKED'} = 'CHECKED' if $comp->{'FLAG_G'};
                              $req->{'AP_CHECKED'} = 'CHECKED' if $comp->{'FLAG_AP'};
                              $req->{ 'W_CHECKED'} = 'CHECKED' if $comp->{'FLAG_W'};
                        }
                  }
            }
      }

      my $sth = $dbh->prepare('SELECT * FROM S00_GPAS WHERE ID_STUDENT = ?');
      $sth->execute($student->{'ID_STUDENT'});
      my @gpas;
      while(my $hr = $sth->fetchrow_hashref()) {
            my %hash = %$hr;
            my $term_name = ('', 'Fall', 'Spring', 'Summer')[$hash{'TERM'}];
            my $year_name = $hash{'YEAR'} + 1899;
            $year_name = "$year_name-" . ($year_name + 1);
            my $aystr = sprintf '%.2d-%d', ($hash{'YEAR'} % 100), $hash{'TERM'};
            $hash{'DATE_STR'} = "$term_name $year_name ($aystr)";
            push @gpas, \%hash;
      }
      $sth->finish;

      my @months = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
      my $sth = $dbh->prepare('SELECT * FROM S00_AWARDS WHERE ID_STUDENT = ?');
      $sth->execute($student->{'ID_STUDENT'});
      my @awards;
      while(my $hr = $sth->fetchrow_hashref()) {
            my %hash = %$hr;
            my $yn = $hash{'YEAR'} + 1900;
            my $mn = $months[$hash{'MONTH'} - 1];
            $hash{'DATE_STR'} = "$mn $yn";
            push @awards, \%hash;
      }
      $sth->finish;

      my $id_student = $student->{'ID_STUDENT'};
      my $sth = $dbh->prepare('SELECT * FROM S00_COMMENTS WHERE ID_STUDENT = ?');
      $sth->execute($id_student);
      my @comments;
      while(my $hr = $sth->fetchrow_hashref()) {
            my %hash = %$hr;
            my $yn = $hash{'YEAR'} + 1900;
            my $mn = $months[$hash{'MONTH'} - 1];
            my $dn = $hash{'DAY'};
            $hash{'DATE_STR'} = "$mn $dn, $yn";
            # if this is for a printable report, treat newlines differently.
            # in this case, change newlines to <BR> tags.
            if( $self->get_current_runmode() eq 'report' ) {
                  $hash{'COMMENT'} =~ s/\n+/<br>/g;
            }
            else {
                  # add <BR> tags after at most every 50 characters
                  $hash{'COMMENT'} =~ s/([^\n]{50}?)\s/\1<br>/g;
            }
            push @comments, \%hash;
      }
      $sth->finish;

      return ( \@categories, \@requirements, \@courses, \@gpas, \@awards, \@comments );
}

####################################################################
sub do_view
####################################################################
# Displays a student's information
####################################################################
{
      my $self = shift;
      my $q = $self->query();
      my $dbh = $self->param('mydbh');

      # Grab student info      
      my $sth = $dbh->prepare('SELECT * FROM S00_STUDENTS WHERE ID_STUDENT = ?');
      $sth->execute($q->param('ID_STUDENT'));
      my %student = %{$sth->fetchrow_hashref()};
      my ($yyyy, $mm, $dd) = $student{'LAST_MODIFIED'} =~ /^(....)-(..)-(..).*$/;
      $student{'LAST_MODIFIED_STR'} = "$mm/$dd/$yyyy";
      my @t1 = ('','Fall', 'Spring', 'Summer');
      $student{'START_TERM_STR'}  = $t1[$student{'START_TERM'}];
      $student{'START_YEAR_STR'} = ($student{'START_YEAR'} + 1996);
      $student{'EXP_GRAD_TERM_STR'}  = $t1[$student{'EXP_GRAD_TERM'}];
      $student{'EXP_GRAD_YEAR_STR'} = ($student{'EXP_GRAD_YEAR'} + 1996);
      my %pmh = ('Y' => 'Yes', 'N' => 'No', 'U' => 'Unsure');
      $student{'PRE_MED_STR'} = $pmh{$student{'PRE_MED'}};
      ($student{'RESEARCH_SEMESTER_TERM'}, $student{'RESEARCH_SEMESTER_YEAR'}) = split /-/, $student{'RESEARCH_SEMESTER'};
      $sth->finish();

      my( $categories, $requirements, $courses, $gpas, $awards, $comments ) = get_student_info( $self, \%student );

      my $sth = $dbh->prepare('SELECT * FROM U00_USERS WHERE USERNAME = ?');
      $sth->execute($self->param('username'));
      my $is_admin = 0;
      while(my $hr = $sth->fetchrow_hashref()) {
            $is_admin = 1 if $hr->{'ADMIN'} eq 'Y';
      }
      $sth->finish();
      
      $student{'FULL_NAME'} = $student{'LAST_NAME'} . ', ' . $student{'FIRST_NAME'};
      $student{'FULL_NAME'} .= (' ' . $student{'MIDDLE_INITIAL'} . '.') if $student{'MIDDLE_INITIAL'};
      $self->param('titleprefix' => $student{'FULL_NAME'});

      my $default_gpa = {
            'TERM' => $self->param('defaultgpaterm'),
            'YEAR' => $self->param('defaultgpayear'),
            'GPA'  => $self->param('defaultgpagpa')
      };
      
      my $default_awd = {
            'MON'  => $self->param('defaultawdmon'),
            'YEAR' => $self->param('defaultawdyear'),
            'NAME'  => $self->param('defaultawdname')
      };
      
      my $default_com = {
            'MON'     => $self->param('defaultcommon'),
            'DAY'     => $self->param('defaultcomday'),
            'YEAR'    => $self->param('defaultcomyear'),
            'COMMENT' => $self->param('defaultcomcomment')
      };

      my $vars = {
            'USERNAME'            => $self->param('username'),
            'STUDENT'                  => \%student,
            'CATEGORIES'      => $categories,
            'REQUIREMENTS'=> $requirements,
            'COURSES'                  => $courses,
            'GPAS'                        => $gpas,
            'AWARDS'                  => $awards,
            'COMMENTS'            => $comments,
            'JUMP_ANCHOR'      => $self->param('jumpanchor'),
            'DEFAULTGPA'      => $default_gpa,
            'DEFAULTAWD'      => $default_awd,
            'DEFAULTCOM'      => $default_com,
            'ADMIN'                        => $is_admin,
            'ROOTDIR'      => $rootDir
      };

      my $template = $self->param('template');
      my $output;
      $template->process('view.html', $vars, \$output);

      $self->param('next_runmode' => 'main_switch');

      return $output;      
}

####################################################################
sub handle_logout
####################################################################
# Logs out the user.  Destroys session record.
####################################################################
{
      my $self = shift;
      my $q = $self->query();
      my $dbh = $self->param('mydbh');
      
      my $sth = $dbh->prepare('DELETE FROM U00_SESSIONS WHERE TAG = ?');
      $sth->execute($self->param('sid'));
      $sth->finish;
      
      $self->param('username' => '');
      $self->param('sid' => '');
      $self->param('uid' => '');
}

####################################################################
sub handle_update
####################################################################
# Update a student's information, from the View form.
####################################################################
{
      my $self = shift;
      my $q = $self->query();
      my $dbh = $self->param('mydbh');

      my @params = $q->param();
      my $output;
      my $sth;
      my $query;
      my $datetime = strftime '%Y-%m-%d', localtime;

      # Take care of the standard basic info.
      $query = 'UPDATE S00_STUDENTS SET GENDER = ?, LAST_NAME = ?, FIRST_NAME = ?, ' .
            'MIDDLE_INITIAL = ?, PEOPLESOFT_ID = ?, EMAIL = ?, START_TERM = ?, START_YEAR = ?,' .
            'EXP_GRAD_TERM = ?, EXP_GRAD_YEAR = ?, CONCENTRATION = ?, ADVISOR = ?, PRE_MED = ?,' .
            'DUAL_DEGREE = ?, CUMGPA = ?, LAST_MODIFIED = ?, WARNING = ?, PROBATION = ?, ' .
            'SUSPENSION = ?, DISMISSAL = ?, GRADUATED = ?, IINTERN = ?, GRE_A = ?, GRE_V = ?, ' .
            'GRE_Q = ?, LSAT = ?, MCAT_V = ?, MCAT_PS = ?, MCAT_BS = ?, POSTGRAD = ?, ' .
            'YEAR = ?, RESEARCH = ?, RESEARCH_SEMESTER = ?, RESEARCH_LAB = ?, ' .
            'RESEARCH_PROJECT = ?, SEMESTER_AT_SEA = ?, STUDY_ABROAD = ?, ' .
            'COOP = ?, BMES = ?, TRANSFERRED_OUT = ?, TRANSFERRED_IN = ? , INACTIVE = ? ' .
            'WHERE ID_STUDENT = ?';
      $sth = $dbh->prepare($query);

      my $rsem = $q->param('RESEARCH_SEMESTER_TERM') . '-' . $q->param('RESEARCH_SEMESTER_YEAR');
      $q->param( 'RESEARCH_SEMESTER' => $rsem );

      $sth->execute(
            $q->param('GENDER'), $q->param('LAST_NAME'), $q->param('FIRST_NAME'),
            $q->param('MIDDLE_INITIAL'), $q->param('PEOPLESOFT_ID'),
            $q->param('EMAIL'), $q->param('START_TERM'),
            $q->param('START_YEAR'), $q->param('EXP_GRAD_TERM'), $q->param('EXP_GRAD_YEAR'),
            $q->param('CONCENTRATION'), $q->param('ADVISOR'), $q->param('PRE_MED'), $q->param('DUAL_DEGREE'),
            $q->param('CUMGPA'), $datetime, $q->param('WARNING') ? 'Y' : 'N',
            $q->param('PROBATION') ? 'Y' : 'N', $q->param('SUSPENSION') ? 'Y' : 'N',
            $q->param('DISMISSAL') ? 'Y' : 'N', $q->param('GRADUATED') ? 'Y' : 'N',
            $q->param('IINTERN') ? 'Y' : 'N',
            $q->param('GRE_A'), $q->param('GRE_V'), $q->param('GRE_Q'),
            $q->param('LSAT'), $q->param('MCAT_V'), $q->param('MCAT_PS'),
            $q->param('MCAT_BS'), $q->param('POSTGRAD'),
            $q->param('YEAR'), $q->param('RESEARCH'), $q->param('RESEARCH_SEMESTER'),
            $q->param('RESEARCH_LAB'), $q->param('RESEARCH_PROJECT'),
            $q->param('SEMESTER_AT_SEA'), $q->param('STUDY_ABROAD'),
            $q->param('COOP'), $q->param('BMES'), $q->param('TRANSFERRED_OUT') ? 'Y' : 'N',
            $q->param('TRANSFERRED_IN') ? 'Y' : 'N',
            $q->param('INACTIVE') ? 'Y' : 'N',
            $q->param('ID_STUDENT'));
      $sth->finish();

      # Remove old completion records
      $sth = $dbh->prepare('DELETE FROM S00_COMPLETIONS WHERE ID_STUDENT = ?');
      my $id_student = $q->param('ID_STUDENT');
      $sth->execute($q->param('ID_STUDENT'));
      $sth->finish();

      # Handle variably-named parameters (req*, crs*)
      KEY: for my $key (@params) {
            # For example reqDone_12 becomes ("req", "Done", "12")
            my ($type, $prop, $cat, $id) = $key =~ /(req|crs)([^_]+)_(\d+)_(\d+)/;
            
            # Requirement data
            if (($type eq 'req') and ($prop eq 'Done')) {
                  # Check for other set flags on the requirement
                  my $flagT  = (defined $q->param("reqT_${cat}_$id" )) ? 1 : 0;
                  my $flagH  = (defined $q->param("reqH_${cat}_$id" )) ? 1 : 0;
                  my $flagG  = (defined $q->param("reqG_${cat}_$id" )) ? 1 : 0;
                  my $flagAP = (defined $q->param("reqAP_${cat}_$id")) ? 1 : 0;
                  my $flagW  = (defined $q->param("reqW_${cat}_$id" )) ? 1 : 0;
                  # Insert this requirement into the student's completions
                  $sth = $dbh->prepare('INSERT INTO S00_COMPLETIONS ' .
                        '(TYPE, ID_REQUIREMENT, ID_STUDENT, FLAG_T, FLAG_H, ' .
                        'FLAG_G, FLAG_AP, FLAG_W) VALUES (?, ?, ?, ?, ?, ?, ?, ?)');
                  $sth->execute('2', $id, $id_student, $flagT,
                        $flagH, $flagG, $flagAP, $flagW);
                  $sth->finish();
            }
            # Course data
            elsif ($type eq 'crs' and ($prop eq 'Name')) {
                  # Add the course to the courses table if it doesn't already exist
                  my ($id_course, $hr);
                  $sth = $dbh->prepare('SELECT ID_COURSE FROM C00_COURSES ' .
                        'WHERE NAME = ? AND ID_CATEGORY = ?');
                  my $crsName = $q->param("crsName_${cat}_$id");
                  next KEY if!$crsName;
                  my $crsCat  = $q->param("crsCat_${cat}_$id");
                  $sth->execute($crsName, $crsCat);
                  $hr = $sth->fetchrow_hashref();
                  if(!$hr) {
                        $sth->finish();
                        $sth = $dbh->prepare('INSERT INTO C00_COURSES (NAME, ID_CATEGORY) ' .
                              'VALUES (?, ?)');
                        $sth->execute($crsName, $crsCat);
                        $sth->finish();
                        $sth = $dbh->prepare('SELECT ID_COURSE FROM C00_COURSES ' .
                              'WHERE NAME = ? AND ID_CATEGORY = ?');
                        $sth->execute($crsName, $crsCat);
                        $hr = $sth->fetchrow_hashref();
                  }
                  $id_course = $hr->{'ID_COURSE'};
                  $sth->finish();
                        
                  # Check flags
                  my $flagT  = (defined $q->param("crsT_${cat}_$id" )) ? 1 : 0;
                  my $flagH  = (defined $q->param("crsH_${cat}_$id" )) ? 1 : 0;
                  my $flagG  = (defined $q->param("crsG_${cat}_$id" )) ? 1 : 0;
                  my $flagAP = (defined $q->param("crsAP_${cat}_$id")) ? 1 : 0;
                  my $flagW  = (defined $q->param("crsW_${cat}_$id" )) ? 1 : 0;
                  # Insert course into student's completions
                  $sth = $dbh->prepare('INSERT INTO S00_COMPLETIONS ' .
                        '(TYPE, ID_COURSE, ID_STUDENT, FLAG_T, FLAG_H, ' .
                        'FLAG_G, FLAG_AP, FLAG_W) VALUES (?, ?, ?, ?, ?, ?, ?, ?)');
                  $sth->execute('1', $id_course, $id_student, $flagT,
                        $flagH, $flagG, $flagAP, $flagW);
                  $sth->finish();
            }
      }

      $sth = $dbh->prepare('SELECT ID_CURRICULUM FROM S00_STUDENTS WHERE ID_STUDENT = ?');
      $sth->execute($id_student);
      my $hr = $sth->fetchrow_hashref();
      my $id_curriculum = $hr->{'ID_CURRICULUM'};
      $sth->finish();

      $sth = $dbh->prepare('SELECT * FROM R00_CATEGORIES WHERE ID_CURRICULUM = ?');
      $sth->execute($id_curriculum);
      my @categories;
      while (my $hr = $sth->fetchrow_hashref()) {
            my %hash = %$hr;
            push @categories, \%hash;
      }
      $sth->finish();

      $sth = $dbh->prepare('DELETE FROM S00_CATNOTES WHERE ID_STUDENT = ?');
      $sth->execute($id_student);
      $sth->finish();
      for my $cat (@categories) {
            my $catvar = 'catnotes_' . $cat->{'ID_CATEGORY'};
            $sth = $dbh->prepare('INSERT INTO S00_CATNOTES (ID_STUDENT, ID_CATEGORY, NOTE) VALUES (?, ?, ?)');
            $sth->execute($id_student, $cat->{'ID_CATEGORY'}, $q->param($catvar));
            $sth->finish();
      }
      
      # Deal with image upload
      if($q->param('IMAGE')) {
                  # explicitly set CGITemp directory to avoid permissions problems
                  $CGITempFile::TMPDIRECTORY = '/webs/undergraddb/cgitemp';

                  my $sth = $dbh->prepare('DELETE FROM I00_IMAGES WHERE ID_STUDENT = ?');
                  $sth->execute($id_student);
                  $sth->finish();

                  my $handle = $q->upload('IMAGE');
                  binmode $handle;
                  my $data;
                  $data .= $_ while <$handle>;
                  my $sth = $dbh->prepare('INSERT INTO I00_IMAGES (ID_STUDENT, DATA) VALUES (?, ?)');
                  $sth->execute($id_student, $data);
                  $sth->finish();
      }      

      return $output;
}

####################################################################
sub do_passwd
####################################################################
# Change Password form.  Uses passwd.html for a template.
####################################################################
{
      my $self = shift;
      
      my $q = $self->query();

      my $vars = {
            'USERNAME'      => $self->param('username'),
            'ERROR_MESSAGE'      => $self->param('chpass_error'),
      };

      $self->param('chpass_error' => '');

      my $template = $self->param('template');
      my $output;
      $template->process('passwd.html', $vars, \$output);

      $self->param('next_runmode' => 'main_switch');
      
      return $output;
}

####################################################################
sub handle_delete
####################################################################
# Deletes a student's entire record and all related data
####################################################################
{
      my $self = shift;
      my $q = $self->query();
      my $dbh = $self->param('mydbh');

      my @params = $q->param();
      my $sth;
      my $query;
      
      my $id = $q->param('ID_STUDENT');

      $sth = $dbh->prepare("UPDATE S00_STUDENTS SET DELETED = 'Y' WHERE ID_STUDENT = ?");
      $sth->execute($id);
      $sth->finish();
}

####################################################################
sub handle_termgpa
####################################################################
# Update a student's per-term GPA records
####################################################################
{
      my $self = shift;
      my $q = $self->query();
      my $dbh = $self->param('mydbh');

      my @params = $q->param();
      my $sth;
      my $query;
      my $datetime = strftime '%Y-%m-%d', localtime;
      
      # update modification time of student record
      $sth = $dbh->prepare('UPDATE S00_STUDENTS SET LAST_MODIFIED = ?');
      $sth->execute($datetime);
      $sth->finish();

      # delete any old record for this term
      $sth = $dbh->prepare('DELETE FROM S00_GPAS WHERE ID_STUDENT = ? AND TERM = ? AND YEAR = ?');
      $sth->execute($q->param('ID_STUDENT'), $q->param('GPA_TERM'), $q->param('GPA_YEAR'));
      $sth->finish();

      # add this GPA information
      $sth = $dbh->prepare('INSERT INTO S00_GPAS (ID_STUDENT, TERM, YEAR, GPA) VALUES (?, ?, ?, ?)');
      $sth->execute($q->param('ID_STUDENT'), $q->param('GPA_TERM'), $q->param('GPA_YEAR'),
            $q->param('TERM_GPA'));
      $sth->finish();
}

####################################################################
sub handle_awards
####################################################################
# Update a student's Awards records
####################################################################
{
      my $self = shift;
      my $q = $self->query();
      my $dbh = $self->param('mydbh');

      my @params = $q->param();
      my $sth;
      my $query;
      my $datetime = strftime '%Y-%m-%d', localtime;
      
      # update modification time of student record
      $sth = $dbh->prepare('UPDATE S00_STUDENTS SET LAST_MODIFIED = ?');
      $sth->execute($datetime);
      $sth->finish();

      # add this GPA information
      $sth = $dbh->prepare('INSERT INTO S00_AWARDS (ID_STUDENT, MONTH, YEAR, NAME) VALUES (?, ?, ?, ?)');
      $sth->execute($q->param('ID_STUDENT'), $q->param('AWARD_MON'), $q->param('AWARD_YR'),
            $q->param('AWARD_NAME'));
      $sth->finish();
}

####################################################################
sub handle_comments
####################################################################
# Update a student's Comments records
####################################################################
{
      my $self = shift;
      my $q = $self->query();
      my $dbh = $self->param('mydbh');

      my @params = $q->param();
      my $sth;
      my $query;
      my $datetime = strftime '%Y-%m-%d', localtime;

      my $comment_mon = $q->param('COMMENT_MON');
      my $comment_day = $q->param('COMMENT_DAY');
      my $comment_yr  = $q->param('COMMENT_YR');

      if( !$comment_mon || !$comment_day || !$comment_yr ) {
            ($comment_yr, $comment_mon, $comment_day) = split /-/, $datetime;
            $comment_yr = $comment_yr - 1900;
            $comment_day = $comment_day + 0;
            $comment_mon = $comment_mon + 0;
      }
      
      # update modification time of student record
      $sth = $dbh->prepare('UPDATE S00_STUDENTS SET LAST_MODIFIED = ?');
      $sth->execute($datetime);
      $sth->finish();

      # add this GPA information
      $sth = $dbh->prepare('INSERT INTO S00_COMMENTS (ID_STUDENT, AUTHOR, MONTH, DAY, YEAR, COMMENT) VALUES (?, ?, ?, ?, ?, ?)');
      $sth->execute($q->param('ID_STUDENT'), $q->param('username'), $comment_mon, $comment_day, $comment_yr, $q->param('COMMENT_TEXT'));
      $sth->finish();
}

####################################################################
sub handle_del_gpa
####################################################################
# Delete a GPA record
####################################################################
{
      my $self = shift;
      my $q = $self->query();
      my $dbh = $self->param('mydbh');

      my @params = $q->param();
      my $sth;
      my $query;
      
      my $id = $q->param('ID_MISC');
      
      $sth = $dbh->prepare('DELETE FROM S00_GPAS WHERE ID_GPA = ?');
      $sth->execute($id);
      $sth->finish();
}

####################################################################
sub handle_del_awd
####################################################################
# Delete a Award record
####################################################################
{
      my $self = shift;
      my $q = $self->query();
      my $dbh = $self->param('mydbh');

      my @params = $q->param();
      my $sth;
      my $query;
      
      my $id = $q->param('ID_MISC');
      
      $sth = $dbh->prepare('DELETE FROM S00_AWARDS WHERE ID_AWARD = ?');
      $sth->execute($id);
      $sth->finish();
}

####################################################################
sub handle_del_com
####################################################################
# Delete a Comment record
####################################################################
{
      my $self = shift;
      my $q = $self->query();
      my $dbh = $self->param('mydbh');

      my @params = $q->param();
      my $sth;
      my $query;
      
      my $id = $q->param('ID_MISC');
      
      $sth = $dbh->prepare('DELETE FROM S00_COMMENTS WHERE ID_COMMENT = ?');
      $sth->execute($id);
      $sth->finish();
}

####################################################################
sub handle_edit_gpa
####################################################################
# Edit a GPA record
####################################################################
{
      my $self = shift;
      my $q = $self->query();
      my $dbh = $self->param('mydbh');

      my @params = $q->param();
      my $sth;
      my $query;
      
      my $id = $q->param('ID_MISC');

      $sth = $dbh->prepare('SELECT * FROM S00_GPAS WHERE ID_GPA = ?');
      $sth->execute($id);
      my $gpa;
      while(my $hr = $sth->fetchrow_hashref()) {
            my %hash = %$hr;
            $gpa = \%hash;
      }
      $sth->finish();

      $sth = $dbh->prepare('DELETE FROM S00_GPAS WHERE ID_GPA = ?');
      $sth->execute($id);
      $sth->finish();
      
      $self->param('defaultgpaterm' => $gpa->{'TERM'});
      $self->param('defaultgpayear' => $gpa->{'YEAR'});
      $self->param('defaultgpagpa' => $gpa->{'GPA'});
}

####################################################################
sub handle_edit_awd
####################################################################
# Edit a Award record
####################################################################
{
      my $self = shift;
      my $q = $self->query();
      my $dbh = $self->param('mydbh');

      my @params = $q->param();
      my $sth;
      my $query;
      
      my $id = $q->param('ID_MISC');
      
      $sth = $dbh->prepare('SELECT * FROM S00_AWARDS WHERE ID_AWARD = ?');
      $sth->execute($id);
      my $awd;
      while(my $hr = $sth->fetchrow_hashref()) {
            my %hash = %$hr;
            $awd = \%hash;
      }
      $sth->finish();

      $sth = $dbh->prepare('DELETE FROM S00_AWARDS WHERE ID_AWARD = ?');
      $sth->execute($id);
      $sth->finish();
      
      $self->param('defaultawdmon' => $awd->{'MONTH'});
      $self->param('defaultawdyear' => $awd->{'YEAR'});
      $self->param('defaultawdname' => $awd->{'NAME'});
}

####################################################################
sub handle_edit_com
####################################################################
# Edit a Comment record
####################################################################
{
      my $self = shift;
      my $q = $self->query();
      my $dbh = $self->param('mydbh');

      my @params = $q->param();
      my $sth;
      my $query;
      
      my $id = $q->param('ID_MISC');
      
      $sth = $dbh->prepare('SELECT * FROM S00_COMMENTS WHERE ID_COMMENT = ?');
      $sth->execute($id);
      my $com;
      while(my $hr = $sth->fetchrow_hashref()) {
            my %hash = %$hr;
            $com = \%hash;
      }
      $sth->finish();

      $sth = $dbh->prepare('DELETE FROM S00_COMMENTS WHERE ID_COMMENT = ?');
      $sth->execute($id);
      $sth->finish();
      
      $self->param('defaultcommon' => $com->{'MONTH'});
      $self->param('defaultcomday' => $com->{'DAY'});
      $self->param('defaultcomyear' => $com->{'YEAR'});
      $self->param('defaultcomcomment' => $com->{'COMMENT'});
}


1;

Anyone have any ideas?  Perl certainly seems to work ok.

Thanks,

Tim
0
tjcst25
Asked:
tjcst25
  • 13
  • 5
  • 3
  • +2
1 Solution
 
kawasCommented:
what is your error?
0
 
tjcst25Author Commented:
HTTP 500 Internal Server Error

This runs fine on our live webserver, but I'm getting this error on my development machine.
0
 
kawasCommented:
you are most likely missing some modules on your dev machine. You should really check the error logs... 500 errors always report something else ...
0
Fill in the form and get your FREE NFR key NOW!

Veeam is happy to provide a FREE NFR server license to certified engineers, trainers, and bloggers.  It allows for the non‑production use of Veeam Agent for Microsoft Windows. This license is valid for five workstations and two servers.

 
Adam314Commented:
The error log should provide more details.  Or you can try running it from the command prompt.  What happens then?
0
 
mjcoyneCommented:
In particular, be sure you have all of these installed on your development machine, as they are required by UGDBApp.pm:

use base 'CGI::Application';
use DBI;
use DBD::ODBC;
use Digest::MD5;
use POSIX qw/ceil strftime/;
use Spreadsheet::WriteExcel;
use Template;
use Cwd;
use File::Basename;

You'll also need the database program and the database itself, and all the right passwords, usernames, and permissions.
0
 
tjcst25Author Commented:
I'll triple check the packages.  I'm used to getting errors to the tone of "can't access package so and so" when one is missing, not this 500 error.  But I also just upgraded to Win2k8...  So not sure how it and IIS7 handles those errors.  I figured this "use CGI::Carp qw(fatalsToBrowser);" would have given me something informative.  The error logs don't tell me much that I can understand anyway.

Thanks for the info.  I'll let you know if something simple like packages are missing.

u-ex081107.log
0
 
tjcst25Author Commented:
Ok, I can run app.pl from the command line and get the html code for the login page...  So it seems that none of the packages are missing.
0
 
tjcst25Author Commented:
The database and ODBC connection seem fine, but I'll triple check those too.
0
 
tjcst25Author Commented:
I can make a connection and query.


#!/usr/bin/perl
use CGI::Carp qw(fatalsToBrowser);
use strict;
use base 'CGI::Application';
use DBI;
use DBD::ODBC;
use Digest::MD5;
use POSIX qw/ceil strftime/;
use Spreadsheet::WriteExcel;
use Template;
use Cwd;
use File::Basename;
 
print "Content-type: text/html\n\n";
 
my $dbh = DBI->connect("DBI:ODBC:UndergradDB","undergraddb","*******",{RaiseError=>1}) or die "Database connection not made: $DBI::errstr";
 
$dbh->{LongReadLen} = 10 * 1024 * 1024;
 
my $sth = $dbh->prepare( "SELECT * FROM S00_STUDENTS WHERE GRADUATED = 'Y' ORDER BY LAST_NAME, FIRST_NAME" );
$sth->execute;
my @students = ();
while(my $hr = $sth->fetchrow_hashref) {
	my %hash = %$hr;
	push @students, \%hash if $hr->{'DELETED'} ne 'Y';
	print @students;
}
$sth->finish;

Open in new window

0
 
Adam314Commented:
The log you attached looks like the access log.  Can you attach the error log?
0
 
tjcst25Author Commented:
Can you point me to where the error log may be?  I have no entries in the Event Viewer->Applications and Services->Microsoft->Windows->HttpService->HTTP Service Channel log.

Thank you!
0
 
tjcst25Author Commented:
I figured out how to capture the 500 error with Site Tracing, but no errors or warnings are listed for these captures...

Tim
500-trace.jpg
0
 
Adam314Commented:
Are the permissions set correctly for app.pl?
0
 
tjcst25Author Commented:
I've given Everyone full permissions to cover all of the bases and still get the 500 error.  

Tim
0
 
Adam314Commented:
Can you log-in as the webserver user and try running it from the command line?
0
 
tjcst25Author Commented:
Ok, I think I've finally figured it out.  Or at least where to get useful information.  In the XML error trace, under General_Response_Headers, it says that it can't locate UGDBApp.pm even though it's in the same directory.  I came across something similar a good bit ago for some other projects, just need to remember what was needed to fix it.

Tim
0
 
TintinCommented:
When running in the CGI context, you can't assume the directory the CGI script lives in, is where the webserver (in particular IIS) runs it from.

Add a

use lib 'C:/path/to/modules';

to the script.
0
 
Adam314Commented:
Or you could create an environment variable named PERL5LIB that contains the directory that the modules are in.
0
 
mjcoyneCommented:
If the module is in the same directory as the script, and the server cannot find the module but can find the script, add the line:

use lib qw(.);

to the script before the line that loads the module.

You might consider using Linux as a development platform, even as a virtual machine guest under Windows, or switching to Apache as a webserver.
0
 
tjcst25Author Commented:
Ok.  I've added "use lib 'C:/Inetpub/wwwroot/undergraddb/cgi-bin/';" to app.pl, and now get a blank screen.  So it seems that it's not calling $dbapp->run();.  Again, all of this runs fine on our live server, but it is running Win2k3 Server with IIS6...
0
 
mjcoyneCommented:
I see 29 sub functions in UGDBApp.pm:

  sub setup
  sub teardown
  sub validate_session
  sub cgiapp_prerun
  sub cgiapp_postrun
  sub do_login
  sub do_login_verify
  sub do_main
  sub do_add_pre
  sub do_search_pre
  sub do_search
  sub do_report
  sub handle_add
  sub handle_chpass
  sub get_student_info
  sub do_view
  sub handle_logout
  sub handle_update
  sub do_passwd
  sub handle_delete
  sub handle_termgpa
  sub handle_awards
  sub handle_comments
  sub handle_del_gpa
  sub handle_del_awd
  sub handle_del_com
  sub handle_edit_gpa
  sub handle_edit_awd
  sub handle_edit_com

Unfortunately, none of them are called "run"...
0
 
tjcst25Author Commented:
So why would this work on our live server and not my test server?
0
 
tjcst25Author Commented:
I also need to keep the environment/server/etc the same as our live server...
0
 
tjcst25Author Commented:
Since the first proposal helped in the stated error, I'm accepting this as the answer.  I'm now trying to trouble-shoot problems with the Template Toolkit module (which is why I'm getting blank pages).
0

Featured Post

Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

  • 13
  • 5
  • 3
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now