## 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. # # 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 ( ) { my $line, $group, @users; if ( !/\$user/ ) { push @result, $_; next; } $line = $_; $group = ""; if ( /\$user\((\S+)\)/ ) { $group = $1; s/\$user\(\S+\)/\$user/g; } if ( $group ) { @users = users_in_group( $group ); } else { @users = users(); } chomp $line; $line = ascii_to_hex( $line ); push @result, "\tlist group _ * //---$line---\n"; $line = $_; foreach( @users ) { $out = $line; $out =~ s/\$user/$_/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 ( ) { 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; }