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
tjcst25Asked:
Who is Participating?
 
kawasConnect With a Mentor Commented:
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
 
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
Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

 
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.