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.
 
 
 
 
 
 

488 lines
18 KiB

package IntegroLib;
# A collection of functions used for custom reports for Integro.
# Most data processing functions.
#
# $Id: IntegroLib.pm,v 1.5 2005/10/31 17:03:34 ddoughty Exp $
use FileHandle;
use Time::Local;
use Data::Dumper;
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 );
require 'sitecfg.pl';
require 'testlib.pl';
require 'tstatlib.pl';
require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
@ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(get_survey_results CommEffectData TrustLevelData ValuesData diversityData KindsOfPeopleData);
@EXPORT_OK = qw();
$VERSION = '0.01';
sub get_survey_results {
my ($client,$user,$test) = @_;
&main::get_test_sequence_for_reports($client,$user,$test);
#print STDERR Dumper(\%SUBTEST_RESPONSES,\%SUBTEST_QUESTIONS);
my (@answers,$i,@comments,@responses);
foreach (split(/\&/,$main::SUBTEST_RESPONSES{2})) {
my ($response,$comment) = split(/::/,$_);
push @responses, $response;
push @comments, $comment;
}
for ($i = 1; $i<=69; $i++) {
($responses[$i] =~ /^\D*(\d+)/);
$answers[$i] = $1;
# Also need to get comments
}
if ($main::SUBTEST_QUESTIONS{2} =~ /\.057/) {
($responses[57] =~ /^\D*(\d+)/);
$answers[57] = $1;
} else {
# Question 57 is suppressed in this survey
# Shift the last two questions to their
# correct position, and flag 57
$comments[59] = $comments[58];
$comments[58] = $comments[57];
$comments[57] = -1;
$responses[59] = $responses[58];
$responses[58] = $responses[57];
$answers[57] = -1;
}
my ($slug,$steady,$energetic) = (5,5,5);
my @tmp = split(/\?/,$responses[58]);
for ($i = 1; $i<= 60; $i+=3) {
#print STDERR "$i - $tmp[$i] - $slug,\n";
if ($tmp[$i] =~ /\d+/) {
last;
} else {
$slug += 5;
}
}
if ($slug == 105) {$slug = 0;}
foreach ($i = 2; $i<= 60; $i+=3) {
#print STDERR "$i - $tmp[$i] - $steady\n";
if ($tmp[$i] =~ /\d+/) {
last;
} else {
$steady += 5;
}
}
if ($steady == 105) {$steady = 0;}
foreach ($i = 3; $i<= 60; $i+=3) {
#print STDERR "$i - $tmp[$i] - $energetic\n";
if ($tmp[$i] =~ /\d+/) {
last;
} else {
$energetic += 5;
}
}
if ($energetic ==105) {$energetic = 0;}
if (($slug + $steady + $energetic) == 100) {
$answers[58] = [$slug,$steady,$energetic];
} else {
#print STDERR "$slug, $steady, $energetic\n";
$answers[58] = undef;
}
$answers[59] = $responses[59];
#print STDERR Dumper(\@answers);
if (wantarray) {
return (\@answers,\@comments);
} else {
return \@answers;
}
}
sub CommEffectData {
my ($client,$testid,$idlist,$groups) = @_;
my $grpMembership = &main::getGroupMemberships($client);
my $config = {'Purpose' => {'Clarity' => [17,25],
'Approval' => [21,29]},
'Values' => {'Clarity' => [19,27],
'Approval' => [23,31]},
'Vision' => {'Clarity' => [18,33],
'Approval' => [22,37]},
'Goals' => {'Clarity' => [26,34],
'Approval' => [30,38]},
'Procedures' => {'Clarity' => [20,35],
'Approval' => [24,39]},
'Roles' => {'Clarity' => [28,36],
'Approval' => [32,40]}
};
#my (%histograms,$claritysum,$approvalsum);
my $res;
foreach (keys %$config) {
@{$res->{'organization'}->{'histogram'}->{$_}->{'Clarity'}} = (0,0,0,0,0,0,0);
foreach my $i (0..6) {
@{$res->{'organization'}->{'histogram'}->{$_}->{'Approval'}->[$i]} = (0,0,0);
}
}
my @filelist = &main::get_test_result_files($main::testcomplete, $client,$testid);
foreach my $file (@filelist) {
my $user = $file;
$user =~ s/.$testid$//;
$user =~ s/^$client.//;
if (defined $idlist and not $idlist->{$user}) {
next;
}
my $answers = &get_survey_results( $client, $user, $testid);
foreach (keys %$config) {
my ($clarity, $approval);
if (defined $answers->[$config->{$_}->{'Clarity'}->[0]] and
defined $answers->[$config->{$_}->{'Clarity'}->[1]] and
defined $answers->[$config->{$_}->{'Approval'}->[0]] and
defined $answers->[$config->{$_}->{'Approval'}->[1]]) {
$clarity = $answers->[$config->{$_}->{'Clarity'}->[0]] +
$answers->[$config->{$_}->{'Clarity'}->[1]];
$res->{'organization'}->{'histogram'}->{$_}->{'Clarity'}->[$clarity]++;
$res->{'organization'}->{'claritysum'}->{$_}->{'number'}++;
$res->{'organization'}->{'claritysum'}->{$_}->{'value'} += $clarity;
$approval = $answers->[$config->{$_}->{'Approval'}->[0]] +
$answers->[$config->{$_}->{'Approval'}->[1]];
$res->{'organization'}->{'approvalsum'}->{$_}->{'number'}++;
$res->{'organization'}->{'approvalsum'}->{$_}->{'value'} += $approval;
my $approvalhist;
if ($approval < 3) {$approvalhist = 0;}
elsif ($approval < 5) {$approvalhist = 1;}
else {$approvalhist = 2;}
$res->{'organization'}->{'histogram'}->{$_}->{'Approval'}->[$clarity]->[$approvalhist]++;
#if () {
if ($grpMembership and exists $grpMembership->{$user}) {
foreach my $group (@{$grpMembership->{$user}}) {
if (defined $idlist and not exists $groups->{$group}) {
# a subset of groups was chosen, and this group is not in that list
next;
}
if (not exists $res->{'groups'}->{$group}) {
foreach my $conf (keys %$config) {
@{$res->{'groups'}->{$group}->{'histogram'}->{$conf}->{'Clarity'}} = (0,0,0,0,0,0,0);
foreach my $i (0..6) {
@{$res->{'groups'}->{$group}->{'histogram'}->{$conf}->{'Approval'}->[$i]} = (0,0,0);
}
}
}
$res->{'groups'}->{$group}->{'histogram'}->{$_}->{'Clarity'}->[$clarity]++;
$res->{'groups'}->{$group}->{'histogram'}->{$_}->{'Approval'}->[$clarity]->[$approvalhist]++;
$res->{'groups'}->{$group}->{'claritysum'}->{$_}->{'number'}++;
$res->{'groups'}->{$group}->{'claritysum'}->{$_}->{'value'} += $clarity;
$res->{'groups'}->{$group}->{'approvalsum'}->{$_}->{'number'}++;
$res->{'groups'}->{$group}->{'approvalsum'}->{$_}->{'value'} += $approval;
}
}
}
}
}
my @groups = ($res->{'organization'});
if (exists $res->{'groups'}) {push @groups, values(%{$res->{'groups'}});}
foreach my $group (@groups) {
my ($count,$claritytot,$approvaltot) = (scalar(keys(%{$group->{'claritysum'}})),0,0);
foreach (values %{$group->{'claritysum'}}) {
$_->{'value'} = 100*$_->{'value'}/(6*$_->{'number'});
$claritytot += $_->{'value'};
}
foreach (values %{$group->{'approvalsum'}}) {
$_->{'value'} = 100*$_->{'value'}/(6*$_->{'number'});
$approvaltot += $_->{'value'};
}
$group->{'overallclarity'} = ($count ? $claritytot/$count : undef);
$group->{'overallapproval'} = ($count ? $approvaltot/$count : undef);
}
#print STDERR Dumper($res);
return $res;
}
sub TrustLevelData {
my ($client,$testid,$idlist,$groups) = @_;
my $grpMembership = &main::getGroupMemberships($client);
my %reversed = (2 => 1, 13 => 1, 15 => 1);
my %config = ('Openness' => [1,5,9,13],
'Congruence' => [2,6,10,14],
'Acceptance' => [3,7,11,15],
'Reliability' => [4,8,12,16]
);
my ($res,%defhistograms);
@defhistograms{keys(%config)} = ([0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0]);
@{$res->{'organization'}->{'histogram'}}{keys(%config)} = ([0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0]);
my @filelist = &main::get_test_result_files($main::testcomplete, $client,$testid);
foreach my $file (@filelist) {
my $user = $file;
$user =~ s/.$testid$//;
$user =~ s/^$client.//;
if (defined $idlist and not $idlist->{$user}) {
next;
}
my $answers = &get_survey_results( $client, $user, $testid);
CONFIG: foreach (keys %config) {
my $value;
foreach my $i (@{$config{$_}}) {
if (not defined $answers->[$i]) {
# We are missing a response in one of the data points for this category,
# skip the category for this canidate.
$value = 0;
next CONFIG;
}
if (exists $reversed{$i}) {
$value += (4 - $answers->[$i]);
} else {
$value += $answers->[$i];
}
}
$res->{'organization'}->{'trust'}->{$_}->{'number'}++;
#print STDERR "$_: ($res->{'organization'}->{'trust'}->{$_}->{'number'}, $value => ";
my $hvalue = $value - 4;
$res->{'organization'}->{'trust'}->{$_}->{'value'}+=$value;
if ($hvalue < 0) {$hvalue = 0;}
if ($hvalue > 8) {$hvalue = 8};
$res->{'organization'}->{'histogram'}->{$_}->[$hvalue]++;
if ($grpMembership and exists $grpMembership->{$user}) {
# it isn't clear what by group breakout should be
# when the reports are limited by groups, so skip it.
foreach my $group (@{$grpMembership->{$user}}) {
if (defined $idlist and not exists $groups->{$group}) {
# a subset of groups was chosen, and this group is not in that list
next;
}
if (not exists $res->{'groups'}->{$group}) {
@{$res->{'groups'}->{$group}->{'histogram'}}{keys(%config)} = ([0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0]);
}
$res->{'groups'}->{$group}->{'trust'}->{$_}->{'number'}++;
$res->{'groups'}->{$group}->{'trust'}->{$_}->{'value'}+=$value;
$res->{'groups'}->{$group}->{'histogram'}->{$_}->[$hvalue]++;
}
}
$value = 0;
$hvalue = 0;
}
}
#print STDERR Dumper($res->{'organization'});
my @groups = ($res->{'organization'});
if (exists $res->{'groups'}) {push @groups, values(%{$res->{'groups'}});}
foreach my $group (@groups) {
my ($count,$overall) = (scalar(keys(%{$group->{'trust'}})),0);
foreach (values %{$group->{'trust'}}) {
#print STDERR "($_->{'value'}, $_->{'number'})\n";
$_->{'value'} = 100*$_->{'value'}/(16*$_->{'number'});
$overall += $_->{'value'};
}
$group->{'overalltrust'} = ($count ? $overall/$count : undef);
}
#print STDERR Dumper($res->{'organization'});
return $res;
}
sub ValuesData {
my ($client,$testid,$idlist,$groups) = @_;
my $grpMembership = &main::getGroupMemberships($client);
#print STDERR Dumper( $grpMembership );
#my @filelist = &main::get_test_result_files($main::testcomplete, $client,$testid);
my %config = ('Straightforwardness' => 41,
'Honesty' => 43,
'Receptivity' => 45,
'Disclosure' => 47,
'Respect' => 49,
'Recognition' => 51,
'Seeks Excellence' => 53,
'Keeps Commitments' => 55,
);
# data is stored [Personal Importance, Work Performance]
my %levels = map(($_ => [0,0]), keys(%config));
my %count = map(($_ => 0), keys(%config)); # number of responses
my @filelist = &main::get_test_result_files($main::testcomplete, $client,$testid);
my $res = {};
foreach my $file (@filelist) {
my $user = $file;
$user =~ s/.$testid$//;
$user =~ s/^$client.//;
if (defined $idlist and not $idlist->{$user}) {
next;
}
my $answers = &get_survey_results( $client, $user, $testid);
foreach (keys %config) {
if (not defined $answers->[$config{$_}] or not defined $answers->[$config{$_}+1]) {
next;
}
$res->{'organization'}->{$_}->{'count'}++;
$res->{'organization'}->{$_}->{'Personal Importance'} += $answers->[$config{$_}]+1;
$res->{'organization'}->{$_}->{'Work Performance'} += $answers->[$config{$_}+1]+1;
if ($grpMembership and exists $grpMembership->{$user}) {
# it isn't clear what by group breakout should be
# when the reports are limited by groups, so skip it.
foreach my $group (@{$grpMembership->{$user}}) {
if (defined $idlist and not exists $groups->{$group}) {
# a subset of groups was chosen, and this group is not in that list
next;
}
$res->{'groups'}->{$group}->{$_}->{'count'}++;
#my $bob = $answers->[$config{$_}]+1;
#print STDERR "User: $user Group: $group Value: $_ Answer: $bob\n";
$res->{'groups'}->{$group}->{$_}->{'Personal Importance'} += $answers->[$config{$_}]+1;
$res->{'groups'}->{$group}->{$_}->{'Work Performance'} += $answers->[$config{$_}+1]+1;
}
}
}
}
my @tmp = ($res->{'organization'});
if (exists $res->{'groups'}) {push @tmp, values(%{$res->{'groups'}});}
foreach my $grp (@tmp) {
foreach (keys %config) {
if (not $grp->{$_}->{'count'}) {next;}
$grp->{$_}->{'Personal Importance'} /= $grp->{$_}->{'count'};
$grp->{$_}->{'Work Performance'} /= $grp->{$_}->{'count'};
$grp->{'Personal Importance'} += $grp->{$_}->{'Personal Importance'};
$grp->{'Work Performance'} += $grp->{$_}->{'Work Performance'};
$grp->{'gap'} += $grp->{$_}->{'Personal Importance'} - $grp->{$_}->{'Work Performance'};
}
}
return $res;
}
sub diversityData {
my ($client,$testid,$idlist,$groups) = @_;
# warn "diversityData called" ; # HBI Debug
my $grpMembership = &main::getGroupMemberships($client);
#print STDERR Dumper( $grpMembership );
#my @filelist = &main::get_test_result_files($main::testcomplete, $client,$testid);
my %config = ('Respectfulness' => 60,
'Speaking Up' => 62,
'Divergent Thinking' => 64,
'Freedom from Harassment' => 66,
'Fairness of Decisions' => 68
);
# data is stored [Personal Importance, Work Performance]
my %levels = map(($_ => [0,0]), keys(%config));
my %count = map(($_ => 0), keys(%config)); # number of responses
my @filelist = &main::get_test_result_files($main::testcomplete, $client,$testid);
my $res = {};
foreach my $file (@filelist) {
my $user = $file;
$user =~ s/.$testid$//;
$user =~ s/^$client.//;
if (defined $idlist and not $idlist->{$user}) {
next;
}
my $answers = &get_survey_results( $client, $user, $testid);
foreach (keys %config) {
if (not defined $answers->[$config{$_}] or not defined $answers->[$config{$_}+1]) {
next;
}
$res->{'organization'}->{$_}->{'count'}++;
$res->{'organization'}->{$_}->{'Personal Importance'} += $answers->[$config{$_}]+1;
$res->{'organization'}->{$_}->{'Work Performance'} += $answers->[$config{$_}+1]+1;
if ($grpMembership and exists $grpMembership->{$user}) {
# it isn't clear what by group breakout should be
# when the reports are limited by groups, so skip it.
foreach my $group (@{$grpMembership->{$user}}) {
if (defined $idlist and not exists $groups->{$group}) {
# a subset of groups was chosen, and this group is not in that list
next;
}
$res->{'groups'}->{$group}->{$_}->{'count'}++;
#my $bob = $answers->[$config{$_}]+1;
#print STDERR "User: $user Group: $group Value: $_ Answer: $bob\n";
$res->{'groups'}->{$group}->{$_}->{'Personal Importance'} += $answers->[$config{$_}]+1;
$res->{'groups'}->{$group}->{$_}->{'Work Performance'} += $answers->[$config{$_}+1]+1;
}
}
}
}
my @tmp = ($res->{'organization'});
if (exists $res->{'groups'}) {push @tmp, values(%{$res->{'groups'}});}
foreach my $grp (@tmp) {
foreach (keys %config) {
if (not $grp->{$_}->{'count'}) {next;}
$grp->{$_}->{'Personal Importance'} /= $grp->{$_}->{'count'};
$grp->{$_}->{'Work Performance'} /= $grp->{$_}->{'count'};
$grp->{'Personal Importance'} += $grp->{$_}->{'Personal Importance'};
$grp->{'Work Performance'} += $grp->{$_}->{'Work Performance'};
$grp->{'gap'} += $grp->{$_}->{'Personal Importance'} - $grp->{$_}->{'Work Performance'};
}
}
return $res;
}
sub KindsOfPeopleData {
my ($client,$testid,$idlist,$groups) = @_;
my $grpMembership = &main::getGroupMemberships($client);
#print STDERR Dumper( $grpMembership );
my @filelist = &main::get_test_result_files($main::testcomplete,$client,$testid);
my $res = {'self' =>{}};
$res->{'self'}->{'count'} = 0;
foreach my $file (@filelist) {
my $user = $file;
$user =~ s/\.$testid$//;
$user =~ s/^$client\.//;
#print STDERR " $user\n";
my $answers = &get_survey_results( $client, $user, $testid);
if (defined $idlist and not $idlist->{$user}) {
#print STDERR "Skipping $user\n";
next;
}
$res->{'Number of Surveys'}++;
#print STDERR Dumper($answers);
if (exists $res->{'self'} and defined $answers->[57] ) {
#print STDERR "BOOOO:$user:$answers->[57]:$answers->[57]->[0] $answers->[57]->[1] $answers->[57]->[2]\n";
if ($answers->[57] >= 0) {
my @types = ('Rebellious', 'Compliant', 'Self-Directed');
$res->{'self'}->{'count'}++;
$res->{'self'}->{$types[$answers->[57]]} += 100;
}
}
if (defined $answers->[58] ) {
#print STDERR "BOOOO::$user $answers->[58]->[0] $answers->[58]->[1] $answers->[58]->[2]\n";
$res->{'organization'}->{'count'}++;
$res->{'organization'}->{'Rebellious'} += $answers->[58]->[0];
$res->{'organization'}->{'Compliant'} += $answers->[58]->[1];
$res->{'organization'}->{'Self-Directed'} += $answers->[58]->[2];
if ($grpMembership and exists $grpMembership->{$user}) {
foreach my $group (@{$grpMembership->{$user}}) {
if (defined $idlist and not exists $groups->{$group}) {
# a subset of groups was chosen, and this group is not in that list
next;
}
$res->{'groups'}->{$group}->{'count'}++;
$res->{'groups'}->{$group}->{'Rebellious'} += $answers->[58]->[0];
$res->{'groups'}->{$group}->{'Compliant'} += $answers->[58]->[1];
$res->{'groups'}->{$group}->{'Self-Directed'} += $answers->[58]->[2];
}
}
}
}
if ($res->{'self'}->{'count'} < 1) {
delete $res->{'self'};
}
if (not defined $res) {
return undef;
}
my @tmp = ($res->{'organization'});
if (exists $res->{'groups'}) {push @tmp, values(%{$res->{'groups'}});}
if (exists $res->{'self'}) {push @tmp, $res->{'self'};}
foreach (@tmp) {
if (not $_->{'count'}) {
$_ = undef;
next;
}
$_->{'Rebellious'} /= $_->{'count'};
$_->{'Compliant'} /= $_->{'count'};
$_->{'Self-Directed'} /= $_->{'count'};
}
#print STDERR Dumper($res,$idlist);
return $res;
}
1;