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);
}