# FILE: usr-list.pl
# DESCRIPTION: Adding a list of users through User Manager
#-------------------------------------------------------------------------------
# DISCUS COPYRIGHT NOTICE
#
# Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
# The use of Discus is governed by the Discus License Agreement which is
# available from the Discus WWW site at:
#    http://www.discusware.com/discus/license
#
# Pursuant to the Discus License Agreement, this copyright notice may not be
# removed or altered in any way.
#-------------------------------------------------------------------------------

use strict;
use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);

###
### userlist_admin_main
###
### Main control for user interface administration list
###

sub userlist_admin_main {
	my ($FORMref, $result) = @_;	
	if ($FORMref->{action} eq "user_list_preview") {
		userlist_admin_preview($FORMref, $result) if $FORMref->{screen} == 0;
		userlist_admin_play($FORMref, $result) if $FORMref->{screen} == 1;
		userlist_admin_add($FORMref, $result) if $FORMref->{screen} == 2;
	}
}

###
### userlist_admin_add
###
### Add the specified users to the user list
###

sub userlist_admin_add {
	my ($FORMref, $result) = @_;	
	my ($substcols, $cols, $coldefine) = userlist_get_form_cols($FORMref, $result);
	my $ulist = create_userlist_boxes($FORMref, $cols);
	my @u = ();
	my $grp = $FORMref->{group}; $grp =~ s/\W//g;
	foreach my $ul (@{ $ulist }) {
		my $hash = {};
		$hash->{user} = $ul->{USERNAME};
		$hash->{pass} = $ul->{PASSWORD};
		$hash->{forcechange} = $FORMref->{forcechange};
		$hash->{email} = $ul->{EMAIL};
		$hash->{fullname} = $ul->{FULLNAME};
		$hash->{groups} = join($grp, '/', '/');
		push @u, $hash if $hash->{user} ne "";		
	}
	dreq("fcn-acct");
	my ($success, $failure) = add_account(\@u, { database => 'users' });
	my $subst = {};
	if ($DCONF->{pro} && $FORMref->{mail_pw}) {
		dreq("fcn-user-PRO");
		$subst->{general}->{mailfile} = user_mail_passwords($success, $FORMref->{mailfile});
	}
	$subst->{coldefine} = $coldefine;
	$subst->{cols} = $substcols;
	$subst->{general}->{successes} = ref $success eq 'ARRAY' ? scalar(@{$success}) : 0;
	$subst->{general}->{failures} = ref $failure eq 'ARRAY' ? scalar(@{$failure}) : 0;
	$subst->{general}->{total} = $subst->{general}->{successes} + $subst->{general}->{failures};
	$subst->{general}->{username} = $result->[0]->{user};
	$subst->{general}->{group} = $FORMref->{group};
	if ($subst->{general}->{failures}) {
		$subst->{general}->{screen} = 2;
		my @flist = ();
		foreach my $fail (@{ $failure }) {
			my $hash = $fail;
			$hash->{USERNAME} = $fail->{user};	
			$hash->{PASSWORD} = $fail->{final_password};	
			$hash->{EMAIL} = $fail->{email};	
			$hash->{FULLNAME} = $fail->{fullname};
			$hash->{error_code} = $fail->{error_code};
			push @flist, $hash;
		}
		$subst->{userlist} = \@flist;
		$subst->{checked}->{mail_pw} = $FORMref->{mail_pw};
		$subst->{checked}->{forcechange} = $FORMref->{forcechange};
	} else {
		$subst->{general}->{screen} = 3;
	}
	screen_out("usrlist", $subst);
}

###
### userlist_get_form_cols
###
### Gets column information from the form
###

sub userlist_get_form_cols {
	my ($FORMref, $result) = @_;
	my $taken = {};
	my @cols = ();
	my $cols = [];
	my $coldefine = {};
	for (my $i = 1; $i <= scalar(grep(/^col\d/, keys(%{ $FORMref }))); $i++) {
		userlist_admin_preview($FORMref, $result, $FORMref->{"col$i"}) if $taken->{$FORMref->{"col$i"}};
		$taken->{$FORMref->{"col$i"}} = 1 if $FORMref->{"col$i"} ne "NOOP";
		push @{ $cols }, $FORMref->{"col$i"} if $FORMref->{"col$i"};
		next if $FORMref->{"col$i"} eq "NOOP";
		push @cols, { column => $FORMref->{"col$i"} } if $FORMref->{"col$i"};
		$coldefine->{$FORMref->{"col$i"}} = 1;
	}
	return (\@cols, $cols, $coldefine);
}


###
### userlist_admin_play
###
### Manipulate list in various ways
###

sub userlist_admin_play {
	my ($FORMref, $result) = @_;
	my @userlist = ();
	my $subst = {};
	my ($substcols, $cols, $coldefine) = userlist_get_form_cols($FORMref);
	my @cols = @{ $cols };
	$subst->{coldefine} = $coldefine;
	$subst->{cols} = $substcols;
	if (defined $FORMref->{x_list}) {	
		my $list = unescape($FORMref->{x_list});
		my @list = split(/\n/, $list);
		my $delim = $FORMref->{delim};
		$delim = quotemeta($delim); $delim =~ s/\\\\t/\\t/; $delim =~ s/\\\\s\\\+/\\s\+/;
		my $ulist = create_userlist(\@list, $delim, $cols, 1);
		@userlist = @{ $ulist };
	} else {
		if ($FORMref->{manip} > 0) {
			$FORMref = user_list_manipulations($FORMref, $cols) if $FORMref->{manip} > 0;
			$FORMref->{manip} = 0;
			userlist_admin_play($FORMref, $result);
		}
		my $ulist = create_userlist_boxes($FORMref, $cols);
		@userlist = @{ $ulist };
	}
	$subst->{userlist} = \@userlist;
	$subst->{general}->{username} = $result->[0]->{user};
	$subst->{general}->{group} = $FORMref->{group};
	$subst->{general}->{screen} = 1;
	screen_out("usrlist", $subst);
}

###
### user_list_manipulations
###
### Generate usernames and passwords in a variety of ways
###

sub user_list_manipulations {
	my ($self, $columns) = @_;
	my $nextcol = scalar(@{ $columns })+1;
	my $box = {};
	foreach my $key (keys(%{ $self })) {
		if ($key =~ /^b_(\d+)_(\d+)$/) {
			$box->{$1}->{$2} = $self->{$key};
		}
	}
	my @manips = ({},
		{ dest => 'USERNAME', source => 'FULLNAME' },
		{ dest => 'USERNAME', source => 'EMAIL' },
		{ dest => 'PASSWORD', source => undef },
		{ dest => 'PASSWORD', source => 'USERNAME' },
		{ dest => 'EMAIL', source => 'EMAIL' },
		);
	my $h = $manips[$self->{manip}];
	return $self if ! defined $h || ! defined $h->{dest};
	my $src_col = _user_list_manipulations_target_col($h->{source}, $columns);
	$self->{"col$nextcol"} = $h->{dest} if $self->{manip} != 5;
	my $new_domain = $self->{newdomain};
	$new_domain =~ s/^\@//;
	foreach my $boxer (keys(%{ $box })) {
		my $N = ""; my $O = $box->{$boxer}->{$src_col};
		if ($self->{manip} == 1) {
			$N = extract_lastname($O);
		} elsif ($self->{manip} == 2) {
			$N = $1 if $O =~ /([\w\+\-\.]+)\@/;	
		} elsif ($self->{manip} == 3) {
			dreq("fcn-acct");
			$N = pick_random_password(1);
		} elsif ($self->{manip} == 4) {
			$N = $O;
		} elsif ($self->{manip} == 5) {
			$self->{join("_", "b", $boxer, $src_col)} .= "\@$new_domain" if $O !~ /\@/;
			next;
		}
		$self->{join("_", "b", $boxer, $nextcol)} = $N;		
	}
	return $self;
}

sub _user_list_manipulations_target_col {
	my ($target, $columns) = @_;
	my $c = 0;
	foreach my $q (@{ $columns }) {	
		$c++;
		return $c if $q eq $target;
	}
	return undef;	
}

###
### create_userlist_boxes
###
### Creates revised user list from user-supplied boxes
###

sub create_userlist_boxes {
	my ($FORMref, $columns) = @_;
	my $box = {};
	my @li = ();
	foreach my $key (keys(%{ $FORMref })) {
		if ($key =~ /^b_(\d+)_(\d+)$/) {
			$box->{$1}->{$2} = $FORMref->{$key};
		}
	}
	my @lines = sort { $a <=> $b } keys(%{$box});
	foreach my $line (@lines) {
		my @z = sort { $a <=> $b } keys(%{$box->{$line}});
		my @u = ();
		foreach my $z (@z) {
			push @u, $box->{$line}->{$z};
		}
		push @li, \@u;
	}
	my @out = map { userlist_box_make_hash($_, $columns) } @li;
	@out = grep($_->{USERNAME} =~ /\S/, @out) if grep($_->{USERNAME}, @out);
	return \@out;	
}

###
### userlist_box_make_hash
###
### Creates a hash for a user list from user-supplied boxes
###

sub userlist_box_make_hash {
	my ($array, $columns) = @_;
	my $hash = {};
	my @l = @{ $array };
	my @z = @{ $columns };
	foreach my $z (@z) {
		$hash->{$z} = shift @l;
	}
	return $hash;	
}

###
### userlist_admin_preview
###
### Preview of user list for administration program
###

sub userlist_admin_preview {
	my ($FORMref, $result, $flag) = @_;
	my $subst = {};
	my $list = defined $FORMref->{x_list} ? unescape($FORMref->{x_list}) : $FORMref->{list};
	my $onesixty = chr(160);
	my @list = map { s/$onesixty//; s/^\s+//; s/\s$//; $_ } split(/\n+/, $list);
	$list = join("\n", @list);
	my $delim = defined $FORMref->{delim} ? $FORMref->{delim} : guess_delimiter(\@list);
	$subst->{general}->{delim} = $delim;
	$delim = quotemeta($delim); $delim =~ s/\\\\t/\\t/; $delim =~ s/\\\\s\\\+/\\s\+/;
	my $cols = [];
	if ($FORMref->{'delim_orig'} eq $FORMref->{'delim'} && defined $FORMref->{col1}) {
		my @cols = ();
		for (my $i = 1; $i <= scalar(grep(/^col\d/, keys(%{ $FORMref }))); $i++) {
			push @cols, { column => $FORMref->{"col$i"} } if $FORMref->{"col$i"};
			push @{ $cols }, $FORMref->{"col$i"} if $FORMref->{"col$i"};
		}
		$subst->{cols} = \@cols;
	} else {
		my ($co, $incl) = guess_columns(\@list, $delim); shift @list if $incl;
		my @cols = ();
		foreach my $col (@{ $co }) {
			push @cols, { column => $col };
		}
		$cols = $co;
		$subst->{cols} = \@cols;
	}		
	$subst->{userlist} = create_userlist(\@list, $delim, $cols);
	$subst->{general}->{username} = $result->[0]->{user};
	$subst->{general}->{group} = $FORMref->{group};
	$subst->{general}->{screen} = 0;
	$subst->{general}->{list} = $list;
	$subst->{general}->{flag} = $flag;
	screen_out("usrlist", $subst);
}

###
### create_userlist
###
### Creates an array of incoming users, separated into their columns
###

sub create_userlist {
	my ($list_in, $delim, $columns, $flag) = @_;
	my @li = ref $list_in eq 'ARRAY' ? @{ $list_in } : split(/\n/, $list_in);
	my @li1 = @li;
	my @li2 = @li;
	$delim = guess_delimiter(\@li1) if ! $delim;
	if (! defined $columns) {
		my ($cols, $incl) = guess_columns(\@li2, $delim);
		shift @li if $incl;
		$columns = $cols;
	}
	my @out = map { userlist_make_hash($_, $delim, $columns, $flag) } @li;
	return \@out;	
}

###
### userlist_make_hash
###
### Makes a hash of information from the columns
###

sub userlist_make_hash {
	my ($line, $delimiter, $columns, $flag) = @_;
	my @z = @{ $columns };
	chomp $line;
	$line =~ s/"(.*?)"/join(escape($1), '"', '"')/ge;
	my @l = split(/$delimiter/, $line);
	foreach my $q (@l) {
		$q =~ s/"([\w\%\+]+)"/unescape($1)/ge;
	}
	my $hash = {};
	foreach my $z (@z) {
		$hash->{$z} = shift @l;
	}
	return $hash;	
}

###
### guess_columns
###
### Guesses what columns represent a full name, e-mail address, username, and password
###

sub guess_columns {
	my ($list_in, $delim) = @_;
	my @li = ref $list_in eq 'ARRAY' ? @{ $list_in } : split(/\n/, $list_in);
	if ($li[0] =~ /^(\*[A-Z]+\*($delim|\n|$))+/) {
		my @u = split(/$delim/, $li[0]);
		foreach my $u (@u) {
			chomp $u; $u =~ s/\*//g;
		}
		return (\@u, 1);
	}
	my $votes = {};
	foreach my $line (@li) {
		chomp $line;
		my @u = split(/$delim/, $line);
		my $ctr = -1;
		my $flag = 0;
		foreach my $u (@u) {
			$ctr++;
			if ($u =~ /^([\w\+\-\.]+)\@([\w\+\-\.]+)$/) {
				$votes->{$ctr}->{EMAIL}++;
			} elsif ($u =~ /\s/) {
				$votes->{$ctr}->{FULLNAME}++;
			} elsif ($flag == 0) {
				$votes->{$ctr}->{USERNAME}++; $flag = 1;
			} elsif ($flag == 1) {
				$votes->{$ctr}->{PASSWORD}++; $flag = 2;
			}			
		}	
	}
	my $taken = {};
	my $vkmax = (sort { $b <=> $a } keys(%{ $votes }))[0];
	my @u = ();
F:	for (my $i = 0; $i <= $vkmax; $i++) {
		my $v = $votes->{$i};
		my @z = sort { $v->{$b} <=> $v->{$a} } keys(%{ $v });
I:		foreach my $j (@z) {
			next I if $taken->{$j};
			push @u, $j;
			next F;
		}
		push @u, "COLUMN$i";
	}
	return (\@u, 0);
}

###
### guess_delimiter
###
### Looks at an incoming list and guesses what the delimiter is
###

sub guess_delimiter {
	my ($list_in) = @_;
	my @li = ref $list_in eq 'ARRAY' ? @{ $list_in } : ( $list_in );
	my @candidates = ('\t', ":", ";", ",", '\s+');
	my $results = {};
	foreach my $delim (@candidates) {
		foreach my $line (@li) {
			chomp $line;
			$line =~ s/"(.*?)"/join(escape($1), '"', '"')/ge;
			my @s = split(/$delim/, $line);
			next if scalar(@s) == 1;
			$results->{$delim}->{scalar(@s)} += ( $delim eq '\s+' ? 2 : 1 );
		}
	}
	my %x = {};
	foreach my $k (keys(%{ $results })) {
		my %l = %{$results->{$k}};
		my @z = sort { $a <=> $b } values(%l);
		$x{$k} = $z[$#z];
	}
	my @z = sort { $x{$b} <=> $x{$a} } keys(%x);
	return $z[0];
}

###
### extract_lastname
###
### Parses several common name formats to determine the last name
###

sub extract_lastname {
	my $name = trim ($_[0]);
	return $1 if $name =~ /^(\S+?),\s*\S/;
	return $3 if $name =~ /^(\S+?)\.\s+?(\S+?)\s+(\S+?)\s*,?/;
	return $3 if $name =~ /^(\S+?)\s+(\S+?)\.?\s+(\S+?)\s*,/;
	return $2 if $name =~ /^(\S+?)\s+(\S+?)\s*,\s*(\S+?)/;
	return $3 if $name =~ /^(\S+?)\s+(\S+?)\.?\s+(\S+?)$/;
	return $3 if $name =~ /^(\S+?)\s+(\S+?)\s+(\S+?)$/;
	return $2 if $name =~ /^(\S+?)\s+?(\S+?)$/;
	$name =~ s/\s/_/g; return $name;
}







1;
