You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
509 lines
20 KiB
509 lines
20 KiB
4 months ago
|
#!/usr/bin/perl
|
||
|
#
|
||
|
# Source File: Likert_Gen_Groups.pl
|
||
|
|
||
|
# Get config
|
||
|
use FileHandle;
|
||
|
use Time::Local;
|
||
|
use Data::Dumper;
|
||
|
use IntegroLib;
|
||
|
require 'sitecfg.pl';
|
||
|
require 'testlib.pl';
|
||
|
require 'tstatlib.pl';
|
||
|
require 'LikertData.pl' ;
|
||
|
require 'grepa.pm' ;
|
||
|
|
||
|
use strict;
|
||
|
use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST
|
||
|
%SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS %SYSTEM %REPORT
|
||
|
%SUBTEST_RESPONSES @xlatphrase);
|
||
|
use vars qw($testcomplete $cgiroot $pathsep $dataroot @rptparams );
|
||
|
use vars qw($testinprog $testpending) ;
|
||
|
|
||
|
# &app_initialize;
|
||
|
|
||
|
$FORM{"idlist"} =~ tr/\000/,/ ; # Change separator for multiple values from NULL to comma. HBI
|
||
|
|
||
|
&LanguageSupportInit();
|
||
|
# print STDERR Dumper(\%FORM);
|
||
|
&get_client_profile($SESSION{'clid'});
|
||
|
# warn "Tstid $FORM{'tstid'}\n" ;
|
||
|
&get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
|
||
|
|
||
|
# Make sure we have a valid session, and exit if we don't
|
||
|
if (not &get_session($FORM{'tid'})) {
|
||
|
exit(0);
|
||
|
}
|
||
|
|
||
|
# Get the group filters, if any
|
||
|
my ($idlist,$groups);
|
||
|
if (exists $FORM{'grouping'} and $FORM{'grouping'} eq 'subset') {
|
||
|
#my @tmp = split(/,/,$FORM{'idlist'});
|
||
|
my @tmp = param('idlist');
|
||
|
$FORM{'idlist'} = join(',', @tmp);
|
||
|
@{$groups}{@tmp} = @tmp;
|
||
|
$idlist = &getIdlist($CLIENT{'clid'},$FORM{'idlist'});
|
||
|
}
|
||
|
|
||
|
# Get the time stamp style
|
||
|
my $timestamp;
|
||
|
if ($FORM{'timestamp'} eq 'currenttime') {
|
||
|
$timestamp = scalar(localtime(time));
|
||
|
} elsif ($FORM{"timestamp"} eq 'custom' and $FORM{'customtime'} ne '') {
|
||
|
$timestamp = $FORM{'customtime'};
|
||
|
} elsif ($FORM{'timestamp'} eq 'mostrecent' and $FORM{'tstid'}) {
|
||
|
my $file = join($pathsep,$testcomplete,"$CLIENT{'clid'}.$FORM{'tstid'}.history");
|
||
|
my $fh = new FileHandle;
|
||
|
if ($fh->open($file)) {
|
||
|
my @history = map([split(/(?:<<>>|&)/,$_,4)],<$fh>);
|
||
|
# print "<pre>".Dumper(\@history)."</pre>";
|
||
|
if (defined $idlist) {
|
||
|
foreach (reverse @history) {
|
||
|
if (exists $idlist->{$_->[2]}) {
|
||
|
$timestamp = scalar(localtime(toGMSeconds($_->[0])));
|
||
|
last;
|
||
|
}
|
||
|
}
|
||
|
} else {
|
||
|
$timestamp = scalar(localtime(toGMSeconds($history[$#history]->[0])));
|
||
|
}
|
||
|
} else {
|
||
|
print STDERR "Could not open $file in Integro.pl\n";
|
||
|
}
|
||
|
}
|
||
|
if (defined $timestamp) {
|
||
|
$timestamp = "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$timestamp</b></font><br><BR>\n";
|
||
|
} else {
|
||
|
$timestamp = "<br>\n";
|
||
|
}
|
||
|
|
||
|
# Generate the reports
|
||
|
if ($FORM{'reportname'} eq 'LikertWQ') {
|
||
|
&LikertWQ($idlist, $groups, $timestamp);
|
||
|
} elsif ($FORM{'reportname'} eq 'LikertWQG') {
|
||
|
&LikertWQG($idlist, $groups, $timestamp);
|
||
|
} else {
|
||
|
&ReportChooser();
|
||
|
}
|
||
|
|
||
|
# There should only be function definitions beyond this point.
|
||
|
exit(0);
|
||
|
|
||
|
sub HTMLHeader {
|
||
|
return "<html>\n<head>\n<title>$_[0]</title>\n".
|
||
|
"<!--Integro3.pl-->\n".
|
||
|
"<script language=\"JavaScript\">\n<!-- \n$_[1]\n -->\n</script>\n</head>\n".
|
||
|
"<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"".
|
||
|
" TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"".
|
||
|
" VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\">\n";
|
||
|
}
|
||
|
|
||
|
sub HTMLHeaderPlain {
|
||
|
return "<html>\n<head>\n<title>$_[0]</title>\n".
|
||
|
"<script language=\"JavaScript\">\n<!-- \n$_[1]\n -->\n</script>\n</head>\n".
|
||
|
"<BODY>\n";
|
||
|
}
|
||
|
|
||
|
sub HTMLFooter {
|
||
|
my $year = `date +%Y`;
|
||
|
my $ionline;
|
||
|
if ($ENV{'SERVER_NAME'} =~ "integroonline.com") {
|
||
|
$ionline = "<br>Copyright (c) $year, Integro Learning Company";
|
||
|
}
|
||
|
return "<br><center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">Copyright (c) $year, ACTS Corporation$ionline<center></font></body>\n</html>\n";
|
||
|
}
|
||
|
|
||
|
sub ReportChooser {
|
||
|
# Links w/javascript for chosing report
|
||
|
# Radio button to choose between all and select group(s)
|
||
|
# Menu box to chose one or more groups
|
||
|
my $groups = &getGroups($CLIENT{'clid'});
|
||
|
my $js = "function parmsIntegro(oform,rpt) {\n\t".
|
||
|
"oform.reportname.value=rpt;\n\t".
|
||
|
"oform.action='/cgi-bin/creports.pl';\n\t".
|
||
|
"oform.submit();\n};\n";
|
||
|
$js .= "\nfunction commIntegro(oform) {\n\t".
|
||
|
"oform.rptid.value='ACT-C-004';\n\t".
|
||
|
"oform.rptdesc.value='Test Statistics by Test'\n\t".
|
||
|
"oform.action='/cgi-bin/IntegroTS.pl';\n\t".
|
||
|
"oform.submit();\n};\n";
|
||
|
my $organizationname = $CLIENT{'clnmc'};
|
||
|
my $uberheader;
|
||
|
my $TESTS = get_data_hash ("tests.$CLIENT{'clid'}") ;
|
||
|
# print STDERR Dumper($TESTS) ;
|
||
|
my %TESTS = %$TESTS ;
|
||
|
my @test_list = () ;
|
||
|
my $ids ;
|
||
|
for $ids (keys %TESTS) {
|
||
|
# warn "ID $ids DATADESC $TESTS{$ids}->{'desc'} X" ;
|
||
|
push @test_list, [$TESTS{$ids}->{'desc'}, $ids] ;
|
||
|
}
|
||
|
# warn "test_list count $#test_list X\n" ;
|
||
|
# print STDERR Dumper(\@test_list) ;
|
||
|
my ($js1, $test_choice_html) = ret_test_chooser_mod(@test_list) ;
|
||
|
|
||
|
#print STDERR get_data("tests.$CLIENT{'clid'}");
|
||
|
#print STDERR "Test ID = $tstid\n";
|
||
|
print HTMLHeader("Integro Learning Custom Reports",$js . $js1);
|
||
|
print "<form name=\"integrorpt\" action=\"/cgi-bin/creports.pl\" method=\"Post\" target=\"rptwindow\" enctype=\"multipart/form-data\" >\n";
|
||
|
print "<input type=\"hidden\" name=\"tid\" value=\"$SESSION{'tid'}\">\n";
|
||
|
# For development purposes we hardcode the survey id.
|
||
|
# Fix this before production
|
||
|
# print "<input type=hidden name=\"tstid\" value=\"\">\n"; # HBI This had a value of $tstid
|
||
|
print "<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">\n";
|
||
|
print "<input type=hidden name=\"rptdesc\" value=\"$REPORT{'rptdesc'}\">\n";
|
||
|
print "<input type=hidden name=\"rptid\" value=\"$REPORT{'rptid'}\">\n";
|
||
|
print "<input type=\"hidden\" name=\"reportname\" value=\"\">\n";
|
||
|
|
||
|
print "<center>\n<table border>\n<caption>Integro Learning Custom Reports</Caption>\n".
|
||
|
"<tr><td valign=\"top\"><input type=\"radio\" name=\"grouping\" value=\"all\" checked>All Groups</td>\n".
|
||
|
"<td valign=\"top\"><input type=\"radio\" name=\"grouping\" value=\"subset\">Choose Groups<br>\n".
|
||
|
"<select name=\"idlist\" onchange='this.form.grouping[1].click();' multiple>\n";
|
||
|
foreach (sort {$a->{'grpnme'} cmp $b->{'grpnme'}} values %$groups) {
|
||
|
print "<option value=\"$_->{'grpid'}\">$_->{'grpnme'}</option>\n";
|
||
|
}
|
||
|
print "</select>\n";
|
||
|
#print "<tr><td colspan=\"2\">$xlatphrase[797] $xlatphrase[279]: <input type=\"text\" name=\"orgname\" value=\"$organizationname\"></td></tr>\n";
|
||
|
print "<tr><td colspan=\"3\"><table border=0><tr><td>Organization Name:</td><td><input type=\"text\" name=\"orgname\" value=\"$organizationname\"></td></tr>\n";
|
||
|
print "<tr><td>Header Override:</td><td><input type=\"text\" name=\"uberheader\" value=\"$uberheader\"></td></tr></table></tr></td>\n";
|
||
|
print "<tr><td colspan=\"2\">Time Stamp:<ul style=\"list-style: none\">".
|
||
|
"<li><input type=\"radio\" name=\"timestamp\" value=\"mostrecent\" checked>Most Recent Survey Taken</li>".
|
||
|
"<li><input type=\"radio\" name=\"timestamp\" value=\"currenttime\">Current Time</li>".
|
||
|
"<li><input type=\"radio\" name=\"timestamp\" value=\"custom\">Custom Value: ".
|
||
|
"<input type=\"text\" name=\"customtime\"></li></tr></td>";
|
||
|
print "</table></center>\n";
|
||
|
print $test_choice_html ;
|
||
|
print "<p>Likert Scale Report" ;
|
||
|
print "<ul style=\"list-style: none\">" ;
|
||
|
print "<li><a href=\"javascript:parmsIntegro(document.integrorpt,'LikertWQ');\">Likert Scale</a> - No Response is zero, Question Numbers listed.</li>\n" ;
|
||
|
print "<li><a href=\"javascript:parmsIntegro(document.integrorpt,'LikertWQG');\">Likert Scale by Group</a> - No Response is zero, Detail by Groups.</li>\n" ;
|
||
|
print "</ul></p>\n" ;
|
||
|
print "<input type=hidden name=\"testsummary\" value=\"composite\">\n";
|
||
|
print "<input type=hidden name=\"showcmts\" value=\"donot\">\n";
|
||
|
print "</form>";
|
||
|
print HTMLFooter();
|
||
|
}
|
||
|
|
||
|
sub LikertWQ {
|
||
|
# This does the Summary on the Likert Scale questions,
|
||
|
# for everybody, or the Groups selected.
|
||
|
# $idlist is the list of candidate ids to report on. It is undef when all groups (everyone) is choosen.
|
||
|
# It is a reference to a hash. The keys are the candidate ids, and the value is 1 for candidates in the choosen groups.
|
||
|
# $groups is the hash of groups to report on. It is undef when all groups (everyone) is choosen.
|
||
|
# It is a reference to a hash. The keys are the group ids, and the values are the group ids.
|
||
|
# $FORM{'idlist'} is a comma separated list of the group ids of the selected groups.
|
||
|
# $FORM{'grouping'} is "subset" when the report should only cover the selected groups.
|
||
|
# $FORM{'grouping'} is "all" when the report should cover everybody.
|
||
|
# HBI - Pick it up here.
|
||
|
my ($idlist,$groups,$timestamp) = @_;
|
||
|
my $all_groups = getGroups($CLIENT{'clid'}) ;
|
||
|
my $group_membership_required ;
|
||
|
if ($groups) {
|
||
|
$group_membership_required = 1 ;
|
||
|
my $group_p ;
|
||
|
for $group_p (keys %{$all_groups}) {
|
||
|
unless ($groups->{$group_p}) {
|
||
|
undef $all_groups->{$group_p} ;
|
||
|
}
|
||
|
}
|
||
|
} else {
|
||
|
$group_membership_required = 0 ;
|
||
|
}
|
||
|
my ($sumdata, $grpdata) = &GetFullLikertGrpData($CLIENT{'clid'},$TEST{'id'},$all_groups, $group_membership_required) ;
|
||
|
# warn "sumdata" ;
|
||
|
# warn &Dumper(\$sumdata) ;
|
||
|
# warn "grpdata" ;
|
||
|
# warn &Dumper(\$grpdata) ;
|
||
|
|
||
|
print HTMLHeaderPlain("Likert Scale General Results");
|
||
|
print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\">" ;
|
||
|
print "<b>Likert Scale General Results<br>" ;
|
||
|
print "Survey/Test $TEST{'desc'}</b></font><br><br>\n";
|
||
|
# print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>Improvement as Perceived by Employees</b></font><br>\n";
|
||
|
# print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
|
||
|
if ($FORM{'uberheader'} ne "") {
|
||
|
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
|
||
|
} elsif (defined $idlist) {
|
||
|
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
|
||
|
.join(", ",map($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n" ;
|
||
|
} else {
|
||
|
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
|
||
|
}
|
||
|
print $timestamp;
|
||
|
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">" ;
|
||
|
|
||
|
my (@img_labels, @img_data) ;
|
||
|
my (@values2, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum) ;
|
||
|
my ($colorscheme, $t_margin, $b_margin, $l_margin, $r_margin ) ;
|
||
|
@img_labels = () ; @img_data = () ; @values2 = () ;
|
||
|
($t_margin, $b_margin, $l_margin, $r_margin) = (0, 0, 0, 30) ;
|
||
|
($xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, $colorscheme) =
|
||
|
(800, 100, 1, "$CLIENT{'clnmc'}", "Category", "Percent for Category", 100, 0, 10, 1) ;
|
||
|
|
||
|
# Print HTML for heading.
|
||
|
print "<b><table border>\n";
|
||
|
|
||
|
# Print first row.
|
||
|
print "<tr>" ;
|
||
|
print "<th colspan=\"5\">Category Scores</th>" ;
|
||
|
print "</tr>\n" ;
|
||
|
|
||
|
# Print second row. Heading for each column.
|
||
|
print "<tr>" ;
|
||
|
print "<th>Category</th>" ;
|
||
|
print "<th>Questions</th>" ;
|
||
|
print "<th>Points Possible</th>" ;
|
||
|
print "<th>Points Earned</th>" ;
|
||
|
print "<th>% Earned</th>" ;
|
||
|
print "</tr>\n" ;
|
||
|
|
||
|
# Loop for Categories.
|
||
|
my $tot_poss = 0 ; my $tot_earned = 0 ;
|
||
|
my $supercat ;
|
||
|
my @supercats = sort keys %{$sumdata} ;
|
||
|
for $supercat (@supercats) {
|
||
|
my $questions = "" ;
|
||
|
my $possible = 0 ;
|
||
|
my $earned = 0 ;
|
||
|
$questions = join(", ", sort keys %{$sumdata->{$supercat}->{'Questions'}}) ;
|
||
|
$possible = $sumdata->{$supercat}->{'PointsAvail'} ;
|
||
|
$earned = $sumdata->{$supercat}->{'PointsEarned'} ;
|
||
|
$tot_poss += $possible ;
|
||
|
$tot_earned += $earned ;
|
||
|
print "<tr>" ;
|
||
|
print "<th>$supercat</th>" ;
|
||
|
print "<td>$questions</td>" ;
|
||
|
print "<td>$possible</td>" ;
|
||
|
print &rep_cell_str($earned, $possible) ;
|
||
|
push @img_labels, $supercat ;
|
||
|
my ($percent) = int ((100.0 * $earned / $possible) +0.5) ;
|
||
|
push @img_data, $percent ;
|
||
|
$ydim += 15 ; # add length to the chart for another row.
|
||
|
print "</tr>\n" ;
|
||
|
}
|
||
|
|
||
|
# Print Total row.
|
||
|
print "<tr>" ;
|
||
|
print "<th colspan=\"2\">Total</th>" ;
|
||
|
print "<td>$tot_poss</td>" ;
|
||
|
print &rep_cell_str($tot_earned, $tot_poss) ;
|
||
|
print "</tr>\n" ;
|
||
|
|
||
|
print "</tr>\n" ;
|
||
|
print "</table>\n" ;
|
||
|
|
||
|
if (@supercats) {
|
||
|
print "<br><br>\n" ;
|
||
|
print BuildBarGraph(\@img_labels, \@img_data, \@values2, $xdim,
|
||
|
$ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum,
|
||
|
$colorscheme, $t_margin, $b_margin, $l_margin, $r_margin) ;
|
||
|
print "<br><br>\n" ;
|
||
|
}
|
||
|
|
||
|
print HTMLFooter();
|
||
|
}
|
||
|
|
||
|
sub LikertWQG {
|
||
|
# This does the Summary on the Likert Scale questions,
|
||
|
# for everybody, or just groups, and lists group results.
|
||
|
# $idlist is the list of candidate ids to report on. It is undef when all groups (everyone) is choosen.
|
||
|
# It is a reference to a hash. The keys are the candidate ids, and the value is 1 for candidates in the choosen groups.
|
||
|
# $groups is the hash of groups to report on. It is undef when all groups (everyone) is choosen.
|
||
|
# It is a reference to a hash. The keys are the group ids, and the values are the group ids.
|
||
|
# $FORM{'idlist'} is a comma separated list of the group ids of the selected groups.
|
||
|
# $FORM{'grouping'} is "subset" when the report should only cover the selected groups.
|
||
|
# $FORM{'grouping'} is "all" when the report should cover everybody.
|
||
|
# HBI - Pick it up here.
|
||
|
my ($idlist,$groups,$timestamp) = @_;
|
||
|
my $all_groups = getGroups($CLIENT{'clid'}) ;
|
||
|
my $group_membership_required ;
|
||
|
if ($groups) {
|
||
|
$group_membership_required = 1 ;
|
||
|
my $group_p ;
|
||
|
for $group_p (keys %{$all_groups}) {
|
||
|
unless ($groups->{$group_p}) {
|
||
|
undef $all_groups->{$group_p} ;
|
||
|
}
|
||
|
}
|
||
|
} else {
|
||
|
$group_membership_required = 0 ;
|
||
|
}
|
||
|
my ($sumdata, $grpdata) = &GetFullLikertGrpData($CLIENT{'clid'},$TEST{'id'},$all_groups, $group_membership_required) ;
|
||
|
# warn "sumdata" ;
|
||
|
# warn &Dumper(\$sumdata) ;
|
||
|
# warn "grpdata" ;
|
||
|
# warn &Dumper(\$grpdata) ;
|
||
|
|
||
|
print HTMLHeaderPlain("Likert Scale Group Results");
|
||
|
print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\">" ;
|
||
|
print "<b>Likert Scale Group Results<br>" ;
|
||
|
print "Survey/Test $TEST{'desc'}</b></font><br><br>\n";
|
||
|
# print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>Improvement as Perceived by Employees</b></font><br>\n";
|
||
|
# print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
|
||
|
if ($FORM{'uberheader'} ne "") {
|
||
|
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
|
||
|
} elsif (defined $idlist) {
|
||
|
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
|
||
|
.join(", ",map($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n" ;
|
||
|
} else {
|
||
|
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
|
||
|
}
|
||
|
print $timestamp;
|
||
|
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">" ;
|
||
|
|
||
|
# Print HTML for heading.
|
||
|
print "<b><table border>\n";
|
||
|
|
||
|
my $cat_count = keys %{$sumdata} ; # Number of categories.
|
||
|
# Print first row.
|
||
|
print "<tr>" ;
|
||
|
print "<th ></th>" ;
|
||
|
my $supercat ;
|
||
|
foreach $supercat (sort keys %{$sumdata}) {
|
||
|
print "<th >$supercat</th>\n" ;
|
||
|
}
|
||
|
print "<th >Total</th>" ;
|
||
|
print "</tr>\n" ;
|
||
|
|
||
|
# Print second row. Heading for each column.
|
||
|
# Loop for Categories.
|
||
|
my $tot_poss = 0 ; my $tot_earned = 0 ;
|
||
|
print "<tr>" ;
|
||
|
print "<td >Overall</td >\n" ;
|
||
|
my @supercats = sort keys %{$sumdata} ;
|
||
|
for $supercat (@supercats) {
|
||
|
# my $questions = "" ;
|
||
|
my $possible = 0 ;
|
||
|
my $earned = 0 ;
|
||
|
# $questions = join(", ", sort keys %{$sumdata->{$supercat}->{'Questions'}}) ;
|
||
|
$possible = $sumdata->{$supercat}->{'PointsAvail'} ;
|
||
|
$earned = $sumdata->{$supercat}->{'PointsEarned'} ;
|
||
|
$tot_poss += $possible ;
|
||
|
$tot_earned += $earned ;
|
||
|
print &rep_cell_str($earned, $possible, 1) ;
|
||
|
}
|
||
|
print &rep_cell_str($tot_earned, $tot_poss, 1) ;
|
||
|
print "</tr>\n" ;
|
||
|
|
||
|
# Print heading for Groups.
|
||
|
my $col_count = $cat_count + 2 ;
|
||
|
print "<tr><th colspan=\"${col_count}\">Group Breakdown</th ></tr >\n" ;
|
||
|
|
||
|
print "<tr><th >Supervisor</th >" ;
|
||
|
for $supercat (@supercats) {
|
||
|
print "<th >$supercat</th >" ;
|
||
|
}
|
||
|
print "<th >Total</th ></tr >\n" ;
|
||
|
|
||
|
unless ($grpdata) {
|
||
|
print "<tr><td colspan=\"${col_count}\">Pick Groups for more detail</td ></tr >\n" ;
|
||
|
} else {
|
||
|
my $group ;
|
||
|
foreach $group (sort keys %{$grpdata}) {
|
||
|
if ($group) {
|
||
|
print "<tr >" ;
|
||
|
print "<td >" ;
|
||
|
# print "$group " ;
|
||
|
print $all_groups->{$group}->{'grpnme'} ;
|
||
|
print "</td >" ;
|
||
|
my $tot_poss = 0 ; my $tot_earned = 0 ;
|
||
|
for $supercat (@supercats) {
|
||
|
my $possible = $grpdata->{$group}->{$supercat}->{'PointsAvail'} ;
|
||
|
my $earned = $grpdata->{$group}->{$supercat}->{'PointsEarned'} ;
|
||
|
$tot_poss += $possible ;
|
||
|
$tot_earned += $earned ;
|
||
|
print &rep_cell_str($earned, $possible, 1) ;
|
||
|
}
|
||
|
print &rep_cell_str($tot_earned, $tot_poss, 1) ;
|
||
|
print "</tr>\n" ;
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
print "</table>\n" ;
|
||
|
|
||
|
print HTMLFooter();
|
||
|
}
|
||
|
|
||
|
sub rep_cell_str {
|
||
|
# Parameters
|
||
|
# $count - required, number for the cell, integer.
|
||
|
# $total - dividend for the percent, integer.
|
||
|
# $skip_tot - Optional, default false.
|
||
|
# If true, do not print total.
|
||
|
# Returned Value
|
||
|
# $html_str - html string to print for the cell.
|
||
|
my ($count, $total, $skip_tot) = @_ ;
|
||
|
my $html_str ;
|
||
|
$html_str .= "<td align=\"center\">" unless ($skip_tot) ;
|
||
|
my ($percent, $percent_str, $count_str) ;
|
||
|
$count_str = sprintf("%4i", $count) ;
|
||
|
if ($total == 0) {
|
||
|
# total is 0, percent is undefined.
|
||
|
$percent_str = "- - %" ;
|
||
|
} else {
|
||
|
$percent = 100.0 * $count / $total ;
|
||
|
$percent_str = sprintf("%5.1f %%", $percent) ;
|
||
|
}
|
||
|
$html_str .= "$count_str</td>" unless ($skip_tot) ;
|
||
|
$html_str .= "<td align=\"right\">" ;
|
||
|
$html_str .= "$percent_str</td>" ;
|
||
|
return $html_str ;
|
||
|
}
|
||
|
|
||
|
sub ret_test_chooser_mod {
|
||
|
# Return strings of html to pick a survey.
|
||
|
# The parameter is an array of arrays with test descriptions and ids.
|
||
|
# The returned value is an array with two strings.
|
||
|
# The first string is JavaScript for the test chooser.
|
||
|
# The second string is html for the tables to drive the test chooser.
|
||
|
my @trecs = @_;
|
||
|
# print STDERR Dumper(\@trecs) ;
|
||
|
my ($testscompleted, $testsinprogress, $testspending, $href, $tstoption, $tstoptions);
|
||
|
my $html_str = "" ;
|
||
|
my $js = "function setTest(oform,test) {\n\t".
|
||
|
"oform.tstid.value=test;\n\t".
|
||
|
"oform.submit();\n};\n";
|
||
|
for (0 .. $#trecs) {
|
||
|
my ($desc,$id) ;
|
||
|
$desc = $trecs[$_][0] ;
|
||
|
$id = $trecs[$_][1] ;
|
||
|
# warn "RET_TEST_CHOOSER_MOD ID $id DESC $desc X" ;
|
||
|
$testscompleted = CountTestFiles($testcomplete,$CLIENT{'clid'},$id);
|
||
|
$testsinprogress = CountTestFiles($testinprog, $CLIENT{'clid'},$id);
|
||
|
$testspending = CountTestFiles($testpending, $CLIENT{'clid'},$id);
|
||
|
$href="javascript:setTest(document.testform1,\'$id\')\;";
|
||
|
my $radio_tst_button ;
|
||
|
$radio_tst_button = '<input type="radio" name="tstid" value="' . $id .
|
||
|
'" > ' . $id ;
|
||
|
$tstoption = " <TR>" .
|
||
|
# "<TD valign=top><FONT SIZE=2><a href=\"$href\">$id</a></FONT></TD>" .
|
||
|
"<TD valign=top><FONT SIZE=2>$radio_tst_button</FONT></TD>" .
|
||
|
"<TD valign=top><FONT SIZE=2>$desc</FONT></TD>" .
|
||
|
"<TD align=right valign=top><FONT SIZE=2>$testscompleted</FONT></TD>" .
|
||
|
"<TD align=right valign=top><FONT SIZE=2>$testsinprogress</FONT></TD>" .
|
||
|
"<TD align=right valign=top><FONT SIZE=2>$testspending</FONT></TD> </TR>\n";
|
||
|
$tstoptions = join('', $tstoptions, $tstoption);
|
||
|
}
|
||
|
$html_str = "<CENTER><B>Please choose the survey for which you would like reports:</B><br>" .
|
||
|
# "<form name=\"testform1\" action=\"/cgi-bin/creports.pl\" method=\"Post\">" .
|
||
|
# "<input type=\"hidden\" name=\"tid\" value=\"$SESSION{'tid'}\">" .
|
||
|
# "<input type=\"hidden\" name=\"tstid\" value=\"\">" .
|
||
|
# "<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">" .
|
||
|
# "</form>" .
|
||
|
"<TABLE cellpadding=1 cellspacing=1 border=0 width=\"100\%\">" .
|
||
|
"<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
|
||
|
"<TR>" .
|
||
|
"<TD valign=top><B><FONT SIZE=1>Test ID</FONT></B></TD>" .
|
||
|
"<TD valign=top><B><FONT SIZE=1>Description</FONT></B></TD>" .
|
||
|
"<TD align=right valign=top><B><FONT SIZE=1>Cmp</FONT></B></TD>" .
|
||
|
"<TD align=right valign=top><B><FONT SIZE=1>InP</FONT></B></TD>" .
|
||
|
"<TD align=right valign=top><B><FONT SIZE=1>Pnd</FONT></B></TD>" .
|
||
|
"</TR>" .
|
||
|
"<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
|
||
|
$tstoptions .
|
||
|
"<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
|
||
|
"</TABLE> " ;
|
||
|
return ($js, $html_str) ;
|
||
|
}
|
||
|
|