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.
386 lines
12 KiB
386 lines
12 KiB
4 months ago
|
#!/usr/bin/perl
|
||
|
|
#
|
||
|
|
# $Id: uploadmass.pl,v 1.19 2006/09/11 19:17:18 psims Exp $
|
||
|
|
#
|
||
|
|
# Source File: uploadmass.pl
|
||
|
|
|
||
|
|
my $HBI_Debug_uploadmass_pl = 0 ;
|
||
|
|
|
||
|
|
warn "WARN: " . __FILE__ . " running. " if ($HBI_Debug_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'})) {
|
||
|
|
warn "WARN: " . __FILE__ . " running. " if ($HBI_Debug_uploadmass_pl) ;
|
||
|
|
&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)) {
|
||
|
|
warn "WARN: " . __FILE__ . " call upload_users.\n" if ($HBI_Debug_uploadmass_pl) ;
|
||
|
|
$n++;
|
||
|
|
upload_users($cndsfile);
|
||
|
|
}
|
||
|
|
|
||
|
|
$testfile = upload('testfile');
|
||
|
|
if (defined($testfile)) {
|
||
|
|
warn "WARN: " . __FILE__ . " call upload_test.\n" if ($HBI_Debug_uploadmass_pl) ;
|
||
|
|
$n++;
|
||
|
|
upload_test($testfile);
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($n==0) {
|
||
|
|
print "<H1>NO UPLOAD FILES PROVIDED. NOTHING IMPORTED.</H1><BR>\n";
|
||
|
|
}
|
||
|
|
warn "WARN: " . __FILE__ . " running. " if ($HBI_Debug_uploadmass_pl) ;
|
||
|
|
&close_results();
|
||
|
|
}
|
||
|
|
|
||
|
|
sub upload_users {
|
||
|
|
warn "WARN: " . __FILE__ . " called upload_users.\n" if ($HBI_Debug_uploadmass_pl) ;
|
||
|
|
&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "AD/UU");
|
||
|
|
# upload users
|
||
|
|
my $cndsfile = $_[0];
|
||
|
|
print "<H1>Importing USERS:</H1><NOBR><BR>\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'});
|
||
|
|
my %Clients_Special_Group = () ;
|
||
|
|
my %Clients_Special_Group_Clear = () ;
|
||
|
|
$Clients_Special_Group{'tgwall'} = 1 ;
|
||
|
|
$Clients_Special_Group{'sandbox'} = 1 ; # DEvelopment only.
|
||
|
|
$Clients_Special_Group_Clear{'ot'} = 1 ;
|
||
|
|
$Clients_Special_Group_Clear{'dr'} = 1 ;
|
||
|
|
$Clients_Special_Group_Clear{'pe'} = 1 ;
|
||
|
|
$Clients_Special_Group_Clear{'ma'} = 1 ;
|
||
|
|
if ($Clients_Special_Group{$SESSION{'clid'}}) {
|
||
|
|
# Clear the membership of the special groups.
|
||
|
|
foreach my $grp_clr (keys %Clients_Special_Group_Clear) {
|
||
|
|
$groups->{$grp_clr}->{'grplist'} = [] ;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
warn "WARN: " . __FILE__ . " called getGroups." if ($HBI_Debug_uploadmass_pl) ;
|
||
|
|
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 {
|
||
|
|
# Only add the user id to the group if it is not already in the group.
|
||
|
|
my $already_in = 0 ;
|
||
|
|
my $User_Id = $flds[$uididx] ;
|
||
|
|
$already_in = grep /^${User_Id}$/ , @{$groups->{$grp}->{'grplist'}} ;
|
||
|
|
unless ($already_in) {
|
||
|
|
push @{$groups->{$grp}->{'grplist'}}, $User_Id ;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
@udata = ();
|
||
|
|
unless($#duprecs eq -1) {
|
||
|
|
# duplicate, but add any groups the user may not already be a memeber of
|
||
|
|
print "<B>Rejected: Duplicate user</B> (Group memeberships are added, though)<BR>\n";
|
||
|
|
print "$newrechdr<BR>\n";
|
||
|
|
for (0 .. $#duprecs) {
|
||
|
|
print "$duprecs[$_]<BR>\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
@duprecs = ();
|
||
|
|
#unless($#badfmts eq -1) {
|
||
|
|
#print "<B>Rejected: Required Element(s) Missing</B><BR>\n";
|
||
|
|
#print "$newrechdr<BR>\n";
|
||
|
|
#for (0 .. $#badfmts) {
|
||
|
|
#print "$badfmts[$_]<BR>\n";
|
||
|
|
#}
|
||
|
|
#}
|
||
|
|
unless($#toolongs eq -1) {
|
||
|
|
print "<B>Rejected: Field Is Wrong Length</B><BR>\n";
|
||
|
|
print "$newrechdr<BR>\n";
|
||
|
|
for (0 .. $#toolongs) {
|
||
|
|
print "$toolongs[$_]<BR>\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
unless($#illchars eq -1) {
|
||
|
|
print "<B>Rejected: Illegal Characters</B><BR>\n";
|
||
|
|
print "$newrechdr<BR>\n";
|
||
|
|
for (0 .. $#illchars) {
|
||
|
|
print "$illchars[$_]<BR>\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
@badfmts = ();
|
||
|
|
@toolongs = ();
|
||
|
|
@illchars = ();
|
||
|
|
@sortedrecs = sort @oldrecs;
|
||
|
|
@oldrecs=();
|
||
|
|
print "<B>Accepted and Existing:</B><BR>\n";
|
||
|
|
print "$oldrechdr<BR>\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[$_]<BR>\n";
|
||
|
|
};
|
||
|
|
close TMPFILE;
|
||
|
|
if ($groups) {
|
||
|
|
my @newgrps;
|
||
|
|
#print STDERR Dumper($groups);
|
||
|
|
foreach my $grp (sort keys (%$groups)) {
|
||
|
|
push @newgrps, "$grp<br>\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 "<B>Created and Populated Groups:</B><BR>\n@newgrps";
|
||
|
|
} else {
|
||
|
|
print "<B>***Failed*** to Create and Populate Groups:</B><BR>\n";
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
print "<B>No Groups Defined:</B><BR>\n";
|
||
|
|
}
|
||
|
|
print "</NOBR><BR>\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub upload_groups {
|
||
|
|
&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "AD/UG");
|
||
|
|
# upload groups
|
||
|
|
print "<H1>Importing GROUPS:</H1><BR>\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub upload_test {
|
||
|
|
# upload test file
|
||
|
|
warn "WARN: " . __FILE__ . " called upload_test." if ($HBI_Debug_uploadmass_pl) ;
|
||
|
|
&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 "<H1>Importing Test file: $testfilename...</H1><BR>\n";
|
||
|
|
my $writefile = join($pathsep, $questionroot, $testfilename);
|
||
|
|
open (OUTFILE,">$writefile");
|
||
|
|
while (<$testfile>) {
|
||
|
|
print OUTFILE $_;
|
||
|
|
}
|
||
|
|
close(OUTFILE);
|
||
|
|
print "<H1>Done.</H1><BR>\n";
|
||
|
|
} else {
|
||
|
|
print "<H1>Test file: $testfilename does not contain proper client id \"$SESSION{'clid'}\".</H1><BR>\n";
|
||
|
|
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub upload_questions {
|
||
|
|
&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "AD/UQ");
|
||
|
|
# upload questions
|
||
|
|
print "<H1>Importing QUESTIONS:</H1><BR>\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub upload_subjareas {
|
||
|
|
&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "AD/US");
|
||
|
|
# upload subject areas
|
||
|
|
print "<H1>Importing SUBJECT AREAS:</H1><BR>\n";
|
||
|
|
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
sub open_results {
|
||
|
|
print "<HTML>
|
||
|
|
<BODY>
|
||
|
|
";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub close_results {
|
||
|
|
print "
|
||
|
|
</BODY>
|
||
|
|
</HTML>
|
||
|
|
";
|
||
|
|
}
|
||
|
|
|