#!/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 "
".Dumper(\@history)."
"; 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 " . __FILE__ . "\n"; } } if (defined $timestamp) { $timestamp = "$timestamp

\n"; } else { $timestamp = "
\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 "\n\n$_[0]\n". "\n". "\n\n". "\n"; } sub HTMLHeaderPlain { return "\n\n$_[0]\n". "\n\n". "\n"; } sub HTMLFooter { my $year = `date +%Y`; my $ionline; if ($ENV{'SERVER_NAME'} =~ "integroonline.com") { $ionline = "
Copyright (c) $year, Integro Learning Company"; } return "
Copyright (c) $year, ACTS Corporation$ionline
\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/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("Learning Custom Reports",$js . $js1); print "
\n"; print "\n"; # For development purposes we hardcode the survey id. # Fix this before production # print "\n"; # HBI This had a value of $tstid print "\n"; print "\n"; print "\n"; print "\n"; print "
\n\n\n". "\n". "\n"; print "\n"; print ""; print "
Learning Custom Reports
All GroupsChoose Groups
\n". "\n"; #print "
$xlatphrase[797] $xlatphrase[279]:
\n"; print "
Organization Name:
Header Override:
Time Stamp:
    ". "
  • Most Recent Survey Taken
    • ". "
  • Current Time
    • ". "
  • Custom Value: ". "
\n"; print $test_choice_html ; print "

Likert Scale Report" ; print "

    " ; print "
  • Likert Scale - No Response is ignored, Question Numbers listed.
    • \n" ; print "
  • Likert Scale by Group - No Response is ignored, Detail by Groups.
    • \n" ; print "

\n" ; print "\n"; print "\n"; print "
"; 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. my ($idlist,$groups,$timestamp) = @_; my $ResponseRequired = 1 ; # Do not count a question if it is not responded to. 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, $ResponseRequired) ; # warn "sumdata" ; # warn &Dumper(\$sumdata) ; # warn "grpdata" ; # warn &Dumper(\$grpdata) ; print HTMLHeaderPlain("Likert Scale General Results"); print "
" ; print "Likert Scale General Results
" ; print "Survey/Test $TEST{'desc'}

\n"; # print "Improvement as Perceived by Employees
\n"; # print "$FORM{'orgname'}
\n"; if ($FORM{'uberheader'} ne "") { print "".$FORM{'uberheader'}."
\n"; } elsif (defined $idlist) { print "Summary for Groups: " .join(", ",map($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n" ; } else { print "$xlatphrase[798] $xlatphrase[799]
\n"; } print $timestamp; print "" ; 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 "\n"; # Print first row. print "" ; print "" ; print "\n" ; # Print second row. Heading for each column. print "" ; print "" ; print "" ; print "" ; print "" ; print "" ; print "\n" ; # Loop for Categories. my $tot_poss = 0 ; my $tot_earned = 0 ; my $supercat ; my $text_summ = "

" ; $text_summ .= '' ; $text_summ .= "Category: Percent
\n" ; my @supercats = sort keys %{$sumdata} ; for $supercat (@supercats) { my $questions = "" ; my $possible = 0 ; my $earned = 0 ; $questions = join(", ", sort map { $_ + 1 } keys %{$sumdata->{$supercat}->{'Questions'}}) ; $possible = $sumdata->{$supercat}->{'PointsAvail'} ; $earned = $sumdata->{$supercat}->{'PointsEarned'} ; $tot_poss += $possible ; $tot_earned += $earned ; print "

" ; print "" ; print "" ; print "" ; 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 . " %
\n" ; $ydim += 15 ; # add length to the chart for another row. print "\n" ; } # Print Total row. print "" ; print "" ; print "" ; push @img_labels, "Total" ; my ($percent) = int ((100.0 * $tot_earned / $tot_poss) +0.5) ; push @img_data, $percent ; $text_summ .= "Total" . ": " . $percent . " %
\n" ; $ydim += 15 ; # add length to the chart for another row. print &rep_cell_str($tot_earned, $tot_poss) ; print "\n" ; print "\n" ; print "
Category Scores
CategoryQuestionsPoints PossiblePoints Earned% Earned
$supercat$questions$possible
Total$tot_poss
\n" ; print $text_summ ; if (@supercats) { print "

\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 "

\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 $ResponseRequired = 1 ; # Do not count questions if there was no response. 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,$ResponseRequired) ; # warn "sumdata" ; # warn &Dumper(\$sumdata) ; # warn "grpdata" ; # warn &Dumper(\$grpdata) ; print HTMLHeaderPlain("Likert Scale Group Results"); print "
" ; print "Likert Scale Group Results
" ; print "Survey/Test $TEST{'desc'}

\n"; # print "Improvement as Perceived by Employees
\n"; # print "$FORM{'orgname'}
\n"; if ($FORM{'uberheader'} ne "") { print "".$FORM{'uberheader'}."
\n"; } elsif (defined $idlist) { print "Summary for Groups: " .join(", ",map($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n" ; } else { print "$xlatphrase[798] $xlatphrase[799]
\n"; } print $timestamp; print "" ; # Print HTML for heading. print "\n"; my $cat_count = keys %{$sumdata} ; # Number of categories. # Print first row. print "" ; print "" ; my $supercat ; foreach $supercat (sort keys %{$sumdata}) { print "\n" ; } print "" ; print "\n" ; # Print second row. Heading for each column. # Loop for Categories. my $tot_poss = 0 ; my $tot_earned = 0 ; print "" ; print "\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 "\n" ; # Print heading for Groups. my $col_count = $cat_count + 2 ; print "\n" ; print "" ; for $supercat (@supercats) { print "" ; } print "\n" ; unless ($grpdata) { print "\n" ; } else { my $group ; foreach $group (sort keys %{$grpdata}) { if ($group) { print "" ; print "" ; 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 "\n" ; } } } print "
$supercatTotal
Overall
Group Breakdown
Supervisor$supercatTotal
Pick Groups for more detail
" ; # print "$group " ; print $all_groups->{$group}->{'grpnme'} ; print "
\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 .= "" 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" unless ($skip_tot) ; $html_str .= "" ; $html_str .= "$percent_str" ; 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 = ' ' . $id ; $tstoption = " " . # "$id" . "$radio_tst_button" . "$desc" . "$testscompleted" . "$testsinprogress" . "$testspending \n"; $tstoptions = join('', $tstoptions, $tstoption); } $html_str = "
Please choose the survey for which you would like reports:
" . # "
" . # "" . # "" . # "" . # "
" . "" . "" . "" . "" . "" . "" . "" . "" . "" . "" . $tstoptions . "" . "
Test IDDescriptionCmpInPPnd
" ; return ($js, $html_str) ; }