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.
424 lines
15 KiB
424 lines
15 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 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<=56; $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 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;
|
|
|