protexp.pl #5

## Set up your connection info here or the trigger won't work!

$p4 = 'p4 -p PORT -u USER -P PASSWD';

##
# ALL WARRANTIES ARE HEREBY DISCLAIMED.
#
# Triggers:
#    protexpOut form-out protect "perl protexp.pl out %formfile%"
#    protexpIn  form-in  protect "perl protexp.pl in  %formfile%"
#
# When this trigger is in place, you can use the variable $user
# in your protection table and have it expanded to multiple lines
# with the variable replaced with each of your Perforce users in
# each expanded line.  To limit this to users in a particular
# group, use $user(group).
#
# For example:
#    write user $user(bobs) * //dev/$user(bobs)/...
# becomes:
#    write user bobA * //dev/bobA/...
#    write user bobB * //dev/bobB/...
#    write user bobC * //dev/bobC/...
# if you have a group "bobs" that contains bobA, bobB, and bobC.
#
# The $dirs variable can be used to expand lists of directories.
# For example:
#    write group * $dirs(//depot/*)/bin/...
# becomes:
#    write group * //depot/main/bin/...
#    write group * //depot/r011/bin/...
#    write group * //depot/r012/bin/...
# This can serve as a replacement for double wildcards.
#
# Before your protections are saved, the "in" trigger will perform
# this expansion and save a hex-encoded "comment" in the spec with
# the line you originally entered.  When you retrieve the table,
# the "out" trigger will collapse the expanded lines back into their
# original form so that it looks like it did when you edited it last.
#
# Since the triggers only fire when the form is edited, the actual
# protections will NOT automatically update when new users or groups
# are added.  To refresh the protections, you can simply do:
#    p4 protect -o | p4 protect -i
# since re-saving the protections will redo the expansion.
#
# To temporarily disable the trigger, you can pass "none" instead of
# "out" or "in".  This might be useful if you want to confirm that
# the table generated by the "in" trigger is correct, since the "out"
# trigger will normally hide the "in" trigger's output from you.

if    ( $ARGV[0] eq "in"  ) { in ( $ARGV[1] ); }
elsif ( $ARGV[0] eq "out" ) { out( $ARGV[1] ); }
elsif ( $ARGV[0] eq "none") { exit 0; }
else { print "bad trigger usage!"; }

sub in
{
	my ( $formfile ) = @_;
	my @result;

	open FILE, $formfile or die "couldn't open file: $!";
	while ( <FILE> )
	{
	    my $line, $group, @users;
	    if ( !/\$user/ && !/\$dirs/ )
	    {
	        push @result, $_;
	        next;
	    }

	    $line = $_;
	    chomp;
	    $_ = ascii_to_hex( $_ );
	    push @result, "\tlist group _ * //---$_---\n";
	    $_ = $line;

	    if ( /\$user/ )
	    {
	        $group = "";
	        if ( /\$user\((\S+)\)/ )
	        {
	            $group = $1;
	            s/\$user\(\S+\)/\$user/g;
	        }
	        $line = $_;
	        if ( $group ) { @users = users_in_group( $group ); }
	        else { @users = users(); }
	        foreach( @users )
	        {
	            $out = $line;
	            $out =~ s/\$user/$_/g;
	            push @result, $out;
	        }
	    }
	    if ( /\$dirs\((\S+)\)/ )
	    {
	        @dirs = `$p4 dirs \"$1\"`;
	        s/\$dirs\(\S+\)/\$dirs/g;
	        $line = $_;
	        foreach( @dirs )
	        {
	            chomp;
	            $out = $line;
	            $out =~ s/\$dirs/$_/g;
	            push @result, $out;
	        }
	    }

	    push @result, "\tlist group _ * //------\n";
	}
	close FILE;

	open FILE, '>', $formfile or die "couldn't open file: $!";
	foreach( @result )
	{
	    print FILE $_;
	}
	close FILE;
}

sub out
{
	my ( $formfile ) = @_;
	my @result;
	open FILE, $formfile or die "couldn't open file: $!";
	my $skip = 0;
	while ( <FILE> )
	{
	    if ( !/\tlist group _ \* \/\/---/ )
	    {
	        if ( !$skip ) { push @result, $_; }
	        next;
	    }
	    if ( $skip )
	    {
	        $skip = 0;
	        next;
	    }
	    if ( !/\tlist group _ \* \/\/---(.+)---/ ) { next; }
	    push @result, hex_to_ascii( $1 )."\n";
	    $skip = 1;
	}
	close FILE;

	open FILE, '>', $formfile or die "couldn't open file: $!";
	foreach( @result )
	{
	    print FILE $_;
	}
	close FILE;
}

sub users
{
	my @users = ();
	my @lines = `$p4 users`;
	foreach( @lines )
	{
	    s/\s.*//;
	    chomp;
	    push @users, $_;
	}
	return @users;
}

sub users_in_group
{
	my @done, @lines, @todo, @users, $group;
	@todo = @_;
	while ( @todo )
	{
	   $group = pop @todo;
	   if ( grep( $_ eq $group, @done ) ) { next; }
	   push @done, $group;
	   @lines = `$p4 -Ztag group -o $group`;
	   foreach( @lines )
	   {
	      if ( /\.\.\. Subgroups\d+ (\S+)/ ) 
	          { push @todo, $1; }
	      if ( /\.\.\. Users\d+ (\S+)/ && !grep( $_ eq $1, @users ) )
	          { push @users, $1; }
	   }
	}
	return sort @users;
}

sub ascii_to_hex
{
	(my $str = shift) =~ s/(.|\n)/sprintf("%02lx", ord $1)/eg;
	return $str;
}
sub hex_to_ascii
{
	(my $str = shift) =~ s/([a-fA-F0-9]{2})/chr(hex $1)/eg;
	return $str;
}