#!/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 " "; }