File Coverage

blib/lib/Unix/GroupFile.pm

Criterion	Covered	Total	%
statement	110	115	95.6
branch	33	46	71.7
condition	2	3	66.6
subroutine	15	15	100.0
pod	10	12	83.3
total	170	191	89.0

package Unix::GroupFile;

# $Id: GroupFile.pm,v 1.6 2000/05/02 15:59:34 ssnodgra Exp $

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
use Unix::ConfigFile;

require Exporter;

@ISA = qw(Unix::ConfigFile Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(

);
$VERSION = '0.06';

# Package variables
my $MAXLINELEN = 511;

# Implementation Notes
#
# This module adds 3 new fields to the basic ConfigFile object.  The fields
# are 'gid', 'gpass', and 'group'.  All three of these fields are hashes.
# The gid field maps names to GIDs.  The gpass field maps names to passwords.
# The group fields maps GIDs to another hash of group members.  There are
# no real values in the group subhash, just a '1' as a placeholder.  This is
# a hash instead of a list because it makes duplicate elimination and user
# deletion much easier to deal with.

# Preloaded methods go here.

# Read in the data structures from the supplied file
sub read {
    my ($this, $fh) = @_;

    while (<$fh>) {
	chop;
	my ($name, $password, $gid, $users) = split /:/;
	my @users = split /,/, $users;
	if (defined $this->{group}{$gid}) {
	    foreach (@users) {
		$this->{group}{$gid}{$_} = 1;
	    }
	}
	else {
	    $this->group($name, $password, $gid, @users);
	}
    }
    return 1;
}


# Add, modify, or get a group
sub group {
    my $this = shift;
    my $name = shift;

    # If no more parameters, we return group info
    unless (@_) {
	my $gid = $this->gid($name);
	return undef unless defined $gid;
	return ($this->passwd($name), $gid, $this->members($name));
    }

    # Create or modify a group
    return undef if @_ < 2;
    my $password = shift;
    my $gid = shift;

    # Have to be careful with this test - 0 is a legitimate return value
    return undef unless defined $this->gid($name, $gid);
    $this->passwd($name, $password);
    $this->members($name, @_);
    return ($gid, $password, $this->members($name));
}


# Delete a group
sub delete {
    my ($this, $name) = @_;

    my $gid = $this->gid($name);
    return 0 unless defined $gid;
    delete $this->{gpass}{$name};
    delete $this->{group}{$gid};
    delete $this->{gid}{$name};
    return 1;
}


# Add users to an existing group
sub add_user {
    my $this = shift;
    my $name = shift;
    my @groups = ($name eq "*") ? $this->groups : ($name);

    foreach (@groups) {
	my $gid = $this->gid($_);
	return 0 unless defined $gid;
	foreach my $user (@_) {
	    $this->{group}{$gid}{$user} = 1;
	}
    }
    return 1;
}


# Remove users from an existing group
sub remove_user {
    my $this = shift;
    my $name = shift;
    my @groups = ($name eq "*") ? $this->groups : ($name);

    foreach (@groups) {
	my $gid = $this->gid($_);
	return 0 unless defined $gid;
	foreach my $user (@_) {
	    delete $this->{group}{$gid}{$user};
	}
    }
    return 1;
}


# Rename a user
sub rename_user {
    my ($this, $oldname, $newname) = @_;

    my $count = 0;
    foreach ($this->groups) {
	my $gid = $this->gid($_);
	if (exists $this->{group}{$gid}{$oldname}) {
	    delete $this->{group}{$gid}{$oldname};
	    $this->{group}{$gid}{$newname} = 1;
	    $count++;
	}
    }
    return $count;
}


# Return the list of groups
# Accepts a sorting order parameter: gid or name (default gid)
sub groups {
    my $this = shift;
    my $order = @_ ? shift : "gid";

    return keys %{$this->{gid}} unless wantarray;
    if ($order eq "name") {
	return sort keys %{$this->{gid}};
    }
    else {
	return sort { $this->gid($a) <=> $this->gid($b) } keys %{$this->{gid}};
    }
}


# Returns the maximum GID in use in the file
sub maxgid {
    my $this = shift;
    my @gids = sort { $a <=> $b } keys %{$this->{group}};
    return pop @gids;
}


# Output the file to disk
sub write {
    my ($this, $fh) = @_;

    foreach my $name ($this->groups) {
	my @users = $this->members($name);
	my $head = join(":", $name, $this->passwd($name), $this->gid($name), "");
	my $ind = join(":", "$name%n", $this->passwd($name), $this->gid($name), "");
	print $fh $this->joinwrap($MAXLINELEN, $head, $ind, ",", "", @users),
		"\n" or return 0;
    }
    return 1;
}


# Accessors (these all accept a group name and an optional value)
sub passwd {
    my $this = shift;
    my $name = shift;
    @_ ? $this->{gpass}{$name} = shift : $this->{gpass}{$name};
}


# Note that it is illegal to change a group's GID to one used by another group
# This method also has to take into account side effects produced by doing
# this, such as the fact that the member hash is keyed against the GID.
sub gid {
    my $this = shift;
    my $name = shift;

    return $this->{gid}{$name} unless @_;
    my $newgid = shift;
    my $oldgid = $this->{gid}{$name};
    # Return OK if you try to set the same GID a group already has
    return $oldgid if defined $oldgid && $newgid == $oldgid;
    return undef if grep { $newgid == $_ } values %{$this->{gid}};
    if (defined $oldgid) {
	$this->{group}{$newgid} = $this->{group}{$oldgid};
	delete $this->{group}{$oldgid};
    }
    $this->{gid}{$name} = $newgid;
}


# Return or set the list of users in a group
sub members {
    my $this = shift;
    my $name = shift;

    my $gid = $this->gid($name);
    return undef unless defined $gid;
    if (@_) {
	$this->{group}{$gid} = { };
	$this->add_user($name, @_);
    }
    return keys %{$this->{group}{$gid}} unless wantarray;
    return sort keys %{$this->{group}{$gid}};
}

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__