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.
221 lines
7.6 KiB
221 lines
7.6 KiB
4 months ago
|
#!/usr/bin/perl
|
||
|
|
#
|
||
|
|
# $Header: /usr/local/cvsroot/Testmanager/cgi-bin/uwex.pl,v 1.1 2005/02/10 20:29:57 ddoughty Exp $
|
||
|
|
#
|
||
|
|
# Source File: uwex.pl
|
||
|
|
|
||
|
|
# Get config
|
||
|
|
use FileHandle;
|
||
|
|
use Time::Local;
|
||
|
|
use Data::Dumper;
|
||
|
|
use IntegroLib;
|
||
|
|
require 'sitecfg.pl';
|
||
|
|
require 'testlib.pl';
|
||
|
|
require 'tstatlib.pl';
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST
|
||
|
|
%SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS %SYSTEM %REPORT
|
||
|
|
%SUBTEST_RESPONSES);
|
||
|
|
use vars qw($testcomplete $cgiroot $pathsep $dataroot );
|
||
|
|
|
||
|
|
&app_initialize;
|
||
|
|
|
||
|
|
$FORM{"idlist"} =~ tr/\000/,/ ; # Change separator for multiple values from NULL to comma. HBI
|
||
|
|
|
||
|
|
&LanguageSupportInit();
|
||
|
|
#print STDERR Dumper(\%SESSION);
|
||
|
|
&get_client_profile($SESSION{'clid'});
|
||
|
|
&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'});
|
||
|
|
@{$groups}{@tmp} = @tmp;
|
||
|
|
$idlist = &getIdlist($CLIENT{'clid'},$FORM{'idlist'});
|
||
|
|
}
|
||
|
|
|
||
|
|
# Generate the reports
|
||
|
|
if ($FORM{'reportname'} eq 'comments') {
|
||
|
|
&CommentsReport($idlist);
|
||
|
|
} else {
|
||
|
|
&ReportChooser();
|
||
|
|
}
|
||
|
|
|
||
|
|
# There should only be function definitions beyond this point.
|
||
|
|
exit(0);
|
||
|
|
|
||
|
|
sub HTMLHeader {
|
||
|
|
return "<html>\n<head>\n<title>$_[0]</title>\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 {
|
||
|
|
return "<br><center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">Copyright (c) 2004, Integro Leadership Institute<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/teststats.pl';\n\t".
|
||
|
|
"oform.submit();\n};\n";
|
||
|
|
my $orgname = $CLIENT{'clnmc'};
|
||
|
|
my ($tstid) = grep((/(SAS01\s*)&/ && ($_=$1)),get_data("tests.$CLIENT{'clid'}"));
|
||
|
|
if (not $tstid) {
|
||
|
|
print HTMLHeader("Error! No Strategic Alignment Survey Found.");
|
||
|
|
print "<h1>Error! No Strategic Alignment Survey Found.</h1>\n";
|
||
|
|
print HTMLFooter();
|
||
|
|
}
|
||
|
|
#print STDERR get_data("tests.$CLIENT{'clid'}");
|
||
|
|
#print STDERR "Test ID = $tstid\n";
|
||
|
|
print HTMLHeader("Integro Learning Custom Reports",$js);
|
||
|
|
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=\"$tstid\">\n";
|
||
|
|
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 "<input type=\"hidden\" name=\"csv\" value=\"Y\">\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 "<tr><td colspan=\"2\">Organization Name: <input type=\"text\" name=\"orgname\" value=\"$orgname\"></td></tr>\n";
|
||
|
|
print "</table></center>\n";
|
||
|
|
print "<hr>\n";
|
||
|
|
print "<p>General Reports<ul style=\"list-style: none\"><li><a href=\"javascript:parmsIntegro(document.integrorpt,'comments');\">Comments</a> (CSV format)</li>";
|
||
|
|
print "<input type=hidden name=\"testsummary\" value=\"composite\">\n";
|
||
|
|
print "<input type=hidden name=\"showcmts\" value=\"donot\">\n";
|
||
|
|
print "</form>";
|
||
|
|
print HTMLFooter();
|
||
|
|
}
|
||
|
|
|
||
|
|
sub CommentsReport {
|
||
|
|
my ($idlist) = @_;
|
||
|
|
my @filelist = &get_test_result_files($testcomplete, $CLIENT{'clid'},$TEST{'id'});
|
||
|
|
my $comments = {};
|
||
|
|
my @users;
|
||
|
|
my @questions = map([split(/&/,$_)],&get_question_list($TEST{'id'},$CLIENT{'clid'}));
|
||
|
|
foreach (@questions) {$_->[4] =~ s/:::.*$//;}
|
||
|
|
foreach my $file (@filelist) {
|
||
|
|
my $user = $file;
|
||
|
|
$user =~ s/.$TEST{'id'}$//;
|
||
|
|
$user =~ s/^$CLIENT{'clid'}.//;
|
||
|
|
if (defined $idlist and not $idlist->{$user}) {
|
||
|
|
next;
|
||
|
|
}
|
||
|
|
push(@users, $user);
|
||
|
|
for (my $i=0; $i<=59; $i++) { $comments->{$user}->[$i] = ""; }
|
||
|
|
my ($answers,$usercomm) = &get_survey_results( $CLIENT{'clid'}, $user, $TEST{'id'});
|
||
|
|
for (my $i=1; $i<59; $i++) {
|
||
|
|
$comments->{$user}->[$i] = $usercomm->[$i];
|
||
|
|
$comments->{$user}->[$i] =~ s/\"//g;
|
||
|
|
}
|
||
|
|
$comments->{$user}->[59] = $answers->[59];
|
||
|
|
$comments->{$user}->[59] =~ s/\"//g;
|
||
|
|
}
|
||
|
|
|
||
|
|
# Randomize user list
|
||
|
|
my @tmp = @users;
|
||
|
|
@users = ();
|
||
|
|
my @itmp = ();
|
||
|
|
for (my $i=0; $i<=$#tmp; $i++) {
|
||
|
|
$itmp[$i] = $i;
|
||
|
|
}
|
||
|
|
for (my $iu=0; $iu<=$#tmp; $iu++){
|
||
|
|
my $j = int(rand($#itmp+1));
|
||
|
|
$users[$iu] = $tmp[$itmp[$j]];
|
||
|
|
my @itmp2 = ();
|
||
|
|
for (my $i=0; $i<$j; $i++){
|
||
|
|
$itmp2[$i] = $itmp[$i];
|
||
|
|
}
|
||
|
|
for (my $i=$j+1; $i<=$#itmp; $i++){
|
||
|
|
$itmp2[$i-1] = $itmp[$i];
|
||
|
|
}
|
||
|
|
@itmp = @itmp2;
|
||
|
|
@itmp2 = ();
|
||
|
|
}
|
||
|
|
@itmp = ();
|
||
|
|
@tmp = ();
|
||
|
|
|
||
|
|
my $firstkeygrps = ":Central:Eastern:Northern:Southeastern:Southern:Western:";
|
||
|
|
my $usergroups = {};
|
||
|
|
my $groups = getGroups($CLIENT{'clid'});
|
||
|
|
#print "<br><pre>".Dumper(\$groups)."</pre>\n";
|
||
|
|
foreach (keys(%{$groups})) {
|
||
|
|
foreach my $guser (@{$groups->{$_}->{'grplist'}}) {
|
||
|
|
if ($firstkeygrps =~ /:$_:/) {
|
||
|
|
push(@{$usergroups->{$guser}->{'First'}}, $groups->{$_}->{'grpnme'});
|
||
|
|
} else {
|
||
|
|
push(@{$usergroups->{$guser}->{'Second'}}, $groups->{$_}->{'grpnme'});
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
# sort unique groups
|
||
|
|
my %saw;
|
||
|
|
foreach my $guser (@users) {
|
||
|
|
undef %saw;
|
||
|
|
@{$usergroups->{$guser}->{'First'}} = grep(!$saw{$_}++, @{$usergroups->{$guser}->{'First'}});
|
||
|
|
undef %saw;
|
||
|
|
@{$usergroups->{$guser}->{'Second'}} = grep(!$saw{$_}++, @{$usergroups->{$guser}->{'Second'}});
|
||
|
|
}
|
||
|
|
|
||
|
|
print "User,Primary Key,Secondary Key,";
|
||
|
|
for (my $i=1; $i<59; $i++) {
|
||
|
|
if ($comments->{$users[0]}->[$i] == -1) {
|
||
|
|
#inactive question;
|
||
|
|
next;
|
||
|
|
}
|
||
|
|
print "$questions[$i]->[0],";
|
||
|
|
}
|
||
|
|
print "$questions[59]->[0]\n";
|
||
|
|
my $iu = 1;
|
||
|
|
foreach my $user (@users) {
|
||
|
|
print "$iu,\"";
|
||
|
|
print join(',',@{$usergroups->{$user}->{'First'}});
|
||
|
|
print "\",\"";
|
||
|
|
print join(',',@{$usergroups->{$user}->{'Second'}});
|
||
|
|
print "\",";
|
||
|
|
for (my $i=1; $i<59; $i++) {
|
||
|
|
if ($comments->{$user}->[$i] == -1) {
|
||
|
|
# inactive question;
|
||
|
|
next;
|
||
|
|
}
|
||
|
|
print "\"$comments->{$user}->[$i]\",";
|
||
|
|
}
|
||
|
|
print "\"$comments->{$user}->[59]\"\n";
|
||
|
|
$iu++;
|
||
|
|
}
|
||
|
|
}
|