eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
  & eval 'exec perl -S $0 $argv:q'
  if 0;
#  THE PRECEEDING STUFF EXECS perl via $PATH
#
# $Id: //guest/sandy_currier/utils/p4users.pl#2 $
#

#
# Copyright (c) 2000, Sandy Currier (sandy@releng.com)
# Distributed under the GNU GENERAL PUBLIC LICENSE:
#
#      This program is free software; you can redistribute it and/or modify
#      it under the terms of the GNU General Public License as published by
#      the Free Software Foundation; either version 1, or (at your option)
#      any later version.
#
#      This program is distributed in the hope that it will be useful,
#      but WITHOUT ANY WARRANTY; without even the implied warranty of
#      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#      GNU General Public License for more details.
#
#      You should have received a copy of the GNU General Public License
#      along with this program; if not, write to the Free Software Foundation,
#      Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
#

# first, see if unix or NT or what...
# need a recent version of perl on NT to have win32 module/config stuff
BEGIN: {
    require 5.004;
    unless ($Platform{'os'}) {
	unless ($Platform{'os'} = $^O) {
	    require Config;
	    $Platform{'os'} = $Config::Config{'osname'};
	}
    }
    # bottom layer OS specific variables/constants
    if ($Platform{'os'}=~/Win/i) {
	#########################
	# win32
	#########################
	require Win32;		# need &Win32::IsWinNT()
	$Platform{'os'} = "win32";
	$Platform{'pd'} = '\\';
	if (&Win32::IsWinNT()) {
	    $Platform{'nt'} = 1;
	}
	else {
	    $Platform{'nt'} = 0;
	}
    } elsif ($Platform{'os'}=~/vms/i) {
	#########################
	# vms
	#########################
	die "vms is currently not a supported platform";
    } elsif ($Platform{'os'}=~/os2/i) {
	#########################
	# os2
	#########################
	die "os2 is currently not a supported platform";
    } elsif ($Platform{'os'}=~/Mac/i or (defined($MacPerl::Version) and $MacPerl::Version)) {
	#########################
	# mac
	#########################
	$Platform{'pd'} = ':';	# use this in pathname pattern matching (mac)
	die "macintosh is currently not a supported platform";
    } else {
	#########################
	# unix
	#########################
	$Platform{'os'} = "unix";
	$Platform{'pd'} = '/';
    }
}

#
# Unbuffer STDERR and STDOUT
select(STDERR);
$| = 1;			# Make STDERR be unbuffered.
select(STDOUT);
$| = 1;			# STDOUT too

#
# set up some globals
$ThisCmd = "p4users"; # this command name

#
# local variables
$verbose = 0;
$err = "***";
$regexp = "";
# Perforce
$P4 = "p4";


#
# now parse any args
# the usage message (for -h or on error)
$help = "$ThisCmd [user]
Function:
    $ThisCmd will list the users catalogued in the various perforce
    groups as well as those perforce groups.  Will follow subgroups
    links.  Will also print <UNKNOWN> for those users listed in a
    group but who have never logged into the server.

    Will also print those users not catalogued in a group
    (<STRANDED>) and referenced but empty groups (<EMPTY>).

    The optional argument is a regular expression to filter
    the output.
                      
Switches/Options:
    -h              Prints this help message
    -u              Only print 'UNKNOWN' users (see above)
";

#
# parse command line
{
    my($i) = 0;
    while($i <= $#ARGV) {
	# scan for a help switch
	if ($ARGV[$i] =~ /^-h/i) {
	    &DieHelp("", $help);
	}
	# scan for switches
	elsif ($ARGV[$i] =~ /^-n/i) {
	    $printonly = 1;
	    $i++;
	}
	elsif ($ARGV[$i] =~ /^-u/i) {
	    $unknown = 1;
	    $i++;
	}
	# scan for variable definitions (-variable value)
	elsif ($ARGV[$i] =~ /^-\w+/ and defined($ARGV[$i+1]) and $ARGV[$i+1] !~ /^-[^-]/) {
	    # NOTE: nt has a difficult time with '=' on a command line...
	    # process any variable value switches
	    my($var) = $ARGV[$i];
	    $var =~ s/^-//;
	    my($value) = $ARGV[$i+1];
	    if (defined $$var) {
		$$var = $value;
	    }
	    else {
		&DieHelp("Unknown parameter '$var'\n", $help);
	    }
	    $i=$i+2;
	}
	# catch unsupported switches
	elsif ($ARGV[$i] =~ /^-/) {
	    &DieHelp("Unsupported switch \"$ARGV[$i]\"\n", $help);
	}
	# snarf first arg
	elsif ($param == 0) {
	    $regexp = $ARGV[$i];
	    $i++; $param++;
	}
	else {
	    &DieHelp("Unsupported argument \"$ARGV[$i]\"\n", $help);
	}
    }
}

#
# first, list the groups
@Groups = &ExecuteP4Cmd("$P4 groups", $verbose);
chomp(@Groups);

#
# get the group info, collecting user and subgroups
foreach my $group (@Groups) {
    &GetGroupInfo($group, \%GroupInfo);
}

#
# now, create a hash for each user found, and add up all the group info
foreach my $group (@Groups) {
    # for each top level group, only visit the subgroups once
    # use a local instead of a my for proper scoping
    local @Visited;
    &GetUsers($group, $group);
}
# now, also get any users explicitly listed in the protect table...
# (but will need super privledges to do this)

#
# now get the real p4 user output
@Users = &ExecuteP4Cmd("$P4 users", $verbose);
chomp(@Users);
# make an array of just the user names for easy grep'ing
foreach (@Users) {
    /^(\S+)\s+</;
    push @Usernames, $1;
}

#
# now print stuff
foreach my $user (sort(keys(%Users))) {
    my $tmp = join(', ', sort(@{$Users{$user}}));
    my $foo = grep(/^$user$/, @Usernames);
    if ($foo) {
	unless ($unknown) {
	    my($tmp) = sprintf "%-20s%s\n", $user, $tmp;
	    push @lines, $tmp;
	}
    }
    else {
	my($tmp) = sprintf "%-20s%s   <UNKNOWN>\n", $user, $tmp;
	push @lines, $tmp;
    }
}

#
# now print stranded groups
@tmp = keys(%Users);
foreach my $user (@Usernames) {
    if (!grep(/^$user$/, @tmp)) {
	my($tmp) = sprintf "%-20s<STRANDED>\n", $user;
	push @lines, $tmp;
    }
}

#
# now print empty groups
foreach my $group (sort(keys(%GroupInfo))) {
    if (!grep(/^$group$/, @Groups)) {
	# find the group that references it
	my(@list, $tmp);
	foreach my $g (keys(%GroupInfo)) {
	    push @list, $g if (grep(/^$group$/, @{$GroupInfo{$g}{'Subgroups'}}));
	}
	$tmp = join(',', @list);
	$tmp = sprintf "%-20s<EMPTY> - referenced by: $tmp\n", $group, $tmp;
	push @lines, $tmp;
    }
}

#
# now filter and print
foreach (@lines) {
    print STDOUT "$_" if (/$regexp/);
}

#
# the end
exit(0);

#
# subroutines
#

# for the specified group, set the hash with the values
sub GetGroupInfo {
    my($group, $groupinfo) = @_;
    my($sub_p, $users_p);
    my(@output) = &ExecuteP4Cmd("$P4 group -o $group", $verbose);
    chomp(@output);
    foreach my $line (@output) {
	if ($line =~ /^MaxResults:\s+(\S+)/) {
	    $$groupinfo{$group}{'MaxResults'} = $1;
	}
	elsif ($line =~ /^Subgroups:/) {
	    $sub_p++;
	}
	elsif ($sub_p and $line =~ /^\s+(\S+)/) {
	    push @{$$groupinfo{$group}{'Subgroups'}}, $1;
	}
	elsif ($sub_p and $line eq "") {
	    $sub_p = 0;
	}
	elsif ($line =~ /^Users:/) {
	    $users_p++;
	}
	elsif ($users_p and $line =~ /^\s+(\S+)/) {
	    push @{$$groupinfo{$group}{'Users'}}, $1;
	}
    }
}


sub GetUsers {
    my($group, $subgroup) = @_;
    # loop over explicit users and add info
    foreach my $user (@{$GroupInfo{$subgroup}{'Users'}}) {
	if (!grep(/^$group$/, @{$Users{$user}})) {
	    push @{$Users{$user}}, $group;
	}
    }
    # loop over subgroups if they have not been visited yet
    foreach my $subg (@{$GroupInfo{$subgroup}{'Subgroups'}}) {
	if (!grep(/^$subg$/, @Visited)) {
	    # this subgroup has not been visited yet - must visit it
	    &GetUsers($group, $subg);
	    # add this subgroup to the visited list
	    push @Visited, $subg;
	}
	else {
	    # this subgroup has already been visited - just return
	}
    }
}


sub DieHelp {
    my($str, $help) = @_;
    print STDERR "$err $str\nUsage: $help";
    exit(1);
}


#
# Note: this will actually execute any command...
# returns the action of the revision of the specified file#revision
sub ExecuteP4Cmd {
    my($script, $verbose, $print_output, $no_error_check, $stream_p) = @_;
    my(@output);
    if ($stream_p) {
	print $stream_p "$vb\n$vb running: $script\n$vb\n" if ($verbose);
    }
    else {
	print STDOUT "$vb\n$vb running: $script\n$vb\n" if ($verbose);
    }
    if (!$Platform{'nt'} and $Platform{'os'} eq "win32") {
	@output = `$script` unless ($printonly);
    }
    else {
	@output = `$script 2>&1` unless ($printonly);
    }
    if ($stream_p) {
	print $stream_p "@output" if ($print_output);
    } else {
	print STDOUT "@output" if ($print_output);
    }
    if (!$no_error_check and $?) {
	# now what - just keep going
	print STDERR "$err $ThisCmd - something happened with '$script'\n$?";
    }
    return(@output);
}