home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / discus_admin_1357211388 / source / usr-list.pl < prev    next >
Text File  |  2009-11-06  |  12KB  |  446 lines
  1. # FILE: usr-list.pl
  2. # DESCRIPTION: Adding a list of users through User Manager
  3. #-------------------------------------------------------------------------------
  4. # DISCUS COPYRIGHT NOTICE
  5. #
  6. # Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
  7. # The use of Discus is governed by the Discus License Agreement which is
  8. # available from the Discus WWW site at:
  9. #    http://www.discusware.com/discus/license
  10. #
  11. # Pursuant to the Discus License Agreement, this copyright notice may not be
  12. # removed or altered in any way.
  13. #-------------------------------------------------------------------------------
  14.  
  15. use strict;
  16. use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);
  17.  
  18. ###
  19. ### userlist_admin_main
  20. ###
  21. ### Main control for user interface administration list
  22. ###
  23.  
  24. sub userlist_admin_main {
  25.     my ($FORMref, $result) = @_;    
  26.     if ($FORMref->{action} eq "user_list_preview") {
  27.         userlist_admin_preview($FORMref, $result) if $FORMref->{screen} == 0;
  28.         userlist_admin_play($FORMref, $result) if $FORMref->{screen} == 1;
  29.         userlist_admin_add($FORMref, $result) if $FORMref->{screen} == 2;
  30.     }
  31. }
  32.  
  33. ###
  34. ### userlist_admin_add
  35. ###
  36. ### Add the specified users to the user list
  37. ###
  38.  
  39. sub userlist_admin_add {
  40.     my ($FORMref, $result) = @_;    
  41.     my ($substcols, $cols, $coldefine) = userlist_get_form_cols($FORMref, $result);
  42.     my $ulist = create_userlist_boxes($FORMref, $cols);
  43.     my @u = ();
  44.     my $grp = $FORMref->{group}; $grp =~ s/\W//g;
  45.     foreach my $ul (@{ $ulist }) {
  46.         my $hash = {};
  47.         $hash->{user} = $ul->{USERNAME};
  48.         $hash->{pass} = $ul->{PASSWORD};
  49.         $hash->{forcechange} = $FORMref->{forcechange};
  50.         $hash->{email} = $ul->{EMAIL};
  51.         $hash->{fullname} = $ul->{FULLNAME};
  52.         $hash->{groups} = join($grp, '/', '/');
  53.         push @u, $hash if $hash->{user} ne "";        
  54.     }
  55.     dreq("fcn-acct");
  56.     my ($success, $failure) = add_account(\@u, { database => 'users' });
  57.     my $subst = {};
  58.     if ($DCONF->{pro} && $FORMref->{mail_pw}) {
  59.         dreq("fcn-user-PRO");
  60.         $subst->{general}->{mailfile} = user_mail_passwords($success, $FORMref->{mailfile});
  61.     }
  62.     $subst->{coldefine} = $coldefine;
  63.     $subst->{cols} = $substcols;
  64.     $subst->{general}->{successes} = ref $success eq 'ARRAY' ? scalar(@{$success}) : 0;
  65.     $subst->{general}->{failures} = ref $failure eq 'ARRAY' ? scalar(@{$failure}) : 0;
  66.     $subst->{general}->{total} = $subst->{general}->{successes} + $subst->{general}->{failures};
  67.     $subst->{general}->{username} = $result->[0]->{user};
  68.     $subst->{general}->{group} = $FORMref->{group};
  69.     if ($subst->{general}->{failures}) {
  70.         $subst->{general}->{screen} = 2;
  71.         my @flist = ();
  72.         foreach my $fail (@{ $failure }) {
  73.             my $hash = $fail;
  74.             $hash->{USERNAME} = $fail->{user};    
  75.             $hash->{PASSWORD} = $fail->{final_password};    
  76.             $hash->{EMAIL} = $fail->{email};    
  77.             $hash->{FULLNAME} = $fail->{fullname};
  78.             $hash->{error_code} = $fail->{error_code};
  79.             push @flist, $hash;
  80.         }
  81.         $subst->{userlist} = \@flist;
  82.         $subst->{checked}->{mail_pw} = $FORMref->{mail_pw};
  83.         $subst->{checked}->{forcechange} = $FORMref->{forcechange};
  84.     } else {
  85.         $subst->{general}->{screen} = 3;
  86.     }
  87.     screen_out("usrlist", $subst);
  88. }
  89.  
  90. ###
  91. ### userlist_get_form_cols
  92. ###
  93. ### Gets column information from the form
  94. ###
  95.  
  96. sub userlist_get_form_cols {
  97.     my ($FORMref, $result) = @_;
  98.     my $taken = {};
  99.     my @cols = ();
  100.     my $cols = [];
  101.     my $coldefine = {};
  102.     for (my $i = 1; $i <= scalar(grep(/^col\d/, keys(%{ $FORMref }))); $i++) {
  103.         userlist_admin_preview($FORMref, $result, $FORMref->{"col$i"}) if $taken->{$FORMref->{"col$i"}};
  104.         $taken->{$FORMref->{"col$i"}} = 1 if $FORMref->{"col$i"} ne "NOOP";
  105.         push @{ $cols }, $FORMref->{"col$i"} if $FORMref->{"col$i"};
  106.         next if $FORMref->{"col$i"} eq "NOOP";
  107.         push @cols, { column => $FORMref->{"col$i"} } if $FORMref->{"col$i"};
  108.         $coldefine->{$FORMref->{"col$i"}} = 1;
  109.     }
  110.     return (\@cols, $cols, $coldefine);
  111. }
  112.  
  113.  
  114. ###
  115. ### userlist_admin_play
  116. ###
  117. ### Manipulate list in various ways
  118. ###
  119.  
  120. sub userlist_admin_play {
  121.     my ($FORMref, $result) = @_;
  122.     my @userlist = ();
  123.     my $subst = {};
  124.     my ($substcols, $cols, $coldefine) = userlist_get_form_cols($FORMref);
  125.     my @cols = @{ $cols };
  126.     $subst->{coldefine} = $coldefine;
  127.     $subst->{cols} = $substcols;
  128.     if (defined $FORMref->{x_list}) {    
  129.         my $list = unescape($FORMref->{x_list});
  130.         my @list = split(/\n/, $list);
  131.         my $delim = $FORMref->{delim};
  132.         $delim = quotemeta($delim); $delim =~ s/\\\\t/\\t/; $delim =~ s/\\\\s\\\+/\\s\+/;
  133.         my $ulist = create_userlist(\@list, $delim, $cols, 1);
  134.         @userlist = @{ $ulist };
  135.     } else {
  136.         if ($FORMref->{manip} > 0) {
  137.             $FORMref = user_list_manipulations($FORMref, $cols) if $FORMref->{manip} > 0;
  138.             $FORMref->{manip} = 0;
  139.             userlist_admin_play($FORMref, $result);
  140.         }
  141.         my $ulist = create_userlist_boxes($FORMref, $cols);
  142.         @userlist = @{ $ulist };
  143.     }
  144.     $subst->{userlist} = \@userlist;
  145.     $subst->{general}->{username} = $result->[0]->{user};
  146.     $subst->{general}->{group} = $FORMref->{group};
  147.     $subst->{general}->{screen} = 1;
  148.     screen_out("usrlist", $subst);
  149. }
  150.  
  151. ###
  152. ### user_list_manipulations
  153. ###
  154. ### Generate usernames and passwords in a variety of ways
  155. ###
  156.  
  157. sub user_list_manipulations {
  158.     my ($self, $columns) = @_;
  159.     my $nextcol = scalar(@{ $columns })+1;
  160.     my $box = {};
  161.     foreach my $key (keys(%{ $self })) {
  162.         if ($key =~ /^b_(\d+)_(\d+)$/) {
  163.             $box->{$1}->{$2} = $self->{$key};
  164.         }
  165.     }
  166.     my @manips = ({},
  167.         { dest => 'USERNAME', source => 'FULLNAME' },
  168.         { dest => 'USERNAME', source => 'EMAIL' },
  169.         { dest => 'PASSWORD', source => undef },
  170.         { dest => 'PASSWORD', source => 'USERNAME' },
  171.         { dest => 'EMAIL', source => 'EMAIL' },
  172.         );
  173.     my $h = $manips[$self->{manip}];
  174.     return $self if ! defined $h || ! defined $h->{dest};
  175.     my $src_col = _user_list_manipulations_target_col($h->{source}, $columns);
  176.     $self->{"col$nextcol"} = $h->{dest} if $self->{manip} != 5;
  177.     my $new_domain = $self->{newdomain};
  178.     $new_domain =~ s/^\@//;
  179.     foreach my $boxer (keys(%{ $box })) {
  180.         my $N = ""; my $O = $box->{$boxer}->{$src_col};
  181.         if ($self->{manip} == 1) {
  182.             $N = extract_lastname($O);
  183.         } elsif ($self->{manip} == 2) {
  184.             $N = $1 if $O =~ /([\w\+\-\.]+)\@/;    
  185.         } elsif ($self->{manip} == 3) {
  186.             dreq("fcn-acct");
  187.             $N = pick_random_password(1);
  188.         } elsif ($self->{manip} == 4) {
  189.             $N = $O;
  190.         } elsif ($self->{manip} == 5) {
  191.             $self->{join("_", "b", $boxer, $src_col)} .= "\@$new_domain" if $O !~ /\@/;
  192.             next;
  193.         }
  194.         $self->{join("_", "b", $boxer, $nextcol)} = $N;        
  195.     }
  196.     return $self;
  197. }
  198.  
  199. sub _user_list_manipulations_target_col {
  200.     my ($target, $columns) = @_;
  201.     my $c = 0;
  202.     foreach my $q (@{ $columns }) {    
  203.         $c++;
  204.         return $c if $q eq $target;
  205.     }
  206.     return undef;    
  207. }
  208.  
  209. ###
  210. ### create_userlist_boxes
  211. ###
  212. ### Creates revised user list from user-supplied boxes
  213. ###
  214.  
  215. sub create_userlist_boxes {
  216.     my ($FORMref, $columns) = @_;
  217.     my $box = {};
  218.     my @li = ();
  219.     foreach my $key (keys(%{ $FORMref })) {
  220.         if ($key =~ /^b_(\d+)_(\d+)$/) {
  221.             $box->{$1}->{$2} = $FORMref->{$key};
  222.         }
  223.     }
  224.     my @lines = sort { $a <=> $b } keys(%{$box});
  225.     foreach my $line (@lines) {
  226.         my @z = sort { $a <=> $b } keys(%{$box->{$line}});
  227.         my @u = ();
  228.         foreach my $z (@z) {
  229.             push @u, $box->{$line}->{$z};
  230.         }
  231.         push @li, \@u;
  232.     }
  233.     my @out = map { userlist_box_make_hash($_, $columns) } @li;
  234.     @out = grep($_->{USERNAME} =~ /\S/, @out) if grep($_->{USERNAME}, @out);
  235.     return \@out;    
  236. }
  237.  
  238. ###
  239. ### userlist_box_make_hash
  240. ###
  241. ### Creates a hash for a user list from user-supplied boxes
  242. ###
  243.  
  244. sub userlist_box_make_hash {
  245.     my ($array, $columns) = @_;
  246.     my $hash = {};
  247.     my @l = @{ $array };
  248.     my @z = @{ $columns };
  249.     foreach my $z (@z) {
  250.         $hash->{$z} = shift @l;
  251.     }
  252.     return $hash;    
  253. }
  254.  
  255. ###
  256. ### userlist_admin_preview
  257. ###
  258. ### Preview of user list for administration program
  259. ###
  260.  
  261. sub userlist_admin_preview {
  262.     my ($FORMref, $result, $flag) = @_;
  263.     my $subst = {};
  264.     my $list = defined $FORMref->{x_list} ? unescape($FORMref->{x_list}) : $FORMref->{list};
  265.     my $onesixty = chr(160);
  266.     my @list = map { s/$onesixty//; s/^\s+//; s/\s$//; $_ } split(/\n+/, $list);
  267.     $list = join("\n", @list);
  268.     my $delim = defined $FORMref->{delim} ? $FORMref->{delim} : guess_delimiter(\@list);
  269.     $subst->{general}->{delim} = $delim;
  270.     $delim = quotemeta($delim); $delim =~ s/\\\\t/\\t/; $delim =~ s/\\\\s\\\+/\\s\+/;
  271.     my $cols = [];
  272.     if ($FORMref->{'delim_orig'} eq $FORMref->{'delim'} && defined $FORMref->{col1}) {
  273.         my @cols = ();
  274.         for (my $i = 1; $i <= scalar(grep(/^col\d/, keys(%{ $FORMref }))); $i++) {
  275.             push @cols, { column => $FORMref->{"col$i"} } if $FORMref->{"col$i"};
  276.             push @{ $cols }, $FORMref->{"col$i"} if $FORMref->{"col$i"};
  277.         }
  278.         $subst->{cols} = \@cols;
  279.     } else {
  280.         my ($co, $incl) = guess_columns(\@list, $delim); shift @list if $incl;
  281.         my @cols = ();
  282.         foreach my $col (@{ $co }) {
  283.             push @cols, { column => $col };
  284.         }
  285.         $cols = $co;
  286.         $subst->{cols} = \@cols;
  287.     }        
  288.     $subst->{userlist} = create_userlist(\@list, $delim, $cols);
  289.     $subst->{general}->{username} = $result->[0]->{user};
  290.     $subst->{general}->{group} = $FORMref->{group};
  291.     $subst->{general}->{screen} = 0;
  292.     $subst->{general}->{list} = $list;
  293.     $subst->{general}->{flag} = $flag;
  294.     screen_out("usrlist", $subst);
  295. }
  296.  
  297. ###
  298. ### create_userlist
  299. ###
  300. ### Creates an array of incoming users, separated into their columns
  301. ###
  302.  
  303. sub create_userlist {
  304.     my ($list_in, $delim, $columns, $flag) = @_;
  305.     my @li = ref $list_in eq 'ARRAY' ? @{ $list_in } : split(/\n/, $list_in);
  306.     my @li1 = @li;
  307.     my @li2 = @li;
  308.     $delim = guess_delimiter(\@li1) if ! $delim;
  309.     if (! defined $columns) {
  310.         my ($cols, $incl) = guess_columns(\@li2, $delim);
  311.         shift @li if $incl;
  312.         $columns = $cols;
  313.     }
  314.     my @out = map { userlist_make_hash($_, $delim, $columns, $flag) } @li;
  315.     return \@out;    
  316. }
  317.  
  318. ###
  319. ### userlist_make_hash
  320. ###
  321. ### Makes a hash of information from the columns
  322. ###
  323.  
  324. sub userlist_make_hash {
  325.     my ($line, $delimiter, $columns, $flag) = @_;
  326.     my @z = @{ $columns };
  327.     chomp $line;
  328.     $line =~ s/"(.*?)"/join(escape($1), '"', '"')/ge;
  329.     my @l = split(/$delimiter/, $line);
  330.     foreach my $q (@l) {
  331.         $q =~ s/"([\w\%\+]+)"/unescape($1)/ge;
  332.     }
  333.     my $hash = {};
  334.     foreach my $z (@z) {
  335.         $hash->{$z} = shift @l;
  336.     }
  337.     return $hash;    
  338. }
  339.  
  340. ###
  341. ### guess_columns
  342. ###
  343. ### Guesses what columns represent a full name, e-mail address, username, and password
  344. ###
  345.  
  346. sub guess_columns {
  347.     my ($list_in, $delim) = @_;
  348.     my @li = ref $list_in eq 'ARRAY' ? @{ $list_in } : split(/\n/, $list_in);
  349.     if ($li[0] =~ /^(\*[A-Z]+\*($delim|\n|$))+/) {
  350.         my @u = split(/$delim/, $li[0]);
  351.         foreach my $u (@u) {
  352.             chomp $u; $u =~ s/\*//g;
  353.         }
  354.         return (\@u, 1);
  355.     }
  356.     my $votes = {};
  357.     foreach my $line (@li) {
  358.         chomp $line;
  359.         my @u = split(/$delim/, $line);
  360.         my $ctr = -1;
  361.         my $flag = 0;
  362.         foreach my $u (@u) {
  363.             $ctr++;
  364.             if ($u =~ /^([\w\+\-\.]+)\@([\w\+\-\.]+)$/) {
  365.                 $votes->{$ctr}->{EMAIL}++;
  366.             } elsif ($u =~ /\s/) {
  367.                 $votes->{$ctr}->{FULLNAME}++;
  368.             } elsif ($flag == 0) {
  369.                 $votes->{$ctr}->{USERNAME}++; $flag = 1;
  370.             } elsif ($flag == 1) {
  371.                 $votes->{$ctr}->{PASSWORD}++; $flag = 2;
  372.             }            
  373.         }    
  374.     }
  375.     my $taken = {};
  376.     my $vkmax = (sort { $b <=> $a } keys(%{ $votes }))[0];
  377.     my @u = ();
  378. F:    for (my $i = 0; $i <= $vkmax; $i++) {
  379.         my $v = $votes->{$i};
  380.         my @z = sort { $v->{$b} <=> $v->{$a} } keys(%{ $v });
  381. I:        foreach my $j (@z) {
  382.             next I if $taken->{$j};
  383.             push @u, $j;
  384.             next F;
  385.         }
  386.         push @u, "COLUMN$i";
  387.     }
  388.     return (\@u, 0);
  389. }
  390.  
  391. ###
  392. ### guess_delimiter
  393. ###
  394. ### Looks at an incoming list and guesses what the delimiter is
  395. ###
  396.  
  397. sub guess_delimiter {
  398.     my ($list_in) = @_;
  399.     my @li = ref $list_in eq 'ARRAY' ? @{ $list_in } : ( $list_in );
  400.     my @candidates = ('\t', ":", ";", ",", '\s+');
  401.     my $results = {};
  402.     foreach my $delim (@candidates) {
  403.         foreach my $line (@li) {
  404.             chomp $line;
  405.             $line =~ s/"(.*?)"/join(escape($1), '"', '"')/ge;
  406.             my @s = split(/$delim/, $line);
  407.             next if scalar(@s) == 1;
  408.             $results->{$delim}->{scalar(@s)} += ( $delim eq '\s+' ? 2 : 1 );
  409.         }
  410.     }
  411.     my %x = {};
  412.     foreach my $k (keys(%{ $results })) {
  413.         my %l = %{$results->{$k}};
  414.         my @z = sort { $a <=> $b } values(%l);
  415.         $x{$k} = $z[$#z];
  416.     }
  417.     my @z = sort { $x{$b} <=> $x{$a} } keys(%x);
  418.     return $z[0];
  419. }
  420.  
  421. ###
  422. ### extract_lastname
  423. ###
  424. ### Parses several common name formats to determine the last name
  425. ###
  426.  
  427. sub extract_lastname {
  428.     my $name = trim ($_[0]);
  429.     return $1 if $name =~ /^(\S+?),\s*\S/;
  430.     return $3 if $name =~ /^(\S+?)\.\s+?(\S+?)\s+(\S+?)\s*,?/;
  431.     return $3 if $name =~ /^(\S+?)\s+(\S+?)\.?\s+(\S+?)\s*,/;
  432.     return $2 if $name =~ /^(\S+?)\s+(\S+?)\s*,\s*(\S+?)/;
  433.     return $3 if $name =~ /^(\S+?)\s+(\S+?)\.?\s+(\S+?)$/;
  434.     return $3 if $name =~ /^(\S+?)\s+(\S+?)\s+(\S+?)$/;
  435.     return $2 if $name =~ /^(\S+?)\s+?(\S+?)$/;
  436.     $name =~ s/\s/_/g; return $name;
  437. }
  438.  
  439.  
  440.  
  441.  
  442.  
  443.  
  444.  
  445. 1;
  446.