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.
94 lines
2.7 KiB
94 lines
2.7 KiB
2 months ago
|
#!/usr/bin/perl
|
||
|
|
#
|
||
|
|
# $Id: IntegroCSV.pl,v 1.2 2005/10/31 17:03:34 ddoughty Exp $
|
||
|
|
#
|
||
|
|
# Source File: IntegroCSV.pl
|
||
|
|
|
||
|
|
### DED 12/23/04 Script to print out answers to Integro SAS Survey
|
||
|
|
### across all clients
|
||
|
|
### Must be run from cgi-bin in browser:
|
||
|
|
### http://www.integrosurvey.com/cgi-bin/IntegroCSV.pl - USA
|
||
|
|
### http://www.integroonline.com/cgi-bin/IntegroCSV.pl - AUS
|
||
|
|
### Prints CSV data to browser, can copy/paste into a file
|
||
|
|
|
||
|
|
# Get config
|
||
|
|
use FileHandle;
|
||
|
|
use Time::Local;
|
||
|
|
use Data::Dumper;
|
||
|
|
#use IntegroLib;
|
||
|
|
#require 'sitecfg.pl';
|
||
|
|
require 'testlib.pl';
|
||
|
|
require 'smilib.pl';
|
||
|
|
require 'tstatlib.pl';
|
||
|
|
require 'cybertestlib.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 );
|
||
|
|
|
||
|
|
print "Content-Type: text/html\n\n";
|
||
|
|
|
||
|
|
my @history;
|
||
|
|
my @client_data = get_client_list();
|
||
|
|
shift @client_data;
|
||
|
|
foreach (@client_data) {
|
||
|
|
my ($clientID, $trash) = split('&', $_);
|
||
|
|
my $file = join($pathsep,$testcomplete,"$clientID.SAS01.history");
|
||
|
|
my $fh = new FileHandle;
|
||
|
|
if ($fh->open($file)) {
|
||
|
|
push(@history, map([split(/<<>>/,$_)],<$fh>));
|
||
|
|
}
|
||
|
|
}
|
||
|
|
#print "<pre>".Dumper(\@history)."</pre>";
|
||
|
|
|
||
|
|
print "<pre>\n";
|
||
|
|
print "Client,Survey Date,Survey Time,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58.1,58.2,58.3\n";
|
||
|
|
foreach (@history) {
|
||
|
|
my ($clientID, $trash) = split(/&/, $_->[1]);
|
||
|
|
my ($date, $time) = split(/ /, $_->[0],2);
|
||
|
|
my @answers;
|
||
|
|
my @data = split(/&/, $_->[4]);
|
||
|
|
for (my $i=0;$i<$#data;$i++) {
|
||
|
|
#if (($i == $#data) || ($#data == 59 && $i == 57)) {
|
||
|
|
# Skip #59, and skip #57, if included
|
||
|
|
if ($i == $#data) {
|
||
|
|
# Skip #59
|
||
|
|
next;
|
||
|
|
} elsif ($i == $#data-1) {
|
||
|
|
my ($answer, $comment) = split(/::/,$data[$i]);
|
||
|
|
my @ans = split(/\?/, $answer);
|
||
|
|
shift @ans;
|
||
|
|
my @fiftyeight;
|
||
|
|
for (my $j=0;$j<=59;$j++) {
|
||
|
|
if ($ans[$j] eq "1") {
|
||
|
|
my $ipers = ($j % 3);
|
||
|
|
$fiftyeight[$ipers] = (($j + 3 - ($j % 3))/6)*10;
|
||
|
|
#if ($clientID eq "integroleadership") {
|
||
|
|
#print STDERR "$date: $answer\n";
|
||
|
|
#print STDERR "$date: J: $j Ipers: $ipers 58: $fiftyeight[$ipers]\n";
|
||
|
|
#}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($i == 57) {
|
||
|
|
push(@answers, "");
|
||
|
|
}
|
||
|
|
push(@answers, "$fiftyeight[0]");
|
||
|
|
push(@answers, "$fiftyeight[1]");
|
||
|
|
push(@answers, "$fiftyeight[2]");
|
||
|
|
} else {
|
||
|
|
my ($answer, $comment) = split(/::/,$data[$i]);
|
||
|
|
$answer =~ tr/\'//d;
|
||
|
|
$answer =~ tr/xxx//d;
|
||
|
|
$answer =~ tr/?//d;
|
||
|
|
push(@answers, $answer);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
my $answers = join(',', @answers);
|
||
|
|
print "$clientID,$date,$time$answers\n";
|
||
|
|
|
||
|
|
}
|
||
|
|
print "</pre>\n";
|
||
|
|
|