#!/usr/bin/perl
#
# $Id: uploadmass.pl,v 1.19 2006/09/11 19:17:18 psims Exp $
#
# Source File: uploadmass.pl
# Get config
use Text::ParseWords;
use CGI qw/:standard/;
require 'sitecfg.pl';
require 'testlib.pl';
require 'sbalib.pl';
&app_initialize;
print "Content-Type: text/html\n\n";
if (&get_session($FORM{'tid'})) {
&LanguageSupportInit();
$n=0;
&open_results();
#if (defined($UPLOADED_FILES{'subjareas.csv'})) { $n++;upload_subjareas();}
#if (defined($UPLOADED_FILES{'tests.csv'})) { $n++;upload_tests();}
#if (defined($UPLOADED_FILES{'questions.csv'})) { $n++;upload_questions();}
#if (defined($UPLOADED_FILES{'cnds.csv'})) { $n++;upload_users();}
#if (defined($UPLOADED_FILES{'groups.csv'})) { $n++;upload_groups();}
#if (defined($UPLOADED_FILES{'customfile'})) { $n++;upload_customfile();}
$cndsfile = upload('cndsfile');
if (defined($cndsfile)) { $n++;upload_users($cndsfile);}
$testfile = upload('testfile');
if (defined($testfile)) { $n++;upload_test($testfile);}
if ($n==0) {
print "
NO UPLOAD FILES PROVIDED. NOTHING IMPORTED.
\n";
}
&close_results();
}
sub upload_users {
&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "AD/UU");
# upload users
my $cndsfile = $_[0];
print "Importing USERS:
\n";
@oldrecs = get_data("cnd.$SESSION{'clid'}");
$oldrec = $oldrecs[0];
$oldrec =~ (s/authtests/createdate/);
if ( !($oldrec =~ /createdby/) ) {
$oldrec =~ s/grpid/createdby/;
}
chomp ($oldrec);
@curflds = split(/&/, $oldrec);
for (0 .. $#curflds) { $RECFLDS{$curflds[$_]} = $_;};
$oldkeyidx = $RECFLDS{'uid'};
for (1 .. $#oldrecs) {
($ukey, $trash) = split(/&/, $oldrecs[$_]);
$OLDRECS{$ukey} = $trash;
}
$oldrechdr = shift @oldrecs;
$oldrechdr =~ (s/authtests/createdate/);
@udata = <$cndsfile>;
$newrechdr = "$udata[0]\n";
@flds = parse_line(',',0,$udata[0]);
$flds[$#flds] =~ s/\s+$// ; # HBI - Delete whitespace at the end of the last element.
for (0 .. $#flds) { $NEWFLDS{$flds[$_]} = $_;};
@flds=();
$uididx = $NEWFLDS{'uid'};
$nmfidx = $NEWFLDS{'nmf'};
$nmmidx = $NEWFLDS{'nmm'};
$nmlidx = $NEWFLDS{'nml'};
$pwdidx = $NEWFLDS{'pwd'};
@duprecs = ();
@badfmts = ();
@illchars = ();
@toolongs = ();
@sortedrecs = ();
$DEFAULT_FLDS{'authtests'} = time(); #authtests gets set to createdate in &put_candidate_profile(), but we have to set it here so it gets put in the file, so please don't delete this line
$DEFAULT_FLDS{'createdate'} = time(); #This sets createdate for existing cnds. The s/authtests/createdate/ gets done before this
$DEFAULT_FLDS{'grpid'} = "";
$DEFAULT_FLDS{'createdby'} = "$SESSION{'uid'}";
$DEFAULT_FLDS{'cnd1'} = "";
$DEFAULT_FLDS{'cnd2'} = "";
$DEFAULT_FLDS{'cnd3'} = "";
$DEFAULT_FLDS{'cnd4'} = "";
$DEFAULT_FLDS{'grpowner'} = "N";
my $groups = getGroups($SESSION{'clid'});
for (1 .. $#udata) {
chomp($udata[$_]);
$udata[$_] =~ s/\r//g;
$udata[$_] =~ tr/'/\\'/d;
@flds = parse_line(',',0,$udata[$_]);
$flds[$#flds] =~ s/\s+$// ; # HBI - Delete whitespace at the end of the last element.
$newkey = $flds[$uididx];
if ((length($flds[$uididx]) > 50) || (length($flds[$uididx]) < 3)) {
$badrec = "uid: $udata[$_]\n";
push @toolongs, "$badrec";
#print STDERR "$udata[$_]\n (".join('|||',@flds).")\n";
} elsif ((length($flds[$pwdidx]) > 50) || (length($flds[$pwdidx]) < 3)){
$badrec = "pwd: $udata[$_]\n";
push @toolongs, "$badrec";
#} elsif (length($flds[$NEWFLDS{'sal'}]) > 15){
# $badrec = "sal: $udata[$_]\n";
# push @toolongs, "$badrec";
#} elsif ((length($flds[$nmfidx]) > 20) || (length($flds[$nmfidx]) < 1)){
} elsif (length($flds[$nmfidx]) < 1) {
$badrec = "nmf: $udata[$_]\n";
push @toolongs, "$badrec";
#} elsif (length($flds[$nmmidx]) > 20){
# $badrec = "nmm: $udata[$_]\n";
# push @toolongs, "$badrec";
#} elsif ((length($flds[$nmlidx]) > 20) || (length($flds[$nmlidx]) < 1)){
} elsif (length($flds[$nmlidx]) < 1) {
$badrec = "nml: $udata[$_]\n";
push @toolongs, "$badrec";
#} elsif (length($flds[$NEWFLDS{'adr'}]) > 50){
# $badrec = "adr: $udata[$_]\n";
# push @toolongs, "$badrec";
#} elsif (length($flds[$NEWFLDS{'cty'}]) > 25){
# $badrec = "cty: $udata[$_]\n";
# push @toolongs, "$badrec";
#} elsif (length($flds[$NEWFLDS{'ste'}]) > 4){
# $badrec = "ste: $udata[$_]\n";
# push @toolongs, "$badrec";
#} elsif (length($flds[$NEWFLDS{'pst'}]) > 10){
# $badrec = "pst: $udata[$_]\n";
# push @toolongs, "$badrec";
#} elsif (length($flds[$NEWFLDS{'ctry'}]) > 4){
# $badrec = "ctry: $udata[$_]\n";
# push @toolongs, "$badrec";
#} elsif (length($flds[$NEWFLDS{'eml'}]) > 100){
# $badrec = "eml: $udata[$_]\n";
# push @toolongs, "$badrec";
#} elsif (length($flds[$NEWFLDS{'cnd1'}]) > 16){
# $badrec = "cnd1: $udata[$_]\n";
# push @toolongs, "$badrec";
#} elsif (length($flds[$NEWFLDS{'cnd2'}]) > 16){
# $badrec = "cnd2: $udata[$_]\n";
# push @toolongs, "$badrec";
#} elsif (length($flds[$NEWFLDS{'grpid'}]) > 100){
# $badrec = "grpid: $udata[$_]\n";
# push @toolongs, "$badrec";
} else {
# Check for illegal characters
$badrec = "";
foreach $key (keys %NEWFLDS) {
$trash = $flds[$NEWFLDS{$key}];
if ($key eq "sal") {
$trash =~ tr/. //d;
} elsif ($key eq "adr") {
$trash =~ tr/\- ,\/.#//d;
} elsif ( ($key eq "nmf") || ($key eq "nml") || ($key eq "cty") || ($key eq "ctry") ) {
$trash =~ tr/\- .'//d;
} elsif ($key eq "nmm") {
$trash =~ tr/. //d;
} elsif ($key eq "pst") {
$trash =~ tr/\- //d;
} elsif (($key eq "eml") || ($key eq "uid") || ($key eq "pwd")) {
$trash =~ tr/\-@.//d;
} elsif ($key eq 'grpid') {
$trash =~ tr/:, //d;
} elsif (($key eq "cnd1") || ($key eq "cnd2") || ($key eq "cnd3") || ($key eq "cnd4")) {
$trash =~ tr/ //d;
}
if ( $trash =~ /\W/ ) {
$badrec = "$key: $udata[$_]\n";
#print STDERR "$key ($flds[$NEWFLDS{$key}],$trash)\n";
push @illchars, "$badrec";
}
}
# No illegal chars, so must be good
if ($badrec eq "") {
$goodrec = "";
if ($OLDRECS{$newkey} eq '') {
for (0 .. $#curflds) {
$delem = "";
$keyword=$curflds[$_];
$jidx = $NEWFLDS{$keyword};
if ($jidx ne '') {
$delem = $flds[$jidx];
}
if ($delem eq '') {
$delem = $DEFAULT_FLDS{$keyword};
}
if ($goodrec eq '') {
$goodrec = $delem;
} else {
$goodrec = join('&', $goodrec, $delem);
}
}
push @oldrecs, "$goodrec\n";
my ($ukey, $trash) = split(/&/, $goodrec);
$OLDRECS{$ukey} = $trash;
} else {
$badrec = "$udata[$_]\n";
push @duprecs, "$badrec";
}
if ($flds[$NEWFLDS{'grpid'}]) {
# The are default group assignments
#print STDERR $flds[$NEWFLDS{'grpid'}]."\n";
foreach my $grp (split(/\s*::\s*/,$flds[$NEWFLDS{'grpid'}])) {
if (not exists $groups->{$grp}) {
$groups->{$grp}->{'grpowner'} = 'grpadmin';
$groups->{$grp}->{'grpid'} = $grp;
$groups->{$grp}->{'grpnme'} = $grp;
$groups->{$grp}->{'grplist'} = [$flds[$uididx]];
$groups->{$grp}->{'validfrom'} = '01-01-2000';
$groups->{$grp}->{'validto'} = '12-31-2037';
} else {
push @{$groups->{$grp}->{'grplist'}}, $flds[$uididx];
}
}
}
}
}
}
@udata = ();
unless($#duprecs eq -1) {
# duplicate, but add any groups the user may not already be a memeber of
print "Rejected: Duplicate user (Group memeberships are added, though)
\n";
print "$newrechdr
\n";
for (0 .. $#duprecs) {
print "$duprecs[$_]
\n";
}
}
@duprecs = ();
#unless($#badfmts eq -1) {
#print "Rejected: Required Element(s) Missing
\n";
#print "$newrechdr
\n";
#for (0 .. $#badfmts) {
#print "$badfmts[$_]
\n";
#}
#}
unless($#toolongs eq -1) {
print "Rejected: Field Is Wrong Length
\n";
print "$newrechdr
\n";
for (0 .. $#toolongs) {
print "$toolongs[$_]
\n";
}
}
unless($#illchars eq -1) {
print "Rejected: Illegal Characters
\n";
print "$newrechdr
\n";
for (0 .. $#illchars) {
print "$illchars[$_]
\n";
}
}
@badfmts = ();
@toolongs = ();
@illchars = ();
@sortedrecs = sort @oldrecs;
@oldrecs=();
print "Accepted and Existing:
\n";
print "$oldrechdr
\n";
$tmpfile = join($pathsep, $dataroot, "cnd.$SESSION{'clid'}");
open (TMPFILE, ">$tmpfile") or $msg="failed";
print TMPFILE "$oldrechdr";
for (0 .. $#sortedrecs) {
print TMPFILE "$sortedrecs[$_]";
print "$sortedrecs[$_]
\n";
};
close TMPFILE;
if ($groups) {
my @newgrps;
#print STDERR Dumper($groups);
foreach my $grp (sort keys (%$groups)) {
push @newgrps, "$grp
\n";
# make entries unique, and sort for good measure
my %tmp = map(($_=>1),@{$groups{$grp}->{'grplist'}});
@{$groups{$grp}->{'grplist'}} = keys %tmp;
}
if (&setGroups($SESSION{'clid'},$groups)) {
print "Created and Populated Groups:
\n@newgrps";
} else {
print "***Failed*** to Create and Populate Groups:
\n";
}
} else {
print "No Groups Defined:
\n";
}
print "
\n";
}
sub upload_groups {
&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "AD/UG");
# upload groups
print "Importing GROUPS:
\n";
}
sub upload_test {
# upload test file
&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "AD/UT");
my $testfile = $_[0];
# some browsers send path info - gotta remove it
my $testfilename = param('testfile');
$testfilename =~ s/\//;/g;
$testfilename =~ s/\\/;/g;
@testfilepath = split(/;/, $testfilename);
$testfilename = $testfilepath[$#testfilepath];
# make sure client id is in test file name
if ($testfilename =~ /.$SESSION{'clid'}$/ || $testfilename =~ /.$SESSION{'clid'}./) {
print "Importing Test file: $testfilename...
\n";
my $writefile = join($pathsep, $questionroot, $testfilename);
open (OUTFILE,">$writefile");
while (<$testfile>) {
print OUTFILE $_;
}
close(OUTFILE);
print "Done.
\n";
} else {
print "Test file: $testfilename does not contain proper client id \"$SESSION{'clid'}\".
\n";
}
}
sub upload_questions {
&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "AD/UQ");
# upload questions
print "Importing QUESTIONS:
\n";
}
sub upload_subjareas {
&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "AD/US");
# upload subject areas
print "Importing SUBJECT AREAS:
\n";
}
sub open_results {
print "
";
}
sub close_results {
print "
";
}