#!/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 "\n\n$_[0]\n". "\n\n". "\n"; } sub HTMLHeaderPlain { return "\n\n$_[0]\n". "\n\n". "\n"; } sub HTMLFooter { return "
Copyright (c) 2004, Integro Leadership Institute
\n\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 "

Error! No Strategic Alignment Survey Found.

\n"; print HTMLFooter(); } #print STDERR get_data("tests.$CLIENT{'clid'}"); #print STDERR "Test ID = $tstid\n"; print HTMLHeader("Integro Learning Custom Reports",$js); print "
\n"; print "\n"; # For development purposes we hardcode the survey id. # Fix this before production print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "
\n\n\n". "\n". "\n"; print "
Integro Learning Custom Reports
All GroupsChoose Groups
\n". "
Organization Name:
\n"; print "
\n"; print "

General Reports

  • Comments (CSV format)
    • "; print "\n"; print "\n"; print ""; 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 "
    ".Dumper(\$groups)."
    \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++; } }