#!/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 $text_summ = "<p align=left>Category: Percent<br>\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 "<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 ; $text_summ .= $supercat . ": " . $percent . "<br>\n" ; $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>" ; push @img_labels, "Total" ; my ($percent) = int ((100.0 * $tot_earned / $tot_poss) +0.5) ; push @img_data, $percent ; $text_summ .= "Total" . ": " . $percent . "<br>\n" ; $ydim += 15 ; # add length to the chart for another row. print &rep_cell_str($tot_earned, $tot_poss) ; print "</tr>\n" ; print "</tr>\n" ; print "</table>\n" ; print $text_summ ; 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) ; }