| 361 |
dpurdie |
1 |
########################################################################
|
|
|
2 |
# Copyright (C) 1998-2011 Vix Technology, All rights reserved
|
|
|
3 |
#
|
|
|
4 |
# Module name : jats_cclabel.pl
|
|
|
5 |
# Module type : Makefile system
|
|
|
6 |
# Compiler(s) : Perl
|
|
|
7 |
# Environment(s): jats
|
|
|
8 |
#
|
|
|
9 |
# Description : A script to perform a number of labeling operations
|
|
|
10 |
# The script will:
|
|
|
11 |
# create a label
|
|
|
12 |
# lock a label
|
|
|
13 |
# unlock a label
|
|
|
14 |
# label all files below the current directory and
|
|
|
15 |
# all directories above the current directory
|
|
|
16 |
#
|
|
|
17 |
# Version Who Date Description
|
|
|
18 |
# 1.0.0 DDP 04-Feb-05 Created
|
|
|
19 |
#
|
|
|
20 |
#......................................................................#
|
|
|
21 |
|
|
|
22 |
require 5.008_002;
|
|
|
23 |
use strict;
|
|
|
24 |
use warnings;
|
|
|
25 |
use JatsError;
|
|
|
26 |
use JatsSystem;
|
|
|
27 |
|
|
|
28 |
use Pod::Usage; # required for help support
|
|
|
29 |
use Getopt::Long;
|
|
|
30 |
use Cwd;
|
|
|
31 |
|
|
|
32 |
my $VERSION = "1.2.2"; # Update this
|
|
|
33 |
|
|
|
34 |
#
|
|
|
35 |
# Options
|
|
|
36 |
#
|
|
|
37 |
my $opt_debug = $ENV{'GBE_DEBUG'}; # Allow global debug
|
|
|
38 |
my $opt_verbose = $ENV{'GBE_VERBOSE'}; # Allow global verbose
|
|
|
39 |
my $opt_help = 0;
|
|
|
40 |
my $opt_label;
|
|
|
41 |
my $opt_replace;
|
|
|
42 |
my $opt_create;
|
|
|
43 |
my $opt_lock;
|
|
|
44 |
my $opt_unlock;
|
|
|
45 |
my $opt_show;
|
|
|
46 |
my $opt_all;
|
|
|
47 |
my $opt_remove;
|
|
|
48 |
my $opt_delete;
|
|
|
49 |
my @opt_exclude;
|
|
|
50 |
my $opt_test;
|
|
|
51 |
my $opt_rename;
|
|
|
52 |
my $opt_auto;
|
|
|
53 |
my $opt_clone;
|
|
|
54 |
my $opt_recurse = 1;
|
|
|
55 |
my $opt_mine;
|
|
|
56 |
my $opt_info;
|
|
|
57 |
my $opt_up = 0;
|
|
|
58 |
my $opt_smartlock;
|
|
|
59 |
my $opt_checkout = 2;
|
|
|
60 |
my @opt_files;
|
|
|
61 |
my @opt_dirs;
|
|
|
62 |
my $opt_comment;
|
|
|
63 |
my $opt_vob;
|
|
|
64 |
my $opt_user;
|
|
|
65 |
my $opt_admin_vob;
|
|
|
66 |
my $opt_entire_view;
|
|
|
67 |
|
|
|
68 |
my $label;
|
|
|
69 |
my $user_cwd;
|
|
|
70 |
my @error_list;
|
|
|
71 |
my @last_results;
|
|
|
72 |
my $last_result;
|
|
|
73 |
my $opr_done;
|
|
|
74 |
my $label_exists = 0;
|
|
|
75 |
my $label_is_locked = 0;
|
|
|
76 |
my $build_count = 0;
|
|
|
77 |
my $vob_desc ='';
|
|
|
78 |
my $vob_base;
|
|
|
79 |
|
|
|
80 |
#
|
|
|
81 |
# Globals
|
|
|
82 |
#
|
|
|
83 |
my $USER = $ENV{'USER'};
|
|
|
84 |
my $UNIX = $ENV{'GBE_UNIX'};
|
|
|
85 |
my $autobuild = $ENV{'GBE_ABT'};
|
|
|
86 |
my $UNIX_VOB_PREFIX = '/vobs';
|
|
|
87 |
my $VOB_SEP = $UNIX ? '/' : '\\';
|
|
|
88 |
|
|
|
89 |
#-------------------------------------------------------------------------------
|
|
|
90 |
# Function : Mainline Entry Point
|
|
|
91 |
#
|
|
|
92 |
# Description :
|
|
|
93 |
#
|
|
|
94 |
# Inputs :
|
|
|
95 |
#
|
|
|
96 |
my $result = GetOptions (
|
|
|
97 |
"help:+" => \$opt_help,
|
|
|
98 |
"manual:3" => \$opt_help,
|
|
|
99 |
"verbose:+" => \$opt_verbose,
|
|
|
100 |
"label" => \$opt_label, # Flag
|
|
|
101 |
"replace" => \$opt_replace, # Flag
|
|
|
102 |
"create" => \$opt_create, # Flag
|
|
|
103 |
"lock" => \$opt_lock, # Flag
|
|
|
104 |
"unlock" => \$opt_unlock, # Flag
|
|
|
105 |
"smartlock" => \$opt_smartlock, # Flag
|
|
|
106 |
"show" => \$opt_show, # Flag
|
|
|
107 |
"remove" => \$opt_remove, # Flag
|
|
|
108 |
"delete" => \$opt_delete, # Flag
|
|
|
109 |
"all" => \$opt_all, # Flag
|
|
|
110 |
"test" => \$opt_test, # Flag
|
|
|
111 |
"exclude=s" => \@opt_exclude, # Multiple strings
|
|
|
112 |
"rename=s" => \$opt_rename, # String
|
|
|
113 |
"clone=s" => \$opt_clone, # String
|
|
|
114 |
"auto" => \$opt_auto, # Flag
|
|
|
115 |
"recurse!", => \$opt_recurse, # [No]Flag
|
|
|
116 |
"mine!", => \$opt_mine, # Flag
|
|
|
117 |
"info", => \$opt_info, # Flag
|
|
|
118 |
"up", => \$opt_up, # Flag
|
|
|
119 |
"checkout!", => \$opt_checkout, # [No]Flag
|
|
|
120 |
"files=s" => \@opt_files, # Multiple strings
|
|
|
121 |
"dirs=s" => \@opt_dirs, # Multiple strings
|
|
|
122 |
"comment=s" => \$opt_comment, # String
|
|
|
123 |
"vob=s" => \$opt_vob, # String
|
|
|
124 |
"user=s" => \$opt_user, # String
|
|
|
125 |
"admin" => \$opt_admin_vob, # String
|
|
|
126 |
"entireview" => \$opt_entire_view, # Flag
|
|
|
127 |
|
|
|
128 |
);
|
|
|
129 |
|
|
|
130 |
#
|
|
|
131 |
# UPDATE THE DOCUMENTATION AT THE END OF THIS FILE !!!
|
|
|
132 |
#
|
|
|
133 |
|
|
|
134 |
#
|
|
|
135 |
# Process help and manual options
|
|
|
136 |
#
|
|
|
137 |
pod2usage(-verbose => 0, -message => "Version: $VERSION") if ($opt_help == 1 || ! $result);
|
|
|
138 |
pod2usage(-verbose => 1) if ( $opt_help == 2 );
|
|
|
139 |
pod2usage(-verbose => 2) if ( $opt_help > 2 );
|
|
|
140 |
pod2usage(-verbose => 0, -message => "Version: $VERSION") if ( $#ARGV < 0 );
|
|
|
141 |
|
|
|
142 |
#
|
|
|
143 |
# Configure the error reporting process now that we have the user options
|
|
|
144 |
#
|
|
|
145 |
ErrorConfig( 'name' =>'LABEL',
|
|
|
146 |
'verbose' => $opt_verbose,
|
|
|
147 |
'on_exit' => \&display_error_list
|
|
|
148 |
);
|
|
|
149 |
|
|
|
150 |
#
|
|
|
151 |
# Validate user options
|
|
|
152 |
# Use either -spec or one command line argument
|
|
|
153 |
#
|
|
|
154 |
Error ("No labels provided") if ( $#ARGV < 0);
|
|
|
155 |
Error ("Too many labels provided") if ( $#ARGV > 0);
|
|
|
156 |
Error ("Conflicting options: -clone and -label") if ( $opt_clone && $opt_label );
|
|
|
157 |
Error ("Conflicting options: -entireview and -label" ) if ( $opt_entire_view && $opt_label );
|
|
|
158 |
Error ("Conflicting options: -entireview and -exclude" ) if ( $opt_entire_view && @opt_exclude );
|
|
|
159 |
Error ("Conflicting options: -entireview and -files" ) if ( $opt_entire_view && @opt_files );
|
|
|
160 |
Error ("Conflicting options: -entireview and -dir" ) if ( $opt_entire_view && @opt_dirs );
|
|
|
161 |
Error ("Conflicting options: -entireview and -norecurse" ) if ( $opt_entire_view && !$opt_recurse );
|
|
|
162 |
|
|
|
163 |
$label = $ARGV[0];
|
|
|
164 |
|
|
|
165 |
#
|
|
|
166 |
# Allow the exclude list to contain comma seperated names
|
|
|
167 |
#
|
|
|
168 |
@opt_exclude = split( /,/,join(',',@opt_exclude));
|
|
|
169 |
@opt_files = split( /,/,join(',',@opt_files));
|
|
|
170 |
@opt_dirs = split( /,/,join(',',@opt_dirs));
|
|
|
171 |
|
|
|
172 |
#
|
|
|
173 |
# Determine the user
|
|
|
174 |
#
|
|
|
175 |
Error ("USER name not determined" )
|
|
|
176 |
unless ( $USER );
|
|
|
177 |
$opt_user = $USER unless ( $opt_user );
|
|
|
178 |
|
|
|
179 |
#
|
|
|
180 |
# Ensure that the 'cleartool' program can be located
|
|
|
181 |
#
|
|
|
182 |
Verbose ("Locate clearcase utility in users path");
|
|
|
183 |
Error ("Cannot locate the 'cleartool' utility in the users PATH")
|
|
|
184 |
unless ( LocateProgInPath('cleartool', '--All') );
|
|
|
185 |
|
| 365 |
dpurdie |
186 |
#
|
|
|
187 |
# Convert label with embedded VCS information into a 'normal' form.
|
|
|
188 |
# Form:
|
|
|
189 |
# CC::label
|
|
|
190 |
# CC::path::label
|
|
|
191 |
# CC::::label
|
|
|
192 |
#
|
|
|
193 |
if ( $label =~ m~^(.+?)::(.*?)(::(.+))?$~ )
|
|
|
194 |
{
|
|
|
195 |
Error ("Label contains invalid Version Control Identifier($1): $_")
|
|
|
196 |
if ( $1 ne 'CC' );
|
|
|
197 |
|
|
|
198 |
my $ll = $2;
|
|
|
199 |
my $path;
|
|
|
200 |
if ( $3 )
|
|
|
201 |
{
|
|
|
202 |
$ll = $4;
|
|
|
203 |
my @pelements = split( m'/+', $2);
|
|
|
204 |
$path = $pelements[1] || '';
|
|
|
205 |
if ( $path )
|
|
|
206 |
{
|
|
|
207 |
|
|
|
208 |
Error ("Multiple conflicting Embedded Vobs",
|
|
|
209 |
"Vob: $opt_vob",
|
|
|
210 |
"VCS Spec: $label" ) if ( $opt_vob && $path ne $opt_vob );
|
|
|
211 |
$opt_vob = $path;
|
|
|
212 |
}
|
|
|
213 |
}
|
|
|
214 |
$label = $ll;
|
|
|
215 |
Verbose ("Clean URL: $opt_vob, $label");
|
|
|
216 |
}
|
|
|
217 |
|
| 361 |
dpurdie |
218 |
#-------------------------------------------------------------------------------
|
|
|
219 |
# Construct a vob descriptor, if required
|
|
|
220 |
#
|
|
|
221 |
# There is a potential problem/race condition if doing a rename
|
|
|
222 |
# within a static view of a label that is a part of the views config spec
|
|
|
223 |
#
|
|
|
224 |
# Work around: If performing a rename, then ensure that we have the VOB name
|
|
|
225 |
#
|
|
|
226 |
if ( ($opt_rename || $opt_entire_view ) && ! $opt_vob )
|
|
|
227 |
{
|
|
|
228 |
Verbose ("Determine VOB name");
|
|
|
229 |
ClearCmd ('describe', '-short', 'vob:.' );
|
|
|
230 |
Error ("Cannot determine vob from current directory") if ( @error_list || ! $last_result );
|
|
|
231 |
$vob_base = $last_result;
|
|
|
232 |
$vob_desc = '@' . $vob_base;
|
|
|
233 |
$vob_desc =~ s~/~$VOB_SEP~g;
|
|
|
234 |
Verbose ("VOB name: $vob_base");
|
|
|
235 |
}
|
|
|
236 |
elsif ( $opt_vob )
|
|
|
237 |
{
|
|
|
238 |
Error ("-vob option cannot be used with this command")
|
|
|
239 |
if ( $opt_clone || $opt_label || $opt_show || $opt_remove );
|
|
|
240 |
|
|
|
241 |
$vob_desc = $UNIX_VOB_PREFIX if ( $UNIX );
|
|
|
242 |
$vob_desc = '@/' . $vob_desc . '/' . $opt_vob;
|
|
|
243 |
$vob_desc =~ s~//~/~g;
|
|
|
244 |
$vob_desc =~ s~/~$VOB_SEP~g;
|
|
|
245 |
}
|
|
|
246 |
|
|
|
247 |
#-------------------------------------------------------------------------------
|
|
|
248 |
# Check to see if the clone source label exists
|
|
|
249 |
# Create a label
|
|
|
250 |
#
|
|
|
251 |
if ( $opt_clone )
|
|
|
252 |
{
|
|
|
253 |
Verbose ("Check clone label");
|
|
|
254 |
ClearCmd ("describe", "-short", "lbtype:$opt_clone" );
|
|
|
255 |
Error ("Clone source label does not exist") if ( @error_list );
|
|
|
256 |
}
|
|
|
257 |
|
|
|
258 |
#-------------------------------------------------------------------------------
|
|
|
259 |
# Check to see if the label exists
|
|
|
260 |
# Determine if its locked at the same time
|
|
|
261 |
#
|
|
|
262 |
Verbose ("Check label");
|
|
|
263 |
ClearCmd ("describe", "-fmt", "%[locked]p", "lbtype:$label$vob_desc" );
|
|
|
264 |
$label_exists = 1 unless( $opt_test
|
|
|
265 |
|| grep ( /Label type not found/, @error_list )
|
|
|
266 |
|| grep ( /Unable to determine VOB/, @error_list )
|
|
|
267 |
);
|
|
|
268 |
if ( $label_exists && $last_result )
|
|
|
269 |
{
|
|
|
270 |
$label_is_locked = ($last_result =~ m~unlocked~)? 0:1;
|
|
|
271 |
}
|
|
|
272 |
Verbose ("Check label: Exist:$label_exists, Locked:$label_is_locked");
|
|
|
273 |
|
|
|
274 |
|
|
|
275 |
#-------------------------------------------------------------------------------
|
|
|
276 |
# Process command
|
|
|
277 |
# Create a label
|
|
|
278 |
#
|
|
|
279 |
if ( $opt_create || ( $opt_auto && ! $label_exists ) )
|
|
|
280 |
|
|
|
281 |
{
|
|
|
282 |
Verbose ("Create label");
|
|
|
283 |
Error ("Label already exists") if ( $label_exists );
|
|
|
284 |
|
|
|
285 |
my @opts;
|
|
|
286 |
push @opts, $opt_comment ? ( '-c', '"' . $opt_comment . '"' ) : '-nc';
|
|
|
287 |
push @opts, '-global' if ( $opt_admin_vob );
|
|
|
288 |
|
|
|
289 |
ClearCmd ("mklbtype", @opts, "$label$vob_desc" ) unless $opt_test;
|
|
|
290 |
Error ("Program Terminated") if ( @error_list );
|
|
|
291 |
$opr_done = 1;
|
|
|
292 |
$label_exists = 1;
|
|
|
293 |
}
|
|
|
294 |
|
|
|
295 |
#-------------------------------------------------------------------------------
|
|
|
296 |
# Process command
|
|
|
297 |
# Unlock a label - if it was locked
|
|
|
298 |
#
|
|
|
299 |
if (( $opt_unlock || $opt_smartlock ) )
|
|
|
300 |
{
|
|
|
301 |
Verbose ("Unlock label");
|
|
|
302 |
|
|
|
303 |
if ( $label_is_locked )
|
|
|
304 |
{
|
|
|
305 |
ClearCmd ("unlock", "lbtype:$label$vob_desc" ) unless $opt_test;
|
|
|
306 |
Error ("Program Terminated") if ( @error_list );
|
|
|
307 |
$opt_lock = 1 if ( $opt_smartlock );
|
|
|
308 |
$label_is_locked = 0;
|
|
|
309 |
}
|
|
|
310 |
$opr_done = 1;
|
|
|
311 |
}
|
|
|
312 |
|
|
|
313 |
#-------------------------------------------------------------------------------
|
|
|
314 |
# Process command
|
|
|
315 |
# Rename a label
|
|
|
316 |
if ( $opt_rename )
|
|
|
317 |
{
|
|
|
318 |
Verbose ("Rename label");
|
|
|
319 |
ClearCmd ("rename", "lbtype:$label$vob_desc", "lbtype:$opt_rename$vob_desc" ) unless $opt_test;
|
|
|
320 |
Error ("Program Terminated") if ( @error_list );
|
|
|
321 |
$label = $opt_rename;
|
|
|
322 |
|
|
|
323 |
#
|
|
|
324 |
# Also rename the owner of the label
|
|
|
325 |
# This facility is used by the build process to rename WIP labels
|
|
|
326 |
# The idea is to prevent the original owner from modifying the label
|
|
|
327 |
#
|
|
|
328 |
$opt_mine = 1
|
|
|
329 |
if ( $opt_mine && ($opt_mine != 0) );
|
|
|
330 |
|
|
|
331 |
$opr_done = 1;
|
|
|
332 |
}
|
|
|
333 |
|
|
|
334 |
#-------------------------------------------------------------------------------
|
|
|
335 |
# Change label ownership
|
|
|
336 |
#
|
|
|
337 |
if ( $opt_mine )
|
|
|
338 |
{
|
|
|
339 |
Verbose ("Change label owner: $opt_user");
|
|
|
340 |
ClearCmd ("protect", "-chown", $opt_user, "lbtype:$label$vob_desc" ) unless $opt_test;
|
|
|
341 |
Error ("Program Terminated") if ( @error_list );
|
|
|
342 |
|
|
|
343 |
$opr_done = 1;
|
|
|
344 |
}
|
|
|
345 |
|
|
|
346 |
#-------------------------------------------------------------------------------
|
|
|
347 |
# Process command
|
|
|
348 |
# Label files and directories
|
|
|
349 |
|
|
|
350 |
if ( $opt_label || ( $opt_auto && ! $opt_clone && ! $opt_entire_view ))
|
|
|
351 |
{
|
|
|
352 |
my $label_error;
|
|
|
353 |
my @cmd_opt;
|
|
|
354 |
my %info;
|
|
|
355 |
push @cmd_opt, "-replace" if ( $opt_replace );
|
|
|
356 |
|
|
|
357 |
#
|
|
|
358 |
# Locate and label directories first
|
|
|
359 |
# Label dirs before we locate files as it simplifies the process
|
|
|
360 |
# of avoiding the current directory
|
|
|
361 |
#
|
|
|
362 |
determine_dirs_to_label(\%info);
|
|
|
363 |
DebugDumpData("Directory Data", \%info ) if (IsVerbose (2));
|
|
|
364 |
#
|
|
|
365 |
# Label the directories
|
|
|
366 |
#
|
|
|
367 |
if ( @{$info{'dir_list'}} )
|
|
|
368 |
{
|
|
|
369 |
print "Root : $info{'VobRoot'}\n";
|
|
|
370 |
foreach ( @{$info{'dir_list'}} )
|
|
|
371 |
{
|
|
|
372 |
my $name = $_;
|
|
|
373 |
$name =~ s~^$info{'VobRoot'}/~~;
|
|
|
374 |
print "Label: $name\n";
|
|
|
375 |
}
|
|
|
376 |
|
|
|
377 |
ClearCmd ("mklabel", @cmd_opt, $label, @{$info{'dir_list'}} ) unless $opt_test;
|
|
|
378 |
$label_error = 1
|
|
|
379 |
if ( display_error_list() );
|
|
|
380 |
}
|
|
|
381 |
|
|
|
382 |
#
|
|
|
383 |
# Locate and label files
|
|
|
384 |
#
|
|
|
385 |
determine_files_to_label( \%info );
|
|
|
386 |
DebugDumpData("File Data", \%info ) if (IsVerbose (2));
|
|
|
387 |
|
|
|
388 |
#
|
|
|
389 |
# Label required files
|
|
|
390 |
# Only do a few at a time so as to limit the command line length
|
|
|
391 |
#
|
|
|
392 |
if ( @{$info{'label_list'}} )
|
|
|
393 |
{
|
|
|
394 |
print "Label: $_\n" foreach @{$info{'label_list'}};
|
|
|
395 |
|
|
|
396 |
#
|
|
|
397 |
# Process the labels in groups
|
|
|
398 |
# The command line does have a finite length
|
|
|
399 |
#
|
|
|
400 |
my $base = 0;
|
|
|
401 |
my $num = $#{$info{'label_list'}};
|
|
|
402 |
|
|
|
403 |
while ( $base <= $num )
|
|
|
404 |
{
|
|
|
405 |
my $end = $base + 10;
|
|
|
406 |
$end = $num if ( $end > $num );
|
|
|
407 |
|
|
|
408 |
print ".";
|
|
|
409 |
ClearCmd ("mklabel", @cmd_opt, $label, @{$info{'label_list'}}[$base .. $end] ) unless ( $opt_test );
|
|
|
410 |
$label_error = 1
|
|
|
411 |
if ( display_error_list() );
|
|
|
412 |
$base = $end + 1;
|
|
|
413 |
}
|
|
|
414 |
print "\n";
|
|
|
415 |
}
|
|
|
416 |
|
|
|
417 |
#
|
|
|
418 |
# Generate warnings based on collected data
|
|
|
419 |
#
|
|
|
420 |
sub show_warning
|
|
|
421 |
{
|
|
|
422 |
my ($text, $element, $allowed) = @_;
|
|
|
423 |
$allowed = 0 unless ( $allowed );
|
|
|
424 |
my $count = scalar(@{$info{$element}});
|
|
|
425 |
print $text, ': ', $count, "\n"
|
|
|
426 |
if ( $count > $allowed );
|
|
|
427 |
}
|
|
|
428 |
|
|
|
429 |
print "Exclude: $_\n" foreach @{$info{'exclude_list'}};
|
|
|
430 |
print "Exclude(/main/0): $_\n" foreach @{$info{'element0_list'}};
|
|
|
431 |
print "Missing File: $_\n" foreach @{$info{'missing_files'}};
|
|
|
432 |
print "Checkedout File: $_\n" foreach @{$info{'checked_out_files'}};
|
|
|
433 |
print "Checkedout Dir: $_\n" foreach @{$info{'checked_out_dirs'}};
|
|
|
434 |
|
|
|
435 |
print ("Labels applied:", scalar(@{$info{'label_list'}}) + scalar(@{$info{'dir_list'}}), "\n" );
|
|
|
436 |
show_warning ("WARNING: Labels applied to checked out parent directories", 'checked_out_pdirs' );
|
|
|
437 |
show_warning ("WARNING: Labels applied to checked out files", 'checked_out_files' );
|
|
|
438 |
show_warning ("WARNING: Labels applied to checked out dirs", 'checked_out_dirs' );
|
|
|
439 |
show_warning ("WARNING: Labels NOT applied to missing files", 'missing_files' );
|
|
|
440 |
show_warning ("WARNING: Labels NOT applied to element-0 of files", 'element0_list' );
|
|
|
441 |
print ("WARNING: Path to the VOB root contains a symbolic link. Labeling incomplete") if ( $info{'is_symlink'} );
|
|
|
442 |
show_warning ("WARNING: Multiple build.pl files labeled", 'build_files', 1 );
|
|
|
443 |
|
|
|
444 |
Error ("Program Terminated") if ( $label_error );
|
|
|
445 |
$opr_done = 1;
|
|
|
446 |
}
|
|
|
447 |
|
|
|
448 |
#-------------------------------------------------------------------------------
|
|
|
449 |
# Process command
|
|
|
450 |
# Label entire view.
|
|
|
451 |
# Intended for 'buildtool' use as its not as flexible, bit it is faster
|
|
|
452 |
#
|
|
|
453 |
if ( $opt_entire_view )
|
|
|
454 |
{
|
|
|
455 |
#
|
|
|
456 |
# The -recurse option doesn't do a good job of reporting
|
|
|
457 |
# errors if the label does not exist. Ensure thatit exists
|
|
|
458 |
#
|
|
|
459 |
Error ("Label does not exist: $label")
|
|
|
460 |
unless ( $label_exists );
|
|
|
461 |
|
|
|
462 |
#
|
|
|
463 |
# Calculate the root of the vob
|
|
|
464 |
#
|
|
|
465 |
my $here = getcwd();
|
|
|
466 |
Verbose ("Current dir: $here");
|
|
|
467 |
|
|
|
468 |
$here =~ m~^(.*$vob_base)~;
|
|
|
469 |
my $base_dir = $1;
|
|
|
470 |
Verbose ("Path of base: $base_dir");
|
|
|
471 |
Error ("Calculating Vob Root: $base_dir" ) unless ( -d $base_dir );
|
|
|
472 |
Message ("Labeling ENTIRE view", $base_dir);
|
|
|
473 |
|
|
|
474 |
#
|
|
|
475 |
# Use -recurse option to label the entire view
|
|
|
476 |
#
|
|
|
477 |
my @cmd_opt = ('-recurse', '-follow');
|
|
|
478 |
push @cmd_opt, '-replace' if ( $opt_replace );
|
|
|
479 |
ClearCmd ("mklabel", @cmd_opt, $label, $base_dir ) unless ( $opt_test );
|
|
|
480 |
|
|
|
481 |
#
|
|
|
482 |
# Can't use the return value or the error list as the command will
|
|
|
483 |
# report errors for many different conditions
|
|
|
484 |
#
|
|
|
485 |
# Look at the tail of @last_results
|
|
|
486 |
# The last line is the most informative.
|
|
|
487 |
# Check that its in the right form. ie: ' nnn failed'
|
|
|
488 |
#
|
|
|
489 |
Error ("Cannot parse comamnd result for recursive label", $last_result )
|
|
|
490 |
unless ( $last_result =~ m~(\d+)\s+failed~ );
|
|
|
491 |
my $fail_count = $1;
|
|
|
492 |
if ( $fail_count )
|
|
|
493 |
{
|
|
|
494 |
#
|
|
|
495 |
# Pretty up the error list
|
|
|
496 |
#
|
|
|
497 |
#
|
|
|
498 |
@error_list = grep ( !/No such file or directory.$/, @error_list );
|
|
|
499 |
@error_list = grep ( !/^Created label/, @error_list );
|
|
|
500 |
|
|
|
501 |
Error ("Labeling entire view: $fail_count Errors" );
|
|
|
502 |
}
|
|
|
503 |
Message ("Labeling entire view", @last_results[-5 .. -1 ]);
|
|
|
504 |
|
|
|
505 |
#
|
|
|
506 |
# Since we don't have 100% confidence in this 'new' labeling
|
|
|
507 |
# process, within the auto build environment we will double
|
|
|
508 |
# check the process.
|
|
|
509 |
#
|
|
|
510 |
# Note: This test can be removed at some time in the future
|
|
|
511 |
# When we have more faith in the process
|
|
|
512 |
#
|
|
|
513 |
unless ( $opt_test )
|
|
|
514 |
{
|
|
|
515 |
my %info = ();
|
|
|
516 |
@opt_files = ();
|
|
|
517 |
@opt_dirs = $base_dir;
|
|
|
518 |
undef $opt_up;
|
|
|
519 |
$opt_recurse = 1;
|
|
|
520 |
|
|
|
521 |
Message ("Double checking labeling");
|
|
|
522 |
determine_files_to_label( \%info );
|
|
|
523 |
if ( @{$info{'label_list'}} )
|
|
|
524 |
{
|
|
|
525 |
DebugDumpData("DoubleCheck Data", \%info );
|
|
|
526 |
Error ('ClearCase label problem detected',
|
|
|
527 |
'Please report to david.purdie@vix-erg.com',
|
|
|
528 |
'Directories and Files not recursively labled as requested'
|
|
|
529 |
);
|
|
|
530 |
}
|
|
|
531 |
}
|
|
|
532 |
|
|
|
533 |
$opr_done = 1;
|
|
|
534 |
}
|
|
|
535 |
|
|
|
536 |
#-------------------------------------------------------------------------------
|
|
|
537 |
# Process command
|
|
|
538 |
# Clone
|
|
|
539 |
if ( $opt_clone )
|
|
|
540 |
{
|
|
|
541 |
Verbose ("Clone Label");
|
|
|
542 |
my @cmd_opt;
|
|
|
543 |
push @cmd_opt, "-all" if ($opt_all);
|
|
|
544 |
|
|
|
545 |
my @cmd2_opt;
|
|
|
546 |
push @cmd2_opt, "-replace" if ( $opt_replace );
|
|
|
547 |
|
|
|
548 |
my $count = 0;
|
|
|
549 |
my $checked_out_count = 0;
|
|
|
550 |
|
|
|
551 |
my $cmd = QuoteCommand ("cleartool", "find", ".", @cmd_opt, "-version", "lbtype($opt_clone)", "-print");
|
|
|
552 |
Verbose2($cmd);
|
|
|
553 |
|
|
|
554 |
open(CLONECMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
|
|
|
555 |
while (<CLONECMD>)
|
|
|
556 |
{
|
|
|
557 |
chomp;
|
|
|
558 |
print($_ . "\n");
|
|
|
559 |
$count++;
|
|
|
560 |
$checked_out_count++ if ( m/CHECKEDOUT$/ );
|
|
|
561 |
|
|
|
562 |
ClearCmd ("mklabel", @cmd2_opt, $label, $_ ) unless ( $opt_test );
|
|
|
563 |
last if ( @error_list )
|
|
|
564 |
}
|
|
|
565 |
close(CLONECMD);
|
|
|
566 |
|
|
|
567 |
Error ("Program Terminated") if ( @error_list );
|
|
|
568 |
print "Labels applied: $count\n";
|
|
|
569 |
print "WARNING: Labels applied to checked out files: $checked_out_count\n" if ( $checked_out_count );
|
|
|
570 |
$opr_done = 1;
|
|
|
571 |
}
|
|
|
572 |
|
|
|
573 |
|
|
|
574 |
#-------------------------------------------------------------------------------
|
|
|
575 |
# Process command
|
|
|
576 |
# Show labeled files and directories
|
|
|
577 |
# Remove labels
|
|
|
578 |
|
|
|
579 |
if ( $opt_show || $opt_remove )
|
|
|
580 |
{
|
|
|
581 |
Verbose ("Show Label");
|
|
|
582 |
my @cmd_opt;
|
|
|
583 |
push @cmd_opt, "-all" if ($opt_all);
|
|
|
584 |
|
|
|
585 |
my $cmd = QuoteCommand("cleartool", "find", ".", @cmd_opt, "-version", "lbtype($label)", "-print");
|
|
|
586 |
Verbose2($cmd);
|
|
|
587 |
|
|
|
588 |
open(SHOWCMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
|
|
|
589 |
while (<SHOWCMD>)
|
|
|
590 |
{
|
|
|
591 |
#
|
|
|
592 |
# Filter output from the user
|
|
|
593 |
#
|
|
|
594 |
chomp;
|
|
|
595 |
print($_ . "\n");
|
|
|
596 |
|
|
|
597 |
if ( $opt_remove )
|
|
|
598 |
{
|
|
|
599 |
ClearCmd ( "rmlabel", $label, $_ ) unless $opt_test;
|
|
|
600 |
}
|
|
|
601 |
|
|
|
602 |
}
|
|
|
603 |
close(SHOWCMD);
|
|
|
604 |
$opr_done = 1;
|
|
|
605 |
}
|
|
|
606 |
|
|
|
607 |
#-------------------------------------------------------------------------------
|
|
|
608 |
# Process command
|
|
|
609 |
# Delete a label
|
|
|
610 |
if ( $opt_delete )
|
|
|
611 |
{
|
|
|
612 |
Verbose ("Delete label");
|
|
|
613 |
ClearCmd ("rmtype", "-force", "-rmall", "lbtype:$label$vob_desc" ) unless $opt_test;
|
|
|
614 |
Error ("Program Terminated") if ( @error_list );
|
|
|
615 |
$opr_done = 1;
|
|
|
616 |
}
|
|
|
617 |
|
|
|
618 |
#-------------------------------------------------------------------------------
|
|
|
619 |
# Process command
|
|
|
620 |
# Lock a label - if not already locked
|
|
|
621 |
if ( $opt_lock )
|
|
|
622 |
{
|
|
|
623 |
Verbose ("Lock label");
|
|
|
624 |
unless ( $label_is_locked )
|
|
|
625 |
{
|
|
|
626 |
ClearCmd ("lock", "lbtype:$label$vob_desc" ) unless $opt_test;
|
|
|
627 |
Error ("Program Terminated") if ( @error_list );
|
|
|
628 |
}
|
|
|
629 |
$opr_done = 1;
|
|
|
630 |
}
|
|
|
631 |
|
|
|
632 |
#-------------------------------------------------------------------------------
|
|
|
633 |
# Process command
|
|
|
634 |
# Display Label information
|
|
|
635 |
if ( $opt_info )
|
|
|
636 |
{
|
|
|
637 |
Verbose ("Describe label");
|
|
|
638 |
my $cmd = 'cleartool ' . QuoteCommand('describe', '-long', "lbtype:$label$vob_desc" );
|
|
|
639 |
Verbose2 $cmd;
|
|
|
640 |
my $rv = system ($cmd);
|
|
|
641 |
Error ("Program Terminated") if ( $rv / 256 );
|
|
|
642 |
$opr_done = 1;
|
|
|
643 |
}
|
|
|
644 |
|
|
|
645 |
#-------------------------------------------------------------------------------
|
|
|
646 |
# End of all operations
|
|
|
647 |
# If nothing has been done, then let the user know
|
|
|
648 |
#
|
|
|
649 |
Error ("No valid operations specified. Try -h") unless ( $opr_done );
|
|
|
650 |
|
|
|
651 |
#
|
|
|
652 |
# End of program
|
|
|
653 |
# Highlight test mode if its been active
|
|
|
654 |
#
|
|
|
655 |
print ("End program", $opt_test ? " [Test Mode]":'' ,"\n");
|
|
|
656 |
exit 0;
|
|
|
657 |
|
|
|
658 |
#-------------------------------------------------------------------------------
|
|
|
659 |
# Function : determine_dirs_to_label
|
|
|
660 |
#
|
|
|
661 |
# Description : Determine diretories up to the VOB root that need to be
|
|
|
662 |
# labeled.
|
|
|
663 |
#
|
|
|
664 |
# Inputs : $data - Ref to hash to collect info
|
|
|
665 |
#
|
|
|
666 |
# Returns : Nothing
|
|
|
667 |
# Values populated into $data hash
|
|
|
668 |
#
|
|
|
669 |
sub determine_dirs_to_label
|
|
|
670 |
{
|
|
|
671 |
my ($data) = @_;
|
|
|
672 |
Verbose ("Locate directories to label");
|
|
|
673 |
|
|
|
674 |
#
|
|
|
675 |
# Init data - so that we can see what to expect
|
|
|
676 |
#
|
|
|
677 |
$data->{'dir_list'} = [];
|
|
|
678 |
$data->{'checked_out_pdirs'} = [];
|
|
|
679 |
$data->{'is_symlink'} = 0;
|
|
|
680 |
$data->{'VobRoot'} = '';
|
|
|
681 |
$data->{'DirsSeen'} = {};
|
|
|
682 |
|
|
|
683 |
#
|
|
|
684 |
# Figure out what to do
|
|
|
685 |
# Label dirs upwards if requested, or we are not doing files or dirs
|
|
|
686 |
# Label the current directory unless asked to do files/dirs or up-only
|
|
|
687 |
#
|
|
|
688 |
my $do_files = scalar @opt_files;
|
|
|
689 |
my $do_dirs = scalar @opt_dirs;
|
|
|
690 |
my $do_up = $opt_up || ( ! $do_files && ! $do_dirs );
|
|
|
691 |
|
|
|
692 |
#
|
|
|
693 |
# Build up a list of parent directories up to the root of the VOB
|
|
|
694 |
# that do not have the desired label
|
|
|
695 |
#
|
|
|
696 |
if ( $do_up )
|
|
|
697 |
{
|
|
|
698 |
Verbose ("Examine parent directories");
|
|
|
699 |
examine_directory (getcwd(), $data, 1);
|
|
|
700 |
|
|
|
701 |
#
|
|
|
702 |
# If the user has provided a list of directories or files then we should label
|
|
|
703 |
# the directory components too
|
|
|
704 |
#
|
|
|
705 |
my @dirs_from_files;
|
|
|
706 |
foreach my $file ( @opt_files )
|
|
|
707 |
{
|
|
|
708 |
my $dir = $file;
|
|
|
709 |
$dir =~ tr~\\/~/~s;
|
|
|
710 |
$dir =~ s~/[^/]+$~~ unless ( -d $dir);
|
|
|
711 |
push @dirs_from_files, $dir;
|
|
|
712 |
}
|
|
|
713 |
|
|
|
714 |
foreach my $dir ( @opt_dirs , @dirs_from_files)
|
|
|
715 |
{
|
|
|
716 |
examine_directory ($dir, $data);
|
|
|
717 |
}
|
|
|
718 |
}
|
|
|
719 |
}
|
|
|
720 |
|
|
|
721 |
#-------------------------------------------------------------------------------
|
|
|
722 |
# Function : examine_directory
|
|
|
723 |
#
|
|
|
724 |
# Description : Examine one directory entry
|
|
|
725 |
#
|
|
|
726 |
# Inputs : $path - Path to examine
|
|
|
727 |
# $data - Ref to hash to collect info
|
|
|
728 |
# $find_root - Finding root
|
|
|
729 |
#
|
|
|
730 |
# Returns :
|
|
|
731 |
#
|
|
|
732 |
sub examine_directory
|
|
|
733 |
{
|
|
|
734 |
my ($path, $data, $find_root) = @_;
|
|
|
735 |
my $is_symlink;
|
|
|
736 |
$path =~ tr~\\/~/~s;
|
|
|
737 |
|
|
|
738 |
while ( 1 )
|
|
|
739 |
{
|
|
|
740 |
return if ( defined $data->{'DirsSeen'}{$path} );
|
|
|
741 |
$data->{'DirsSeen'}{$path} = 1;
|
|
|
742 |
|
|
|
743 |
my $cmd = QuoteCommand ("cleartool", "describe", $path);
|
|
|
744 |
my $has_label;
|
|
|
745 |
my $is_versioned;
|
|
|
746 |
my $start_labels;
|
|
|
747 |
my $link;
|
|
|
748 |
my $is_checkedout;
|
|
|
749 |
|
|
|
750 |
Verbose($cmd);
|
|
|
751 |
my $cmd_handle;
|
|
|
752 |
open($cmd_handle, "$cmd 2>&1 |") || Error( "Can't run command: $!");
|
|
|
753 |
while (<$cmd_handle>)
|
|
|
754 |
{
|
|
|
755 |
#
|
|
|
756 |
# Filter output from the user
|
|
|
757 |
#
|
|
|
758 |
chomp;
|
|
|
759 |
Verbose2($_);
|
|
|
760 |
push @error_list, $_ if ( m~Error:~ );
|
|
|
761 |
$link = $1 if ( m~^symbolic link.* -> (.*)~ );
|
|
|
762 |
$is_versioned = 1 if ( m~^directory version ~ );
|
|
|
763 |
$start_labels = 1 if ( m~^\s+Labels:$~ );
|
|
|
764 |
$is_checkedout = 1 if ( m~[\\/]CHECKEDOUT"~ );
|
|
|
765 |
next unless ( $start_labels );
|
|
|
766 |
$has_label = 1 if ( m~^\s+$label$~ );
|
|
|
767 |
}
|
|
|
768 |
close($cmd_handle);
|
|
|
769 |
$data->{'VobRoot'} = $path if ( $find_root );
|
|
|
770 |
|
|
|
771 |
#
|
|
|
772 |
# Symbolic link located
|
|
|
773 |
# Resolve the link and continue
|
|
|
774 |
# The link cannot be labeled. If we can label the resolved link then
|
|
|
775 |
# all is good, otherwise we have a a problem
|
|
|
776 |
#
|
|
|
777 |
if ( $link )
|
|
|
778 |
{
|
|
|
779 |
$is_symlink = 1;
|
|
|
780 |
$path =~ s~[/][^/]*$~~;
|
|
|
781 |
$path = $path . '/' . $link;
|
|
|
782 |
$path =~ s~/[^/]+/\.\./~/~;
|
|
|
783 |
Verbose("Symbolic link: $link, Path: $path" );
|
|
|
784 |
next;
|
|
|
785 |
}
|
|
|
786 |
|
|
|
787 |
#
|
|
|
788 |
# Parent directory checked out. Options:
|
|
|
789 |
# 0: Don't Label checkedout elements
|
|
|
790 |
# 1: Do Label only checkout elements
|
|
|
791 |
# 2: Label both (default)
|
|
|
792 |
#
|
|
|
793 |
if ( $is_checkedout )
|
|
|
794 |
{
|
|
|
795 |
$has_label = 2 if ( $opt_checkout == 0 );
|
|
|
796 |
push @{$data->{'checked_out_pdirs'}}, $_;
|
|
|
797 |
}
|
|
|
798 |
else
|
|
|
799 |
{
|
|
|
800 |
$has_label = 2 if ( $opt_checkout == 1 );
|
|
|
801 |
}
|
|
|
802 |
|
|
|
803 |
last unless ( $is_versioned );
|
|
|
804 |
unshift @{$data->{'dir_list'}}, $path unless ( $has_label );
|
|
|
805 |
|
|
|
806 |
#
|
|
|
807 |
# Versioned directory seen
|
|
|
808 |
# If the previous one loop was a symlink, then we have labeled
|
|
|
809 |
# the link correctly
|
|
|
810 |
#
|
|
|
811 |
$is_symlink = 0;
|
|
|
812 |
|
|
|
813 |
#
|
|
|
814 |
# Calculate the path of the parent directory
|
|
|
815 |
# Stop when we get to the top ( ie z: is not good )
|
|
|
816 |
#
|
|
|
817 |
last unless ( $path =~ s~[/][^/]*$~~);
|
|
|
818 |
last unless ( length $path);
|
|
|
819 |
last if ( $path =~ m~:$~ );
|
|
|
820 |
}
|
|
|
821 |
|
|
|
822 |
#
|
|
|
823 |
# Accumulate bad symlinks
|
|
|
824 |
#
|
|
|
825 |
$data->{'is_symlink'}++
|
|
|
826 |
if ( $is_symlink );
|
|
|
827 |
}
|
|
|
828 |
|
|
|
829 |
|
|
|
830 |
#-------------------------------------------------------------------------------
|
|
|
831 |
# Function : determine_files_to_label
|
|
|
832 |
#
|
|
|
833 |
# Description : Determine a list of files that need to be
|
|
|
834 |
# labeled.
|
|
|
835 |
#
|
|
|
836 |
# Inputs : $data - Ref to hash to collect info
|
|
|
837 |
#
|
|
|
838 |
# Returns : Nothing
|
|
|
839 |
# Values populated into $data hash
|
|
|
840 |
#
|
|
|
841 |
sub determine_files_to_label
|
|
|
842 |
{
|
|
|
843 |
my ($data) = @_;
|
|
|
844 |
Verbose ("Locate files to label");
|
|
|
845 |
|
|
|
846 |
#
|
|
|
847 |
# Init data - so that we can see what to expect
|
|
|
848 |
#
|
|
|
849 |
$data->{'label_list'} = [];
|
|
|
850 |
$data->{'checked_out_files'} = [];
|
|
|
851 |
$data->{'checked_out_dirs'} = [];
|
|
|
852 |
$data->{'missing_files'} = [];
|
|
|
853 |
$data->{'element0_list'} = [];
|
|
|
854 |
$data->{'exclude_list'} = [];
|
|
|
855 |
$data->{'build_files'} = [];
|
|
|
856 |
|
|
|
857 |
#
|
|
|
858 |
# Figure out what to do
|
|
|
859 |
# Label dirs upwards if requested, or we are not doing files or dirs
|
|
|
860 |
# Label the current directory unless asked to do files/dirs or up-only
|
|
|
861 |
#
|
|
|
862 |
my $do_files = scalar @opt_files;
|
|
|
863 |
my $do_dirs = scalar @opt_dirs;
|
|
|
864 |
push @opt_dirs, '.' unless ($opt_up || $do_files || $do_dirs);
|
|
|
865 |
|
|
|
866 |
my @check_these;
|
|
|
867 |
|
|
|
868 |
#
|
|
|
869 |
# Examine all specified files and directories
|
|
|
870 |
# Detect nasty files
|
|
|
871 |
# Don't label elements that have already been labled
|
|
|
872 |
#
|
|
|
873 |
# Use the cleartool find command as it will allow us to determine
|
|
|
874 |
# if the element has already been labled.
|
|
|
875 |
#
|
|
|
876 |
# Note: cleartool find works on files and directories
|
|
|
877 |
#
|
|
|
878 |
my $doing_files = 0;
|
|
|
879 |
foreach my $dir (@opt_dirs ,undef, @opt_files )
|
|
|
880 |
{
|
|
|
881 |
if ( ! defined $dir )
|
|
|
882 |
{
|
|
|
883 |
$doing_files = 1;
|
|
|
884 |
next;
|
|
|
885 |
}
|
|
|
886 |
|
|
|
887 |
#
|
|
|
888 |
# If this element is from the files option and its not a file
|
|
|
889 |
# this skip it - the path will have been processed
|
|
|
890 |
#
|
|
|
891 |
next if ($doing_files && -d $dir );
|
|
|
892 |
|
|
|
893 |
#
|
|
|
894 |
# Remove possible trailing / from user specified directory as
|
|
|
895 |
# clearcase doesn't handle these too well.
|
|
|
896 |
#
|
|
|
897 |
$dir =~ tr~\\/~/~s;
|
|
|
898 |
$dir =~ s~/+$~~;
|
|
|
899 |
$dir = '/' unless ( $dir );
|
|
|
900 |
|
|
|
901 |
Verbose ("Examine subdirectory: $dir");
|
|
|
902 |
my $find_arg = $opt_recurse && !$doing_files ? '' : '-nrecurse';
|
|
|
903 |
my $cmd = QuoteCommand ("cleartool", "find", "$dir", "-cview", $find_arg, "-version", "{!lbtype($label)}", "-print");
|
|
|
904 |
Verbose2($cmd);
|
|
|
905 |
|
|
|
906 |
my $cmd_handle;
|
|
|
907 |
@error_list = ();
|
|
|
908 |
@last_results = ();
|
|
|
909 |
$last_result = undef;
|
|
|
910 |
open($cmd_handle, "$cmd 2>&1 |") || Error( "can't run command: $!");
|
|
|
911 |
while (<$cmd_handle>)
|
|
|
912 |
{
|
|
|
913 |
#
|
|
|
914 |
# Filter output from the user
|
|
|
915 |
#
|
|
|
916 |
chomp;
|
|
|
917 |
Verbose2($_);
|
|
|
918 |
if ( m~Error:~ )
|
|
|
919 |
{
|
|
|
920 |
#
|
|
|
921 |
# In AutoBuild Mode allow the error "Not a vob object"
|
|
|
922 |
# This may be cause by generated directory that has been checked in
|
|
|
923 |
# If the directory gets re-generated then the Find gets confused.
|
|
|
924 |
#
|
|
|
925 |
if ( $autobuild && m~Not a vob object:~ )
|
|
|
926 |
{
|
|
|
927 |
Warning( "AutoBuildTool supressed: $_" );
|
|
|
928 |
next;
|
|
|
929 |
}
|
|
|
930 |
push @error_list, $_;
|
|
|
931 |
next;
|
|
|
932 |
}
|
|
|
933 |
push @check_these, $_;
|
|
|
934 |
}
|
|
|
935 |
close($cmd_handle);
|
|
|
936 |
Error ("Program Terminated") if ( @error_list );
|
|
|
937 |
}
|
|
|
938 |
|
|
|
939 |
#
|
|
|
940 |
# Have a list of files to examine to see if we really want to label them
|
|
|
941 |
#
|
|
|
942 |
find:
|
|
|
943 |
foreach ( @check_these )
|
|
|
944 |
{
|
|
|
945 |
( my $file = $_ ) =~ s~@@.*~~;
|
|
|
946 |
|
|
|
947 |
#
|
|
|
948 |
# If we are not recursing - then skip directories
|
|
|
949 |
#
|
|
|
950 |
next find
|
|
|
951 |
if ( ! $opt_recurse && -d $file );
|
|
|
952 |
|
|
|
953 |
tr~\\/~/~s;
|
|
|
954 |
s~^\./~~;
|
|
|
955 |
|
|
|
956 |
#
|
|
|
957 |
# Exclude files and directories that are the /main/0 element
|
|
|
958 |
# These may be in a view due to branching rules
|
|
|
959 |
# The contents will be empty. Labeling them will create uglyness
|
|
|
960 |
# it simplifies life if we don't label them
|
|
|
961 |
#
|
|
|
962 |
if ( m~/main/0$~ )
|
|
|
963 |
{
|
|
|
964 |
push @{$data->{'element0_list'}}, $_;
|
|
|
965 |
next find;
|
|
|
966 |
}
|
|
|
967 |
|
|
|
968 |
#
|
|
|
969 |
# Has it been excluded
|
|
|
970 |
#
|
|
|
971 |
foreach my $name ( @opt_exclude )
|
|
|
972 |
{
|
|
|
973 |
if ( m~(^|/)$name[/@]~ )
|
|
|
974 |
{
|
|
|
975 |
push @{$data->{'exclude_list'}}, $_;
|
|
|
976 |
next find;
|
|
|
977 |
}
|
|
|
978 |
}
|
|
|
979 |
|
|
|
980 |
#
|
|
|
981 |
# Ensure that the file is really present
|
|
|
982 |
# In a static sandbox CC retains memory of files that have been
|
|
|
983 |
# deleted. This may be intentional it may be an error
|
|
|
984 |
#
|
|
|
985 |
if ( ! -e $file && ! $opt_all )
|
|
|
986 |
{
|
|
|
987 |
push @{$data->{'missing_files'}}, $file;
|
|
|
988 |
next find;
|
|
|
989 |
}
|
|
|
990 |
|
|
|
991 |
#
|
|
|
992 |
# Count build.pl files
|
|
|
993 |
# Not really useful for Ant Builds
|
|
|
994 |
#
|
|
|
995 |
if ( m~(^|/)build.pl@~i )
|
|
|
996 |
{
|
|
|
997 |
push @{$data->{'build_files'}}, $_
|
|
|
998 |
}
|
|
|
999 |
|
|
|
1000 |
#
|
|
|
1001 |
# Handle Checked out files
|
|
|
1002 |
#
|
|
|
1003 |
if ( m/CHECKEDOUT$/ )
|
|
|
1004 |
{
|
|
|
1005 |
next find if ( $opt_checkout == 0 );
|
|
|
1006 |
if ( -d $file )
|
|
|
1007 |
{
|
|
|
1008 |
push @{$data->{'checked_out_dirs'}}, $_;
|
|
|
1009 |
}
|
|
|
1010 |
else
|
|
|
1011 |
{
|
|
|
1012 |
push @{$data->{'checked_out_files'}}, $_;
|
|
|
1013 |
}
|
|
|
1014 |
}
|
|
|
1015 |
else
|
|
|
1016 |
{
|
|
|
1017 |
next find if ( $opt_checkout == 1 );
|
|
|
1018 |
}
|
|
|
1019 |
|
|
|
1020 |
push @{$data->{'label_list'}}, $_ ;
|
|
|
1021 |
}
|
|
|
1022 |
}
|
|
|
1023 |
|
|
|
1024 |
#-------------------------------------------------------------------------------
|
|
|
1025 |
# Function : display_error_list
|
|
|
1026 |
#
|
|
|
1027 |
# Description : Display the error list
|
|
|
1028 |
# This function is registered as an Error callback function
|
|
|
1029 |
# it will be called on error exit
|
|
|
1030 |
#
|
|
|
1031 |
# Will clear error list when called, so that it can be used
|
|
|
1032 |
# in non-exit situations.
|
|
|
1033 |
#
|
|
|
1034 |
# Inputs :
|
|
|
1035 |
#
|
|
|
1036 |
# Returns : true - Errors in list
|
|
|
1037 |
# false - No error in list
|
|
|
1038 |
#
|
|
|
1039 |
sub display_error_list
|
|
|
1040 |
{
|
|
|
1041 |
return 0 unless ( @error_list );
|
|
|
1042 |
print "$_\n" foreach ( @error_list );
|
|
|
1043 |
@error_list = ();
|
|
|
1044 |
return 1;
|
|
|
1045 |
}
|
|
|
1046 |
|
|
|
1047 |
#-------------------------------------------------------------------------------
|
|
|
1048 |
# Function : ClearCmd
|
|
|
1049 |
#
|
|
|
1050 |
# Description : Similar to the system command
|
|
|
1051 |
# Does allow standard output and standard error to be captured
|
|
|
1052 |
# to a log file
|
|
|
1053 |
#
|
|
|
1054 |
# Used since I was having problems with calling other programs
|
|
|
1055 |
# and control-C. It could hang the terminal session.
|
|
|
1056 |
#
|
|
|
1057 |
# Inputs :
|
|
|
1058 |
#
|
|
|
1059 |
# Returns :
|
|
|
1060 |
#
|
|
|
1061 |
sub ClearCmd
|
|
|
1062 |
{
|
|
|
1063 |
my $cmd = QuoteCommand (@_);
|
|
|
1064 |
Verbose2 "cleartool $cmd";
|
|
|
1065 |
|
|
|
1066 |
@error_list = ();
|
|
|
1067 |
@last_results = ();
|
|
|
1068 |
$last_result = undef;
|
|
|
1069 |
my $cmd_handle;
|
|
|
1070 |
open($cmd_handle, "cleartool $cmd 2>&1 |") || Error "can't run command: $!";
|
|
|
1071 |
while (<$cmd_handle>)
|
|
|
1072 |
{
|
|
|
1073 |
chomp;
|
|
|
1074 |
$last_result = $_;
|
|
|
1075 |
$last_result =~ tr~\\/~/~s;
|
|
|
1076 |
push @last_results, $last_result;
|
|
|
1077 |
Verbose ( "cleartool resp:" . $_);
|
|
|
1078 |
push @error_list, $_ if ( m~Error:~ );
|
|
|
1079 |
}
|
|
|
1080 |
close($cmd_handle);
|
|
|
1081 |
|
|
|
1082 |
Verbose2 "Exit Status: $?";
|
|
|
1083 |
return $? / 256;
|
|
|
1084 |
}
|
|
|
1085 |
|
|
|
1086 |
#-------------------------------------------------------------------------------
|
|
|
1087 |
# Documentation
|
|
|
1088 |
#
|
|
|
1089 |
|
|
|
1090 |
=pod
|
|
|
1091 |
|
|
|
1092 |
=for htmltoc GENERAL::ClearCase::
|
|
|
1093 |
|
|
|
1094 |
=head1 NAME
|
|
|
1095 |
|
|
|
1096 |
jats_cclabel - ClearCase label operations
|
|
|
1097 |
|
|
|
1098 |
=head1 SYNOPSIS
|
|
|
1099 |
|
|
|
1100 |
jats cclabel [options] label
|
|
|
1101 |
|
|
|
1102 |
Options:
|
|
|
1103 |
-help - brief help message
|
|
|
1104 |
-help -help - Detailed help message
|
|
|
1105 |
-man - Full documentation
|
|
|
1106 |
-auto - Auto create and label
|
|
|
1107 |
-clone=xxx - Apply new label to objects with label xxx
|
|
|
1108 |
-create - Create a label
|
|
|
1109 |
-label - Labels a directory tree
|
|
|
1110 |
-entireview - Labels entire view
|
|
|
1111 |
-lock - Lock the label
|
|
|
1112 |
-remove - Remove label from elements
|
|
|
1113 |
-delete - Delete label label from elements and vob
|
|
|
1114 |
-rename=xxx - Rename a label
|
|
|
1115 |
-show - Show elements with the label
|
|
|
1116 |
-unlock - Unlock the label
|
|
|
1117 |
-[no]mine - Set label owner to user.
|
|
|
1118 |
-info - Provide label information
|
|
|
1119 |
-smartlock - Unlock and Relock label, if it was locked
|
|
|
1120 |
|
|
|
1121 |
Modifiers
|
|
|
1122 |
-admin - Modifies label creation to create global label
|
|
|
1123 |
-all - Process all the VOB. Use with -show, -remove and -clone.
|
|
|
1124 |
-replace - Replace existing labels. Use with -label
|
|
|
1125 |
-exclude=n1,n2 - Exclude files and directories from the -label process.
|
|
|
1126 |
-files=f1,f2,... - Label only the named files.
|
|
|
1127 |
-dirs=d1,d2,... - Label only the named dirs.
|
|
|
1128 |
-[no]recurse - Exclude all subdirectories from the -label process.
|
|
|
1129 |
-[no]checkout - Don't/Do label checked out files. Default - label both
|
|
|
1130 |
-up - Only label directories upwards. Do not label files/dirs
|
|
|
1131 |
-test - Just show the labels that would be added.
|
|
|
1132 |
-comment=text - Comment to add to label when created.
|
|
|
1133 |
-user=name - Used with -mine to specify user
|
|
|
1134 |
-vob=name - Specify VOB name when manipulating label.
|
|
|
1135 |
Not allowed with -label, -clone, -remove and -show
|
|
|
1136 |
|
|
|
1137 |
=head1 OPTIONS
|
|
|
1138 |
|
|
|
1139 |
=over 8
|
|
|
1140 |
|
|
|
1141 |
=item B<-help>
|
|
|
1142 |
|
|
|
1143 |
Print a brief help message and exits.
|
|
|
1144 |
|
|
|
1145 |
=item B<-help -help>
|
|
|
1146 |
|
|
|
1147 |
Print a detailed help message with an explanation for each option.
|
|
|
1148 |
|
|
|
1149 |
=item B<-man>
|
|
|
1150 |
|
|
|
1151 |
Prints the manual page and exits.
|
|
|
1152 |
|
|
|
1153 |
=item B<-all>
|
|
|
1154 |
|
|
|
1155 |
This option modifies the operation of the -show, -remove, -clone and -label
|
|
|
1156 |
operations.
|
|
|
1157 |
|
|
|
1158 |
With this option the processing extends to the entire VOB. This is a slower, but
|
|
|
1159 |
more complete operation.
|
|
|
1160 |
|
|
|
1161 |
With this option the -label will label files that are not currently present in a
|
|
|
1162 |
static view.
|
|
|
1163 |
|
|
|
1164 |
=item B<-auto>
|
|
|
1165 |
|
|
|
1166 |
This option will create the label if the label does not exist and then label the
|
|
|
1167 |
current directory.
|
|
|
1168 |
|
|
|
1169 |
This option is a combination of a -create and a -label, except that it will
|
|
|
1170 |
not fail if the label already exists.
|
|
|
1171 |
|
|
|
1172 |
=item B<-clone=xxx>
|
|
|
1173 |
|
|
|
1174 |
This option will apply a new label to all objects that have the label xxx.
|
|
|
1175 |
The effect is that the specified label is clone of label xxx.
|
|
|
1176 |
|
|
|
1177 |
This operation may be used to initiate a new build label by first cloning an
|
|
|
1178 |
existing build before tailoring the file set.
|
|
|
1179 |
|
|
|
1180 |
=item B<-create>
|
|
|
1181 |
|
|
|
1182 |
This option will create the specified label. The operations will fail if the
|
|
|
1183 |
label is already present in the current VOB.
|
|
|
1184 |
|
|
|
1185 |
The label will be created in the current VOB with a comment if one is provided.
|
|
|
1186 |
|
|
|
1187 |
=item B<-delete>
|
|
|
1188 |
|
|
|
1189 |
This option will delete the specified label from all objects with the label
|
|
|
1190 |
and remove the label from the VOB. You need to be the owner of this label in
|
|
|
1191 |
order for the operation to occur without error.
|
|
|
1192 |
|
|
|
1193 |
=item B<-exclude name>
|
|
|
1194 |
|
|
|
1195 |
Exclude specific files and directories from the labeling process.
|
|
|
1196 |
|
|
|
1197 |
The names may be comma separated, or the option may be specified multiple times.
|
|
|
1198 |
|
|
|
1199 |
Wildcards are supported in the form of regular expressions. All .h
|
|
|
1200 |
files may be excluded with the command "-exclude=.*\.h".
|
|
|
1201 |
|
|
|
1202 |
examples:
|
|
|
1203 |
-exclude=test will exclude all directory trees called test
|
|
|
1204 |
|
|
|
1205 |
-exclude=test,play will exclude all directory trees called 'test' and 'play'
|
|
|
1206 |
|
|
|
1207 |
-exclude=test/seattle will exclude all directory trees called test/seattle
|
|
|
1208 |
|
|
|
1209 |
=item B<-files=name>
|
|
|
1210 |
|
|
|
1211 |
Label only the specified files. The names may be comma separated, or the option
|
|
|
1212 |
may be specified multiple times.
|
|
|
1213 |
|
|
|
1214 |
The use of this option overrides the default operation of the label utility
|
|
|
1215 |
and the entire file tree will not be scanned. Only the specified files will be
|
|
|
1216 |
labeled.
|
|
|
1217 |
|
|
|
1218 |
Wildcards are not supported.
|
|
|
1219 |
|
|
|
1220 |
Directories will not be recursed, but may be labeled.
|
|
|
1221 |
|
|
|
1222 |
The component paths of the named path will also be labeled, when the B<-up> is
|
|
|
1223 |
used.
|
|
|
1224 |
|
|
|
1225 |
=item B<-dirs=name>
|
|
|
1226 |
|
|
|
1227 |
Label only the specified directories. The names may be comma separated, or the
|
|
|
1228 |
option may be specified multiple times.
|
|
|
1229 |
|
|
|
1230 |
The use of this option overrides the default operation of the label utility
|
|
|
1231 |
and the entire file tree will not be scanned. Only the specified directories
|
|
|
1232 |
will be labeled.
|
|
|
1233 |
|
|
|
1234 |
Wildcards are not supported.
|
|
|
1235 |
|
|
|
1236 |
The component paths of the named path will also be labeled, when the B<-up> is
|
|
|
1237 |
used.
|
|
|
1238 |
|
|
|
1239 |
=item B<-label>
|
|
|
1240 |
|
|
|
1241 |
This option will label all the files in, and below, the current directory and
|
|
|
1242 |
all the parent directories.
|
|
|
1243 |
|
|
|
1244 |
The -replace option may be used to force labels to be moved.
|
|
|
1245 |
|
|
|
1246 |
The -norecurse option may be used to prevent recursion into all subdirectories,
|
|
|
1247 |
and the labeling of any directories.
|
|
|
1248 |
|
|
|
1249 |
=item B<-entireview>
|
|
|
1250 |
|
|
|
1251 |
This option will label all the files and directories in the current view. It may be
|
|
|
1252 |
invoked at any point within the view.
|
|
|
1253 |
|
|
|
1254 |
This option is intended to be used by the 'autobuild' process. It is not as
|
|
|
1255 |
flexible as the B<-label> option, nor can it be used in conjunction with
|
|
|
1256 |
may other options.
|
|
|
1257 |
|
|
|
1258 |
The -replace option may be used to force labels to be moved.
|
|
|
1259 |
|
|
|
1260 |
The option will determine the root of the vob and label all components in the
|
|
|
1261 |
current view, following vib-symbolic links in the process.
|
|
|
1262 |
|
|
|
1263 |
=item B<-lock>
|
|
|
1264 |
|
|
|
1265 |
This option will lock the specified label. This operation will be done after any
|
|
|
1266 |
other operations have been performed. If the label is already locked then
|
|
|
1267 |
this operation will not attempt to lock the label.
|
|
|
1268 |
|
|
|
1269 |
=item B<-remove>
|
|
|
1270 |
|
|
|
1271 |
This option will remove the specified label from all objects with the label.
|
|
|
1272 |
|
|
|
1273 |
If the -all option is present then all elements in the entire VOB will be
|
|
|
1274 |
examined, otherwise just this in and below the current directory will be
|
|
|
1275 |
examined.
|
|
|
1276 |
|
|
|
1277 |
The -all operation may take some time.
|
|
|
1278 |
|
|
|
1279 |
=item B<-rename=xxx>
|
|
|
1280 |
|
|
|
1281 |
This option will rename a label. The new name of the label is provided as the
|
|
|
1282 |
argument after the option. If any further operation are to be performed the
|
|
|
1283 |
new label name will be used.
|
|
|
1284 |
|
|
|
1285 |
By default, the owner of the label will be set to the current user. This
|
|
|
1286 |
mechanism is used in the build process. This -nomine option changes this
|
|
|
1287 |
behaviour.
|
|
|
1288 |
|
|
|
1289 |
=item B<-replace>
|
|
|
1290 |
|
|
|
1291 |
This option may be used with the -label command to force labels to be moved to
|
|
|
1292 |
the file or directory in the current view.
|
|
|
1293 |
|
|
|
1294 |
=item B<-[no]recurse>
|
|
|
1295 |
|
|
|
1296 |
This option modifies the behaviour of the B<-label> operation. The default
|
|
|
1297 |
behaviour is to label all files and directories in and below the current
|
|
|
1298 |
directory.
|
|
|
1299 |
|
|
|
1300 |
The B<-norecurse> option prevents recursion into subdirectories and the labeling
|
|
|
1301 |
of subdirectories. Only files in the current directory will be labeled. -
|
|
|
1302 |
together with parent directories as required.
|
|
|
1303 |
|
|
|
1304 |
=item B<-show>
|
|
|
1305 |
|
|
|
1306 |
This operation will show all clearcase elements with the specified label.
|
|
|
1307 |
|
|
|
1308 |
If the -all option is present then all elements in the entire VOB will be shown,
|
|
|
1309 |
otherwise just this in and below the current directory will be displayed.
|
|
|
1310 |
|
|
|
1311 |
The -all operation may take some time.
|
|
|
1312 |
|
|
|
1313 |
=item B<-test>
|
|
|
1314 |
|
|
|
1315 |
This operation will prevent the program from performing any destructive
|
|
|
1316 |
operation. It may be used to show what operation would be done.
|
|
|
1317 |
|
|
|
1318 |
=item B<-unlock>
|
|
|
1319 |
|
|
|
1320 |
This option will unlock the specified label. This operation will be done before
|
|
|
1321 |
any other operations have been performed. If the label is not locked then
|
|
|
1322 |
this operation will not attempt to unlock the label.
|
|
|
1323 |
|
|
|
1324 |
=item B<-[no]mine>
|
|
|
1325 |
|
|
|
1326 |
This option will set the owner of the label to the current user. This
|
|
|
1327 |
operation is performed automatically when a -rename operation occurs. The
|
|
|
1328 |
"no" option allows this behaviour to be modified.
|
|
|
1329 |
|
|
|
1330 |
=item B<-up>
|
|
|
1331 |
|
|
|
1332 |
This option will prevent the utility from labeling files and directories below
|
|
|
1333 |
the current directory. Only directories above the current directory will be
|
|
|
1334 |
labeled.
|
|
|
1335 |
|
|
|
1336 |
This option may be specifically used with -dirs and -files to label the named
|
|
|
1337 |
directories and files as well as the directoires up, from the current directory.
|
|
|
1338 |
|
|
|
1339 |
=item B<-info>
|
|
|
1340 |
|
|
|
1341 |
This option will provide label information. It uses the clearcase describe
|
|
|
1342 |
command.
|
|
|
1343 |
|
|
|
1344 |
=item B<-smartlock>
|
|
|
1345 |
|
|
|
1346 |
This option will unlock the label for the duration of the operations and then
|
|
|
1347 |
lock the label again - if it was locked to start with. Smart locking allows
|
|
|
1348 |
label operations while retaining the lock state of the label.
|
|
|
1349 |
|
|
|
1350 |
=item B<-[no]checkout>
|
|
|
1351 |
|
|
|
1352 |
This option affects the processing of checked out files. There are three modes of
|
|
|
1353 |
operation:
|
|
|
1354 |
|
|
|
1355 |
=over 4
|
|
|
1356 |
|
|
|
1357 |
=item 1
|
|
|
1358 |
|
|
|
1359 |
-nocheckout Checked out files are not labeled
|
|
|
1360 |
|
|
|
1361 |
=item 2
|
|
|
1362 |
|
|
|
1363 |
-checkout Only checked out files are labeled
|
|
|
1364 |
|
|
|
1365 |
=item 3
|
|
|
1366 |
|
|
|
1367 |
Neither All files are labeled.
|
|
|
1368 |
|
|
|
1369 |
=back
|
|
|
1370 |
|
|
|
1371 |
=item B<-comment=text>
|
|
|
1372 |
|
|
|
1373 |
This option allows a comment to be added to a label when it is created. The
|
|
|
1374 |
option has no effect if the label is not created.
|
|
|
1375 |
|
|
|
1376 |
=item B<-vob=name>
|
|
|
1377 |
|
|
|
1378 |
This option is used by commands that do not acutally place labels on files to
|
|
|
1379 |
manipulate when the user's current directry is not within a view. This allows lables to be created,
|
|
|
1380 |
locked and unlocked without having a view present.
|
|
|
1381 |
|
|
|
1382 |
=item B<-admin>
|
|
|
1383 |
|
|
|
1384 |
This option modifies the label creation process to create a global label. This
|
|
|
1385 |
may be used in an admin vob.
|
|
|
1386 |
|
|
|
1387 |
=back
|
|
|
1388 |
|
|
|
1389 |
=head1 DESCRIPTION
|
|
|
1390 |
|
|
|
1391 |
The L<JATS|TOOLS::jats> wrapper script will invoke this command when the 'label'
|
|
|
1392 |
command is run and the script determine the ClearCase is the default VCS.
|
|
|
1393 |
|
|
|
1394 |
This program provides a number of useful ClearCase labeling operations. These
|
|
|
1395 |
are:
|
|
|
1396 |
|
|
|
1397 |
=over 8
|
|
|
1398 |
|
|
|
1399 |
=item *
|
|
|
1400 |
|
|
|
1401 |
create - create a label
|
|
|
1402 |
|
|
|
1403 |
=item *
|
|
|
1404 |
|
|
|
1405 |
unlock - unlock the specified label
|
|
|
1406 |
|
|
|
1407 |
=item *
|
|
|
1408 |
|
|
|
1409 |
rename - rename a label
|
|
|
1410 |
|
|
|
1411 |
=item *
|
|
|
1412 |
|
|
|
1413 |
mine - change ownership of a label
|
|
|
1414 |
|
|
|
1415 |
=item *
|
|
|
1416 |
|
|
|
1417 |
label - label a directory tree
|
|
|
1418 |
|
|
|
1419 |
=item *
|
|
|
1420 |
|
|
|
1421 |
remove - remove the label from all labeled objects
|
|
|
1422 |
|
|
|
1423 |
=item *
|
|
|
1424 |
|
|
|
1425 |
show - show all objects tagged with the label
|
|
|
1426 |
|
|
|
1427 |
=item *
|
|
|
1428 |
|
|
|
1429 |
lock - lock a label
|
|
|
1430 |
|
|
|
1431 |
=item *
|
|
|
1432 |
|
|
|
1433 |
delete - delete all instances of a label and the label
|
|
|
1434 |
|
|
|
1435 |
=item *
|
|
|
1436 |
|
|
|
1437 |
info - describe the labels properties
|
|
|
1438 |
|
|
|
1439 |
=back
|
|
|
1440 |
|
|
|
1441 |
The various operations may be mixed in the one command. The order of the
|
|
|
1442 |
operations is: create, unlock, rename, mine, label, show, remove, delete, lock
|
|
|
1443 |
and info.
|
|
|
1444 |
|
|
|
1445 |
Thus it is possible to create a label, label a directory tree and then lock the
|
|
|
1446 |
label.
|
|
|
1447 |
|
| 365 |
dpurdie |
1448 |
The 'label' command line parameter may be a ClearCase VCS specification, in
|
|
|
1449 |
which case the VOB and the ClearCase label will be extracted and used.
|
|
|
1450 |
|
| 361 |
dpurdie |
1451 |
=head1 EXAMPLE
|
|
|
1452 |
|
|
|
1453 |
jats label -create -label -lock daf_br_23.0.0.syd
|
|
|
1454 |
|
| 365 |
dpurdie |
1455 |
This command will create the label 'daf_br_23.0.0.syd', then label all files and
|
|
|
1456 |
folders in and below the current directory with that label, and then lock the label.
|
|
|
1457 |
|
|
|
1458 |
jats label -info CC::/MASS_Dev/COTS/cots_netbula::netbula_2.10.1.cots
|
|
|
1459 |
|
|
|
1460 |
This command will process the 'label' as a ClearCase VCS tag and extract the
|
|
|
1461 |
vob (MASS_Dev) and the ClearCase label (netbula_2.10.1.cots). It will then
|
|
|
1462 |
provide information on that label in the MASS_Dev vob.
|
|
|
1463 |
|
| 361 |
dpurdie |
1464 |
=cut
|
|
|
1465 |
|