view release on metacpan or  search on metacpan

user_manage  view on Meta::CPAN

          hidden(-name=>'realm',-value=>$Q::realm),
          hidden(-name=>'user',-value=>$user),
          $REQUIRE_ACCESS_CONTROL ? '' : 
	    ( hidden(-name=>'admin',-value=>$Q::user),
	      hidden(-name=>'passwd',-value=>'')
	     ), 
	  table({-width=>'100%',-border=>''},
		   TR(th(['Set Groups','Set Password'])),
		   TR({-valign=>TOP},
		      td(
			 table({-width=>'100%'},
			       TR({-valign=>TOP},
				  $group_stuff,
				  th('Other:'),
				  td(textfield(-name=>'groups',
					       -default=>'',
					       -override=>1,
					       -size=>12))
				  )
			       )
			 ),
		      td(
			 table({-width=>'100%'},
			       TR(th('Enter:'),td(password_field(-name=>'password1',
								 -default=>$current_passwd,
								 -size=>12,
								 -override=>1))),
			       TR(th('Confirm:'),td(password_field(-name=>'password2',
								   -default=>$current_passwd,
								   -size=>12,
								   -override=>1)))
			       )
			 )
		      )
		),
       $other_fields ? (p(),$other_fields) : (),
       CGI::reset(-value=>'Reset Values'),
       submit(-name=>'action',-value=>'Set Values'),
       end_form();

    if (0) {			# dead code
	my $back = self_url;
	$back=~s/action=[^=&]*&?//g;
	$back=~s/password[0-9]?=[^=&]*&?//g;
	$back=~s/groups=[^=&]*&?//g;
	$back=~s/user=[^=&]*&?//g;
	$back.="user=$user";
	print a({href=>$back},"List of Users");
    }
    print hr();
}

# --------------------- command line functions --------------------
# Usage: user_manage <database> <command> <user> <value1> <value2> <value3>...
#
# commands: adduser deleteuser setgroup view
#
sub dbm_manage {

    my ($realm,$help);
    my $admin = getpwuid($<);

    # process command line
    while ($ARGV[0] && $ARGV[0] =~ /^-/) {
	my $arg = shift @ARGV;
	$realm = shift @ARGV if $arg eq '-r';
	$help++ if $arg =~ /^(-h|--help)/i;
    }
    $realm ||= $DEFAULT_REALM;

    my($command,@rest) = @ARGV;

    # define $command to suppress 'undefined value' errors
    $command = ''  unless (defined($command));

    my $usage = <<USAGE;
Usage: $0 [-r realm] <command> <user> <value1> <value2>...
       Manage Apache databases from the command line.

Arguments:
    realm     Security realm [$DEFAULT_REALM]
    command   One of "add" "delete" "edit" "group" "view" "realms" "format" "setup"

Commands:
    Name    Arguments                                        Description
    ----    ----------                                       -----------
    realms  (none)                                           List realms
    format  (none)                                           Format an access entry for the realm

    add     <user> <password> <group1,group2> <info1,info2>  Add/edit a user's password, groups, info
    edit    <user> <password> <group1,group2> <info1,info2>  Same as "add"
    delete  <user>                                           Delete a user
    group   <user> <group1> <group2>                         Assign user to named group(s)
    info    <user> <field1=value1> <field2=value2>           Edit user's other information

    view    <user>                                           Get information about user
    view    (none)                                           Dump out entire realm
    list                                                     Same as "view"
    setup                                                    Set up a new realm
USAGE
    ;
    die $usage if $help;
    die $usage if !$realm;
    
    die "Unknown database realm \"$realm\".\n",$usage unless $REALMS->exists($realm);
    my $db;

    # don't bother opening database files for the 'format' command
    unless ($command=~/format/) {
	$db = $REALMS->dbm(-realm=>$realm,-writable=>$command=~/add|edit|delete|group|setup/i);
	die HTTPD::RealmManager->error() unless $db;
    }

    $_ = $command;
  SWITCH: 
    {
	/add|edit/i   and  do_add($db,$admin,@rest),last SWITCH;
	/delete/i     and  do_delete($db,$admin,@rest),last SWITCH;
	/realm/i      and  do_realm(),last SWITCH;
	/group/i      and  do_group($db,$admin,@rest),last SWITCH;
	/info/i       and  do_info($db,$admin,@rest),last SWITCH;