#! /usr/bin/perl # Copyright 2001-2020 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. my %lex = ('Main' => 'Main', 'Walkthrough' => 'Walkthrough', 'Description' => 'Description', 'Error' => 'Error', 'Delete' => 'Delete', 'Deleted' => 'Deleted', 'View' => 'View', 'Evaluation' => 'Evaluation', 'Evaluations' => 'Evaluations', 'Subject' => 'Subject', 'Name' => 'Name', 'Date' => 'Date', 'Title' => 'Title', 'Edit' => 'Edit', 'Yes' => 'Yes', 'Record' => 'Record', 'Are you sure' => 'Are you sure', 'Update' => 'Update', 'Updated' => 'Updated', 'No Records Found' => 'No Records Found', 'Areas of Strength' => 'Areas of Strength', 'Areas for Improvement' => 'Areas for Improvement', ); my $self = 'pwalkevalview.pl'; use DBI; use CGI; use Data::UUID; # Current Date my @tim = localtime(time); my $year = @tim[5] + 1900; my $month = @tim[4] + 1; my $day = @tim[3]; if (length($month) == 1) { $month = '0'.$month; } if (length($day) == 1) { $day = '0'.$day; } my $currdate = "$year-$month-$day"; # Read database access eval require "../../etc/admin.conf"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } my $dbtype = 'mysql'; # Setup Database access my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); my $q = new CGI; my %arr = $q->Vars; print $q->header( -charset, $charset ); # Page Header my $title = qq{$lex{Walkthrough} $lex{Evaluations}}; print qq{$doctype\n$title \n}; if ( $arr{page} == 1 ) { # load jQuery libs print qq{\n}; print qq{\n}; } print qq{$chartype\n\n}; print qq{
[ $lex{Main} ]
\n}; print qq{

$title

\n}; if ( not $arr{page} ) { showStartPage(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; showEvaluation(); } elsif ( $arr{page} == 2 ) { delete $arr{page}; editEvaluation(); } elsif ( $arr{page} == 3 ) { delete $arr{page}; updateEvaluation(); } elsif ( $arr{page} == 4 ) { delete $arr{page}; confirmDelete( $arr{id} ); } elsif ( $arr{page} == 5 ) { delete $arr{page}; deleteEval( $arr{id} ); } #----------------- sub editEvaluation { #----------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } print qq{
\n}; print qq{\n}; # Get Master Record my $sth = $dbh->prepare("select * from pwalk_eval where id = ?"); $sth->execute( $arr{id} ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $mref = $sth->fetchrow_hashref; my %mst = %$mref; my $mstid = $mst{id}; # Loop through all score records my $sth = $dbh->prepare("select * from pwalk_score where mstid = ? order by sequence"); $sth->execute( $mstid ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } print qq{

$mst{tfirstname} $mst{tlastname}\n}; print qq{ ($mst{title} – $mst{description}) $mst{adatetime}

\n}; print qq{
$lex{Subject} $mst{subject}
\n}; print qq{\n}; print qq{\n}; print qq{\n}; while ( my $ref = $sth->fetchrow_hashref ) { %r = %$ref; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; } print qq{\n}; print qq{\n}; print qq{\n}; print qq{
$lex{Evaluation}
$r{description} ($r{category})
Score}; print qq{
$lex{'Areas of Strength'}}; print qq{
$lex{'Areas for Improvement'}}; print qq{
General Comments}; print qq{
Continue Editing}; my $checked; if ( $mst{continueedit} ) { $checked = qq{checked="checked"}; } print qq{
\n}; print qq{\n}; exit; } # end of editEvaluation #----------------- sub showEvaluation { #----------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } # Get Master Record my $sth = $dbh->prepare("select * from pwalk_eval where id = ?"); $sth->execute( $arr{id} ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $mref = $sth->fetchrow_hashref; my %mst = %$mref; my $mstid = $mst{id}; # Loop through all template records my $sth = $dbh->prepare("select * from pwalk_score where mstid = ? order by sequence"); $sth->execute( $mstid ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } print qq{

$mst{tfirstname} $mst{tlastname}\n}; print qq{ ($mst{title} – $mst{description}) $mst{adatetime}

\n}; print qq{
$lex{Subject} $mst{subject}
\n}; print qq{\n}; print qq{\n}; while ( my $ref = $sth->fetchrow_hashref ) { %r = %$ref; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; } print qq{\n}; print qq{
$lex{Evaluation}
$r{description} ($r{category})
Score$r{score}
$lex{'Areas of Strength'}$r{strengths}
$lex{'Areas for Improvement'}$r{weaknesses}
General Comments$mst{comment}
\n}; print qq{\n}; exit; } # end of showEvaluation #------------------- sub updateEvaluation { #------------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } # Don't mess up existing; pull out value. my $continueedit = $arr{continueedit}; delete $arr{continueedit}; my $sth1 = $dbh->prepare("update pwalk_eval set comment = ? where id = ?"); foreach my $key ( keys %arr ) { my ($val, $recid ) = split(':', $key); if ( $val eq 'MSTCOM' ) { # update master record $sth1->execute( $arr{$key}, $recid ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } if ( $continueedit ) { # set value my $sth2 = $dbh->prepare("update pwalk_eval set continueedit = 1 where id = ?"); $sth2->execute( $recid ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } } else { # clear value my $sth2 = $dbh->prepare("update pwalk_eval set continueedit = NULL where id = ?"); $sth2->execute( $recid ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } } } else { # do the rest my $sth = $dbh->prepare("update pwalk_score set $val = ? where id = ?"); $sth->execute( $arr{$key}, $recid ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } } } print qq{

$lex{Record} $lex{Updated}

\n}; print qq{

[ $title ]

\n}; print qq{\n}; exit; } #---------------- sub showStartPage { #---------------- # Get the Evaluations my $sth = $dbh->prepare("select * from pwalk_eval order by adatetime desc, tlastname, tfirstname"); $sth->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } $first = 1; while ( my $ref = $sth->fetchrow_hashref ) { my %r = %$ref; if ( $first ) { print qq{\n}; print qq{\n}; print qq{\n}; $first = 0; } print qq{}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; } if ( $first ) { print qq{

$lex{'No Records Found'}

\n}; } else { print qq{
$lex{Name}$lex{Date}$lex{Title}$lex{Description}
$r{tlastname}, $r{tfirstname}$r{adatetime}$r{title}$r{description}
\n}; print qq{\n}; print qq{\n}; print qq{
\n}; print qq{\n}; print qq{\n}; print qq{
\n}; print qq{\n}; print qq{\n}; print qq{
\n}; } print qq{\n}; exit; } #---------------- sub confirmDelete { #---------------- my $id = shift; # Load Record my $sth = $dbh->prepare("select * from pwalk_eval where id = ?"); $sth->execute( $id ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $ref = $sth->fetchrow_hashref; my %r = %$ref; print qq{\n}; print qq{}; print qq{\n}; print qq{}; print qq{\n}; print qq{}; print qq{\n}; print qq{}; print qq{\n}; print qq{
$lex{Name}$r{tfirstname} $r{tlastname}
$lex{Date}$r{adatetime}
$lex{Title}$r{title}
$lex{Description}$r{description}
\n}; print qq{

$lex{Delete} $lex{Record}: $lex{'Are you sure'}?

\n}; print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{
\n}; exit; } #--------------- sub deleteEval { #--------------- # foreach my $key ( sort keys %arr) { print qq{K:$key V:$arr{$key}
\n}; } my $id = shift; # load the record my $sth = $dbh->prepare("select * from pwalk_eval where id = ?"); $sth->execute( $id ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $ref = $sth->fetchrow_hashref; my %r = %$ref; my $sth = $dbh->prepare("delete from pwalk_score where mstid = ?"); $sth->execute( $id ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } $sth = $dbh->prepare("delete from pwalk_eval where id = ?"); $sth->execute( $id ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } print qq{

$lex{Record} $lex{Deleted}: $r{tfirstname} $r{tlastname} - $r{title}

\n}; print qq{

[ $title ]

\n}; print qq{\n}; exit; }