2 ################################################################################
4 # File: $RCSfile: rmnusers,v $
5 # Revision: $Revision: 1.3 $
6 # Description: This script will remove a user to the nusers list for a lock
7 # Author: Andrew@DeFaria.com
8 # Created: Mon Feb 13 10:35:34 PST 2006
9 # Modified: $Date: 2011/08/31 21:57:06 $
12 # (c) Copyright 2006, Andrew@DeFaria.com, all rights reserved.
14 ################################################################################
19 use lib "$FindBin::Bin/../lib";
27 my $me = $FindBin::Script;
29 # Pick up from the environment if the user specifies pvob
30 my $pvob = $ENV{pvob};
32 my @pvob_related_objects = (
40 display "Usage: $me: <object_selector> <username> [<username>]";
54 my $cmd = "cleartool lock ";
58 if (scalar @users gt 1) {
64 next if $_ eq $username;
84 Usage "Must specify an object selector" if !defined $object;
85 Usage "Must specify an username" if scalar @users eq 0;
87 my $object_type = $object;
90 $object_type =~ s/:.*//;
92 if ($object =~ m/(.*)\@(.*)/) {
97 Usage "Must specify pvob or set pvob in your environment" if !$pvob;
99 if (InArray $object_type, @pvob_related_objects) {
100 # Need to add additional "\\" because Windows will eat them up when executing a ``;
101 if ($arch eq "windows" or $arch eq "cygwin") {
102 $full_object = "$object\@\\$pvob";
104 $full_object = "$object\@$pvob";
107 $full_object = $object;
109 # Handle oddity with windows using \ for vob tags
110 if ($full_object =~ /vob:\\(.*)/) {
111 $full_object = "vob:\\\\" . $1;
116 my $cmd = "cleartool lslock $full_object 2>&1";
121 if (scalar @output eq 0) {
122 display "$object is not locked";
126 display "$object does not exist";
133 if (/\"Locked except for users: (.*)\"/) {
134 @current_users = split " ", $1;
139 if (InArray $_, @current_users) {
140 if (RemoveNuser $full_object, $_, @current_users) {
141 error "Unable to remove $_ from nusers for $object";
143 display "User $_ removed from the list of nusers for $object";
146 error "User $_ is not on the nusers list for $object";