#!/usr/bin/perl # Copyright 2001-2008 Leslie Richardson # This file is part of Open Admin for Schools. # Open Admin for Schools is free software; you can redistribute it # and/or modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 of # the License, or (at your option) any later version. # Language Support my %lex = ('The Tab Key = next field.' => 'The Tab Key = next field.', 'Shift+Tab = previous field.' => 'Shift+Tab = previous field.', 'The Space Bar selects a checkbox.' => 'The Space Bar selects a checkbox.', 'The Up/Down Arrow keys select pulldown menus.' => 'The Up/Down Arrow keys select pulldown menus.', 'The Mouse kills key entry productivity.' => 'The Mouse kills key entry productivity.', 'No Entry' => 'No Entry', 'Add Student' => 'Add Student', 'Unable to open template file' => 'Unable to open template file', 'Save Record to Student Table' => 'Save Record to Student Table', 'Save Record to Pre-Registration Table' => 'Save Record to Pre-Registration Table', 'Save Record to Waiting List' => 'Save Record to Waiting List', 'Required Field' => 'Required Field', 'Bold' => 'Bold', 'Enrollment Date' => 'Enrollment Date', 'Entry Error' => 'Entry Error', 'No Student(s) Found' => 'No Student(s) Found', 'Clone this record' => 'Clone this record', 'Error' => 'Error', 'Main' => 'Main', ); my $self = 'sentry1.pl'; use CGI; use DBI; my $q = new CGI; print $q->header; my %arr = $q->Vars; # strip off leading text... $arr{entrytype} =~ s/(.*)\((.*)\)/$2/; eval require "../../etc/admin.conf"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } eval require "../../lib/libmeta.pl"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } my @tim = localtime(time); my $year = @tim[5] + 1900; my $month = @tim[4] + 1; my $day = @tim[3]; my $currdate = "$year-$month-$day"; $dsn = "DBI:$dbtype:dbname=$dbase"; $dbh = DBI->connect($dsn,$user,$password); print "$doctype\n". $lex{'Add Student'}. " $chartype\n

". $lex{'Add Student'}. "

\n"; print "[ ". $lex{Main}. " ]\n"; if ( $arr{clone} ) { showCloneResults( $arr{clone} ); } print "

"$lex{'The Tab Key = next field.'}" "$lex{'Shift+Tab = previous field.'}" "$lex{'The Space Bar selects a checkbox.'}" "$lex{'The Up/Down Arrow keys select pulldown menus.'}" "$lex{'The Mouse kills key entry productivity.'}"

\n"; if ( $arr{waitlist} ) { print "\n"; } elsif ( $arr{prereg} ) { print "\n"; } else { print "\n"; } print " ". $lex{'Enrollment Date'}. "   [ ". $lex{Bold}. " = ". $lex{'Required Field'}. " ] \n"; # Read in Template unless (open (FH,"<../../template/student.tpl")) { print $lex{'Unable to open template file'}. ": $!\n"; die $lex{'Unable to open template file'}. ": $!\n"; } my $text; { local $/; $text = ; close FH;} # Create meta hash - %fields fieldid => fieldname my $sth = $dbh->prepare("select id, fieldid, fieldname, required from meta where tableid = 'student'"); # order doesn't matter. $sth->execute; if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } while (my ($id, $fieldid, $fieldname, $required) = $sth->fetchrow) { if ( uc($required) eq 'Y') { $fields{$fieldid} = "$fieldname"; } else { $fields{$fieldid} = $fieldname; } } # Now put replacement text back in. $text =~ s{\<\*(.*?)\*\>} { exists($fields{$1}) ? $fields{$1} : $1 }gsex; # now parse for form entry replacement elements <*name*> while ( $text =~ m/\<\@(.*)\@\>/g){ push @fields, $1; } # get replacement values for fields foreach my $val ( @fields ) { if ( $val eq 'studnum' ){ $values{studnum} = $lex{'No Entry'}; next; } $values{$val} = metaput('student',$val, $arr{clonestudnum}, 'edit'); } # now put back into $text variable... $text =~ s{\<\@(.*?)\@\>} { exists($values{$1}) ? $values{$1} : "$values{$1}-$1" }gsex; print $text,"\n"; if ( $arr{waitlist} ) { print "\n"; } elsif ( $arr{prereg} ) { print "\n"; } else { print "\n"; } print "\n"; #------------------- sub showCloneResults { #------------------- my $student = shift; # Setup the Search if ($student =~ /\d+/) { # we have a student number $sth = $dbh->prepare("select studnum, lastname, firstname from student where studnum = ?"); $sth->execute( $student ); } else { # we have words hopefully with a comma ($lastname,$firstname) = split /\,/, $student; $firstname =~ s/^\s*//; $lastname =~ s/^\s*//; if ($lastname and $firstname){ # both entered. $sth = $dbh->prepare("select studnum, lastname, firstname from student where lastname = ? and firstname = ?"); $sth->execute( $lastname, $firstname ); } elsif ($lastname and not $firstname){ # only lastname (no comma) if (length($lastname) == 2){ # search by initials: fi, li. $fi = substr($lastname,0,1). '%'; $li = substr($lastname,1,1). '%'; $sth = $dbh->prepare("select studnum, lastname, firstname from student where lastname $sql{like} ? and firstname $sql{like} ?"); $sth->execute( $li, $fi ); } else { $sth = $dbh->prepare("select studnum, lastname, firstname from student where lastname = ? order by firstname"); $sth->execute( $lastname ); } } else { # print an error.... print '

'. $lex{'Entry Error'}. ': '. $lex{'No Student(s) Found'}.".

\n"; print "\n"; return; } } # Last Else if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; } $rows = $sth->rows; if ($rows < 1) { print '

'. $lex{'No Student(s) Found'}. ".

\n"; print "\n"; return; } delete $arr{clone}; # remove so will correctly load on looping... print "\n"; # Loop through and display all records. while ( my ( $studnum, $lastname, $firstname ) = $sth->fetchrow ) { if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; } print "\n"; } # End of Loop print "
"; print "
\n"; print "\n"; foreach my $key (keys %arr) { print "\n"; #print "K:$key V:$arr{$key}
\n"; } print "$firstname $lastname ($studnum)\n"; print "\n"; print "
\n"; exit; }