#!/usr/bin/perl
use strict;
use warnings;
use Schema::RDBMS::AUS;
use Schema::RDBMS::AUS::User;
{
my %o;
my %commands = (
help => \&help,
delete => sub{},
info => \&info,
edit => \&edit,
add => \&add,
);
sub {
use Getopt::Long;
GetOptions(\%o,
(map {"$_|".substr($_,0,1)} @_),
(map {"$_|".substr($_,0,1)."=s"} qw(password name id)),
(map {"$_=s"} qw(db dbuser dbpass password_crypt)),
('is_group')
);
local $" = "|--";
die "$0 [--@_]" if 1 != grep {$o{$_}} @_;
}->(keys %commands);
$o{_password} = delete $o{password} if exists $o{password};
exit $commands{(grep { $o{$_} } keys %commands)[0]}->(%o);
}
sub getdb {
my %o = @_;
return Schema::RDBMS::AUS->dbh(@o{'db','dbuser','dbpass'});
}
sub help {
print <<"EOT";
Usage: $0 --info|--delete|--add|--help
--db=DSN --dbuser=username --dbpass=password
--add|--delete
--name=username --id=id --password=password
--password_crypt=crypt --is_group
EOT
0;
}
sub info {
my $dbh = &getdb;
my %o = @_;
die "A username (--name) or id (--id) is required"
unless $o{name} || $o{id};
my $user = Schema::RDBMS::AUS::User->load(%o, _dbh => $dbh);
user_info($user);
}
sub user_info {
my $user = shift;
printf(
qq{User #%i:\n Name: %s\n Crypt: %s\n Used: %s\n Group: %s\n\n},
@$user{'id', 'name', 'password_crypt'},
$user->{time_used} ? $user->{time_used} : 'Never',
$user->{is_group} ? 'Yes' : 'No'
);
return 0;
}
sub add {
my $dbh = &getdb;
my %o = @_;
die "--id is not allowed for add" if $o{id};
my $user = Schema::RDBMS::AUS::User->create(%o, _dbh => $dbh);
user_info($user);
}
sub edit {
my $dbh = &getdb;
my %o = @_;
my $user = Schema::RDBMS::AUS::User->load(%o, _dbh => $dbh);
$dbh->transaction(sub {
if($o{password_crypt} && !$o{_password}) {
warn "Warning: changing password_crypt without changing password ",
"will probably make account unusuable!";
}
%$user = (%$user, %o);
delete $user->{_password};
$user->save;
$user = $user->load;
$user->reset_password($o{_password}) if exists $o{_password};
user_info($user);
1;
});
0;
}