0: <p>
1: Copyright (c) 1999-2001, Keith S. Chea. All rights reserved. 
2: </p><p>
3: Legal Note: codes you see below were extracted
4: from my soon-to-be-released product and they
5: are copyrighted. These codes (and soon-to-be
6: released product) is free, you can redistribute
7: it and/or modify it as long the copyright note
8: (above) remains intact. Using these codes for 
9: commercial purposes without prior permission 
10: from me is prohibited. 
11: </p>
12: <p>
13: Works the same as "dbmmanage add|adduser", except 
14: that you can add group(s) to an existing user, 
15: and remove any duplicated group(s) before adding.
16: </p>
17: <code>
18: #!/usr/local/bin/perl
19: 
20: use strict;
21: use DB_File;
22: my $u = $ARGV[0] || 'japh'; #User ID: i.e japh
23: my $p = $ARGV[1] || '1234'; #Password: i.e 1234
24: my $g = $ARGV[2] || 'perl'; #Group: i.e admin or admin,staff,root
25: my @o = ("email\@yahoo.com", "123 St,Boston,MA 02450,USA","24","Male"); #optionally other information
26: &_($u,$p,$g);
27: 
28: sub _{ my($u1,$p1,$g1,@o1)=@_;
29:        my(%D)=();
30:        my(%G)=();
31:        my(@G,@V,@U,@M);
32: 
33:        flock "pwd.db",2;dbmopen %D,"pwd.db", 0666 or die "$!\n";while(
34: 
35:        my($k,$v) = each %D){$D{$k} = $v;}
36:        my($o) = defined(@o1) ? join ',',@o1 : '';
37:        my($g) = ($g1 =~ /[^\w\-\,]+/) ? undef : $g1;
38:        my($p) = sub {shift;
39:        my(@__)= ('.','/','A'..'Z','a'..'z','0'..'9');
40:        my($s) = $__[rand($#__) + 0] . $__[rand($#__) + 0];
41:        my($c) = crypt($_,$s);};@G = grep {! $G{$_} ++ } split ',',$g1;
42: 
43:        if(exists $D{$u1}){
44:        if(defined $g){@V = split ':',$D{$u1};
45:        if($V[1] ne ''){@M
46:  
47:        = (@G,(split ',',$V[1]));@U 
48:        = grep {! $G{$_} ++ } @M;$V[1] 
49:        = join ',',@U,@G;$D{$u1} 
50:        = join ':',$V[0],$V[1],$V[2];
51:             
52:        }else{$V[1] = join ',',@G;$D{$u1} = join ':',$V[0],$V[1],$V[2];}
53:        }else{dbmclose %D;flock "pwd.db", 8;print "$u1 existed\n";exit(0);}
54:        }else{$D{$u1} = join ':',&$p($p),(join ',',@G),$o;}dbmclose %D;
55: 
56:        flock "pwd.db", 8;
57:        my($z) = sub {dbmopen %D, "pwd.db", 0444 or die "$!\n";while(
58:        my($x,$y) = each %D){return "$x:$y\n";}dbmclose %D;};print &$z;
59:     } 
60: </CODE>
61: <small><strong>Edit</strong> [kudra], 
62: 2001-07-25
63: Changed formatting--HTML not code ;)
64: </small>
65: </p>