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