Unix-Mgt

 view release on metacpan or  search on metacpan

lib/Unix/Mgt.pm  view on Meta::CPAN


# debug tools
# use Debug::ShowStuff ':all';

# safety mechanism for development
our $MOD_ONLY;


#------------------------------------------------------------------------------
# POD
#

=head1 Unix::Mgt::User

A Unix::Mgt::User object represents a user in the Unix system. The object
allows you to get and set information about the user account. A user object
is created in one of three ways: C<get>, C<create>, or C<ensure>. The C<new>
method is an alias for C<get>.

Unix::Mgt::User objects stringify to the account's name. For example, the
following code would output C<miko>.

 $user = Unix::Mgt::User->get('miko');
 print $user, "\n";

=cut

#
# POD
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# field_names
#
our @field_names = qw{
	name
	passwd
	uid
	gid
	quota
	comment
	gecos
	dir
	shell
	expire
};
#
# field_names
#------------------------------------------------------------------------------



#------------------------------------------------------------------------------
# get
#

=head2 get

Unix::Mgt::User->get() retrieves user account information using C<getpwnam> or
C<getpwuid>.  The single param for this method is either the name or the uid of
the user.

 $user = Unix::Mgt::User->get('vera');
 $user = Unix::Mgt::User->get('1010');

If the user is not found then the C<do-not-have-user> error id is set in
C<$Unix::Mgt::err_id> and undef is returned.

=cut

# alias new to get
sub new {
	my $class = shift(@_);
	return $class->get(@_);
}

sub get {
	my $class = shift(@_);
	my ($name, %opts) = $class->even_odd_params('name', @_);
	my (@fields, $user);
	
	# TESTING
	# println subname(method=>1); ##i
	
	# reset error globals
	$class->reset_err();
	
	# check and normalize name
	$name = $class->name_check($name, 'missing-user-name');
	$name or return undef;
	
	# get fields
	@fields = $class->fields($name);
	
	# if user exists, get name, else throw error
	if (@fields) {
		$name = $fields[0];
	}
	else {
		return $class->set_err(
			'do-not-have-user',
			$class->called_sub() . qq|: do not find a user with name "$name"|,
		);
	}
	
	# create object
	$user = bless({}, $class);
	
	# hold on to name
	$user->{'name'} = $name;
	
	# return
	return $user;
}
#
# get
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# entry
#
sub entry {
	my ($user) = @_;
	my (@fields, %entry);
	
	# TESTING
	# println subname(method=>1); ##i
	
	# get fields
	@fields = $user->fields($user->{'name'});
	
	# if no fields, set error and return undef
	if (! @fields) {
		return $user->set_err(
			'do-not-have-user-entry-anymore',
			$user->called_sub() . ': do not have a user with name "' . $user->{'name'} . '"',
		);
	}
	
	# set hash
	@entry{@field_names} = @fields;
	
	# return
	return \%entry;
}
#
# entry
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# fields
#
sub fields {
	my ($class, $name) = @_;
	
	# TESTING
	# println subname(method=>1); ##i
	
	# return
	if ($name =~ m|^\d+$|s)
		{ return getpwuid($name) }
	else
		{ return getpwnam($name) }
}
#
# fields
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# create
#

=head2 create

Unix::Mgt::User->create() creates a user account.  The required param for this
method is the name for the new account.

 $user = Unix::Mgt::User->create('vera');

If the C<system> param is true, then the account is created as a system user,
like this:

 $user = Unix::Mgt::User->create('lanny', system=>1);

create() uses the Unix C<adduser> program.

=cut

sub create {
	my $class = shift(@_);
	my ($name, %opts) = $class->even_odd_params('name', @_);
	my ($user, @cmd);
	
	# TESTING
	# println subname(method=>1); ##i
	
	# reset error globals
	$class->reset_err();
	
	# check and normalize name
	$name = $class->name_check($name, 'missing-user-name');
	$name or return undef;
	
	# if user exists, throw error
	if ($class->fields($name)) {
		return $class->set_err(
			'already-have-user',
			$class->called_sub() . qq|: already have a user with name "$name"|,
		);
	}
	
	# safety check
	$class->mod_only($name);
	
	# BSD style
	if ($class->use_bsd) {
		@cmd = (
			'pw',
			'useradd',
			'-n',



( run in 1.548 second using v1.01-cache-2.11-cpan-df04353d9ac )