tjcst25
asked on
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:Und ergradDB", "undergrad db","***** ****",{Rai seError=>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')->dis connect();
}
########################## ########## ########## ########## ########## ##
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_TI ME'};
      $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_runmod e() 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->par am('new_mo de')) 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_runmod e() 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('passw ord'));
      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.h tml', $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_pr e.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_TYP E");
           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_TER M'}], ($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_Y EAR'}) = 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.htm l', $vars, \$output);
      }
      if($q->param('PeopleSoft') ) {
           my $vars = {
                 'USERNAME' => $self->param('username'),
                 'STUDENTS' => \@students,
           };
           my $template = Template->new( { 'INCLUDE_PATH' => '..' } );
           $template->process('people soft_repor t.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_SEMEST ER_TERM');
           my $rsyear = $q->param('RESEARCH_SEMEST ER_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_CATEGO RY'}} = $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_CURRICU LUM'});
      my @categories;
      while(my $hr = $sth->fetchrow_hashref) {
           my %hash = %$hr;
           $hash{'NOTES'} = $catnotes{$hash{'ID_CATEGO RY'}};
           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_CURRICU LUM'});
      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('I D_STUDENT' ));
      my %student = %{$sth->fetchrow_hashref() };
      my ($yyyy, $mm, $dd) = $student{'LAST_MODIFIED'} =~ /^(....)-(..)-(..).*$/;
      $student{'LAST_MODIFIED_ST R'} = "$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_ST R'}  = $t1[$student{'EXP_GRAD_TER M'}];
      $student{'EXP_GRAD_YEAR_ST R'} = ($student{'EXP_GRAD_YEAR'} + 1996);
      my %pmh = ('Y' => 'Yes', 'N' => 'No', 'U' => 'Unsure');
      $student{'PRE_MED_STR'} = $pmh{$student{'PRE_MED'}};
      ($student{'RESEARCH_SEMEST ER_TERM'}, $student{'RESEARCH_SEMESTE R_YEAR'}) = split /-/, $student{'RESEARCH_SEMESTE R'};
      $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('defaultgpate rm'),
           'YEAR' => $self->param('defaultgpaye ar'),
           'GPA'  => $self->param('defaultgpagp a')
      };
     Â
      my $default_awd = {
           'MON'  => $self->param('defaultawdmo n'),
           'YEAR' => $self->param('defaultawdye ar'),
           'NAME'  => $self->param('defaultawdna me')
      };
     Â
      my $default_com = {
           'MON'   => $self->param('defaultcommo n'),
           'DAY'   => $self->param('defaultcomda y'),
           'YEAR'   => $self->param('defaultcomye ar'),
           'COMMENT' => $self->param('defaultcomco mment')
      };
      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.h tml', $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_SEMEST ER_TERM') . '-' . $q->param('RESEARCH_SEMEST ER_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_SEMEST ER'),
           $q->param('RESEARCH_LAB'), $q->param('RESEARCH_PROJEC T'),
           $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('I D_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}_$i d")) ? 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}_$i d")) ? 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_curricul um);
      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('I D_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('I D_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('I D_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('I D_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('defaultgpate rm' => $gpa->{'TERM'});
      $self->param('defaultgpaye ar' => $gpa->{'YEAR'});
      $self->param('defaultgpagp a' => $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('defaultawdmo n' => $awd->{'MONTH'});
      $self->param('defaultawdye ar' => $awd->{'YEAR'});
      $self->param('defaultawdna me' => $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('defaultcommo n' => $com->{'MONTH'});
      $self->param('defaultcomda y' => $com->{'DAY'});
      $self->param('defaultcomye ar' => $com->{'YEAR'});
      $self->param('defaultcomco mment' => $com->{'COMMENT'});
}
1;
Anyone have any ideas? Â Perl certainly seems to work ok.
Thanks,
Tim
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:Und
      $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')->dis
}
##########################
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
      my $row_ref  = $sth->fetchrow_hashref();
      my $result  = defined $row_ref;
      my $old_time = $row_ref->{'LAST_ACCESS_TI
      $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
                 $sth->finish();
                Â
                 # Take user to login screen with error
                 $self->param('login_error'
                 $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
      # 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_runmod
           # 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')
           }
           # 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->par
                      $self->get_current_runmode
           }
      }
}
##########################
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_runmod
          Â
      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
      $template->process('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.
      $self->param('next_runmode
      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'
           $self->param('next_runmode
           return do_login($self);
      }
     Â
      # Get MD5 digest of given password
      my $md5 = Digest::MD5->new();
      $md5->add($q->param('passw
      my $digest = $md5->b64digest;
      # Compare new and stored digests
      if($digest ne $row->{'PASSWORD'}) {
           # Display login screen with error.
           $self->param('login_error'
           $self->param('next_runmode
           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
      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.h
      $self->param('next_runmode
      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_pr
      $self->param('next_runmode
     Â
      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
      $self->param('next_runmode
     Â
      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_TYP
           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
      $self->param('next_runmode
     Â
      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{'EXP_GRAD_DATE'} = sprintf "%s %d", $terms[$hash{'EXP_GRAD_TER
  $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'}
  ($hash{'RESEARCH_SEMESTER_
  $hash{'RESEARCH_SEMESTER_Y
  $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')
   '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')
   '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
 }
      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'}
                 $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_
      }
      if($q->param('PeopleSoft')
           my $vars = {
                 'USERNAME' => $self->param('username'),
                 'STUDENTS' => \@students,
           };
           my $template = Template->new( { 'INCLUDE_PATH' => '..' } );
           $template->process('people
      }
      $self->param('next_runmode
     Â
      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_SEMEST
           my $rsyear = $q->param('RESEARCH_SEMEST
           $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
                 $self->param('next_runmode
                 #do_passwd($self);
                 $self->prerun_mode('passwd
                 return 1;
           }
           my $sth = $dbh->prepare('SELECT * FROM U00_USERS WHERE USERNAME = ?');
           $sth->execute($self->param
           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
                 $self->param('next_runmode
                 #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->{'
      my %catnotes;
      while(my $hr = $sth->fetchrow_hashref) {
           $catnotes{$hr->{'ID_CATEGO
      }
      $sth->finish();
      # Grab requirements categories
      my $sth = $dbh->prepare('SELECT * FROM R00_CATEGORIES WHERE ID_CURRICULUM = ? ORDER BY SORT_INDEX');
      $sth->execute($student->{'
      my @categories;
      while(my $hr = $sth->fetchrow_hashref) {
           my %hash = %$hr;
           $hash{'NOTES'} = $catnotes{$hash{'ID_CATEGO
           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->{'
      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->{'
      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
                            $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->{'
      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->{'
      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
                 $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('I
      my %student = %{$sth->fetchrow_hashref()
      my ($yyyy, $mm, $dd) = $student{'LAST_MODIFIED'} =~ /^(....)-(..)-(..).*$/;
      $student{'LAST_MODIFIED_ST
      my @t1 = ('','Fall', 'Spring', 'Summer');
      $student{'START_TERM_STR'}
      $student{'START_YEAR_STR'}
      $student{'EXP_GRAD_TERM_ST
      $student{'EXP_GRAD_YEAR_ST
      my %pmh = ('Y' => 'Yes', 'N' => 'No', 'U' => 'Unsure');
      $student{'PRE_MED_STR'} = $pmh{$student{'PRE_MED'}};
      ($student{'RESEARCH_SEMEST
      $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
      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'}
      $self->param('titleprefix'
      my $default_gpa = {
           'TERM' => $self->param('defaultgpate
           'YEAR' => $self->param('defaultgpaye
           'GPA'  => $self->param('defaultgpagp
      };
     Â
      my $default_awd = {
           'MON'  => $self->param('defaultawdmo
           'YEAR' => $self->param('defaultawdye
           'NAME'  => $self->param('defaultawdna
      };
     Â
      my $default_com = {
           'MON'   => $self->param('defaultcommo
           'DAY'   => $self->param('defaultcomda
           'YEAR'   => $self->param('defaultcomye
           'COMMENT' => $self->param('defaultcomco
      };
      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.h
      $self->param('next_runmode
      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
      $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_SEMEST
      $q->param( 'RESEARCH_SEMESTER' => $rsem );
      $sth->execute(
           $q->param('GENDER'), $q->param('LAST_NAME'), $q->param('FIRST_NAME'),
           $q->param('MIDDLE_INITIAL'
           $q->param('EMAIL'), $q->param('START_TERM'),
           $q->param('START_YEAR'), $q->param('EXP_GRAD_TERM')
           $q->param('CONCENTRATION')
           $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_SEMEST
           $q->param('RESEARCH_LAB'),
           $q->param('SEMESTER_AT_SEA
           $q->param('COOP'), $q->param('BMES'), $q->param('TRANSFERRED_OUT
           $q->param('TRANSFERRED_IN'
           $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('I
      $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+)_(\
          Â
           # 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
                 my $flagH  = (defined $q->param("reqH_${cat}_$id
                 my $flagG  = (defined $q->param("reqG_${cat}_$id
                 my $flagAP = (defined $q->param("reqAP_${cat}_$i
                 my $flagW  = (defined $q->param("reqW_${cat}_$id
                 # 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}_
                 next KEY if!$crsName;
                 my $crsCat  = $q->param("crsCat_${cat}_$
                 $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
                 my $flagH  = (defined $q->param("crsH_${cat}_$id
                 my $flagG  = (defined $q->param("crsG_${cat}_$id
                 my $flagAP = (defined $q->param("crsAP_${cat}_$i
                 my $flagW  = (defined $q->param("crsW_${cat}_$id
                 # 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_curricul
      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,
           $sth->finish();
      }
     Â
      # Deal with image upload
      if($q->param('IMAGE')) {
                 # explicitly set CGITemp directory to avoid permissions problems
                 $CGITempFile::TMPDIRECTORY
                 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,
                 $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
      $self->param('next_runmode
     Â
      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('I
      $sth->finish();
      # add this GPA information
      $sth = $dbh->prepare('INSERT INTO S00_GPAS (ID_STUDENT, TERM, YEAR, GPA) VALUES (?, ?, ?, ?)');
      $sth->execute($q->param('I
           $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('I
           $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('I
      $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('defaultgpate
      $self->param('defaultgpaye
      $self->param('defaultgpagp
}
##########################
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('defaultawdmo
      $self->param('defaultawdye
      $self->param('defaultawdna
}
##########################
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('defaultcommo
      $self->param('defaultcomda
      $self->param('defaultcomye
      $self->param('defaultcomco
}
1;
Anyone have any ideas? Â Perl certainly seems to work ok.
Thanks,
Tim
what is your error?
ASKER
HTTP 500 Internal Server Error
This runs fine on our live webserver, but I'm getting this error on my development machine.
This runs fine on our live webserver, but I'm getting this error on my development machine.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
The error log should provide more details. Â Or you can try running it from the command prompt. Â What happens then?
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.
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.
ASKER
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
Thanks for the info. Â I'll let you know if something simple like packages are missing.
u-ex081107.log
ASKER
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.
ASKER
The database and ODBC connection seem fine, but I'll triple check those too.
ASKER
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;
The log you attached looks like the access log. Â Can you attach the error log?
ASKER
Can you point me to where the error log may be? Â I have no entries in the Event Viewer->Applications and Services->Microsoft->Windo ws->HttpSe rvice->HTT P Service Channel log.
Thank you!
Thank you!
ASKER
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
Tim
500-trace.jpg
Are the permissions set correctly for app.pl?
ASKER
I've given Everyone full permissions to cover all of the bases and still get the 500 error. Â
Tim
Tim
Can you log-in as the webserver user and try running it from the command line?
ASKER
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
Tim
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.
Add a
use lib 'C:/path/to/modules';
to the script.
Or you could create an environment variable named PERL5LIB that contains the directory that the modules are in.
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.
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.
ASKER
Ok. Â I've added "use lib 'C:/Inetpub/wwwroot/underg raddb/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...
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"...
 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"...
ASKER
So why would this work on our live server and not my test server?
ASKER
I also need to keep the environment/server/etc the same as our live server...
ASKER
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).