#!/usr/bin/perl
# Copyright 2001-2024 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.
%lex = ( 'Edit' => 'Edit',
'Main' => 'Main',
'Record Updated' => 'Record Updated',
'Bold' => 'Bold',
'Required Field' => 'Required Field',
'Cannot open' => 'Cannot open',
'Edit Another Student' => 'Edit Another Student',
'Main' => 'Main',
'Contact' => 'Contact',
'Update' => 'Update',
'Withdrawn' => 'Withdrawn',
'Preregistration' => 'Preregistration',
'Record' => 'Record',
'Error' => 'Error',
'Students' => 'Students',
'Student' => 'Student',
'Password' => 'Password',
);
use CGI;
use DBI;
use Data::Password qw(:all);
# Config values for password Check; Other values minlen, maxlen
# loaded from configuration; See Data::Password docs for meaning.
my $g_studentpwd_groups = 0; # turn off character group (uppercase, lowercase, symbols) checking
my $g_studentpwd_following = 0; # turn off following character checking (keyboard, same)
# my $g_studentpwd_dictionary = 4; # if leave blank here, zeroed below.
my $self = 'studed.pl';
eval require "../etc/admin.conf";
if ( $@ ) {
print $lex{Error}. ": $@ \n";
die $lex{Error}. ": $@\n";
}
# Need r_ShowStudentPicture value
eval require "../etc/repcard.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 $q = new CGI;
print $q->header( -charset, $charset );
my %arr = $q->Vars;
my $dsn = "DBI:$dbtype:dbname=$dbase";
my $dbh = DBI->connect($dsn,$user,$password);
# Select table to Edit.
my ($table, $sth, $wd);
if ( not $arr{tb} ) { # no passed table to edit...
$arr{tb} = 'student';
}
if ( $arr{tb} eq 'wd' ){ # if passed a tb=wd param, then edit alt table.
$sth = $dbh->prepare("select * from studentwd where studid = ?");
$wd = qq{$lex{Withdrawn}};
$table = 'studentwd';
} elsif ( $arr{tb} eq 'prereg' ){ # if tb=pre then edit prereg table.
$sth = $dbh->prepare("select * from prereg where studid = ?");
$wd = qq{$lex{Preregistration}};
$table = 'prereg';
} else {
$sth = $dbh->prepare("select * from student where studid = ?");
$table = 'student';
}
my $title = qq{$lex{Edit} $lex{Student}};
print qq{$doctype\n$title\n};
print qq{\n};
print qq{$chartype\n\n};
print qq{[ $lex{Main} ]\n};
print qq{
$title
\n};
# Update the record
if ( $arr{writeflag} ) {
delete $arr{writeflag};
updateRecord();
}
# Load the record into a hash.
$sth->execute( $arr{id} );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
my $ref = $sth->fetchrow_hashref;
my %rec = %$ref;
$studnum = $rec{studnum};
# Populate password field if blank.
if ( not $rec{password} ) { # Add a password.
use Crypt::GeneratePassword qw(:all); # password generation.
$g_studentpwd_minfreq = .001;
$g_studentpwd_avgfreq = .001;
$g_studentpwd_lang = 'en'; # only en or de available.
my $password = word( $g_studentpwd_minlen, $g_studentpwd_maxlen,
$g_studentpwd_lang, $g_studentpwd_signs,
$g_studentpwd_caps, $g_studentpwd_minfreq,
$g_studentpwd_avgfreq );
$rec{password} = $password
}
print qq{\n\n};
# Display any medical information, put in Add / Edit buttons.
my $first = 1;
my %medical;
my $sth = $dbh->prepare("select * from student_medical where studnum = ?");
$sth->execute($studnum);
if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
while ( my $ref = $sth->fetchrow_hashref ) {
$medical{$ref->{id}} = $ref;
$first = 0;
}
print qq{
\n};
print qq{
Medical Information
\n};
print qq{
};
print qq{
\n};
print qq{
Open in New Tabs
\n};
#print qq{Add (new tab)\n};
foreach my $id ( keys %medical ) {
my %r = %{$medical{$id}};
print qq{
};
print qq{
\n};
print qq{
$r{category}
$r{description}
\n};
}
print qq{
\n};
print qq{\n};
#---------------
sub updateRecord {
#---------------
# foreach my $key ( sort keys %arr ) { print qq{K:$key VAL:$arr{$key} \n}; }
my $table = $arr{tb};
delete $arr{tb}; # delete table value
my $id = $arr{id};
delete $arr{id};
# foreach my $key (keys %arr){ print qq{K: $key VAL: $arr{$key} \n};}
# check for Password Quality... rest of configs at top of script
$MINLEN = $g_studentpwd_minlen;
$MAXLEN = $g_studentpwd_maxlen;
$GROUPS = $g_studentpwd_groups;
$FOLLOWING = $g_studentpwd_following;
if ( $g_studentpwd_dictionary ) {
$DICTIONARY = $g_studentpwd_dictionary;
} else {
$DICTIONARY = 0; # turn it off.
}
if ( IsBadPassword( $arr{password} ) ) {
print qq{