Rev 365 | Blame | Compare with Previous | Last modification | View Log | RSS feed
######################################################################### Copyright (C) 1998-2011 Vix Technology, All rights reserved## Module name : jats_cclabel.pl# Module type : Makefile system# Compiler(s) : Perl# Environment(s): jats## Description : A script to perform a number of labeling operations# The script will:# create a label# lock a label# unlock a label# label all files below the current directory and# all directories above the current directory## Version Who Date Description# 1.0.0 DDP 04-Feb-05 Created##......................................................................#require 5.008_002;use strict;use warnings;use JatsError;use JatsSystem;use Pod::Usage; # required for help supportuse Getopt::Long;use Cwd;my $VERSION = "1.2.2"; # Update this## Options#my $opt_debug = $ENV{'GBE_DEBUG'}; # Allow global debugmy $opt_verbose = $ENV{'GBE_VERBOSE'}; # Allow global verbosemy $opt_help = 0;my $opt_label;my $opt_replace;my $opt_create;my $opt_lock;my $opt_unlock;my $opt_show;my $opt_all;my $opt_remove;my $opt_delete;my @opt_exclude;my $opt_test;my $opt_rename;my $opt_auto;my $opt_clone;my $opt_recurse = 1;my $opt_mine;my $opt_info;my $opt_up = 0;my $opt_smartlock;my $opt_checkout = 2;my @opt_files;my @opt_dirs;my $opt_comment;my $opt_vob;my $opt_user;my $opt_admin_vob;my $opt_entire_view;my $label;my $user_cwd;my @error_list;my @last_results;my $last_result;my $opr_done;my $label_exists = 0;my $label_is_locked = 0;my $build_count = 0;my $vob_desc ='';my $vob_base;## Globals#my $USER = $ENV{'USER'};my $UNIX = $ENV{'GBE_UNIX'};my $autobuild = $ENV{'GBE_ABT'};my $UNIX_VOB_PREFIX = '/vobs';my $VOB_SEP = $UNIX ? '/' : '\\';#-------------------------------------------------------------------------------# Function : Mainline Entry Point## Description :## Inputs :#my $result = GetOptions ("help:+" => \$opt_help,"manual:3" => \$opt_help,"verbose:+" => \$opt_verbose,"label" => \$opt_label, # Flag"replace" => \$opt_replace, # Flag"create" => \$opt_create, # Flag"lock" => \$opt_lock, # Flag"unlock" => \$opt_unlock, # Flag"smartlock" => \$opt_smartlock, # Flag"show" => \$opt_show, # Flag"remove" => \$opt_remove, # Flag"delete" => \$opt_delete, # Flag"all" => \$opt_all, # Flag"test" => \$opt_test, # Flag"exclude=s" => \@opt_exclude, # Multiple strings"rename=s" => \$opt_rename, # String"clone=s" => \$opt_clone, # String"auto" => \$opt_auto, # Flag"recurse!", => \$opt_recurse, # [No]Flag"mine!", => \$opt_mine, # Flag"info", => \$opt_info, # Flag"up", => \$opt_up, # Flag"checkout!", => \$opt_checkout, # [No]Flag"files=s" => \@opt_files, # Multiple strings"dirs=s" => \@opt_dirs, # Multiple strings"comment=s" => \$opt_comment, # String"vob=s" => \$opt_vob, # String"user=s" => \$opt_user, # String"admin" => \$opt_admin_vob, # String"entireview" => \$opt_entire_view, # Flag);## UPDATE THE DOCUMENTATION AT THE END OF THIS FILE !!!### Process help and manual options#pod2usage(-verbose => 0, -message => "Version: $VERSION") if ($opt_help == 1 || ! $result);pod2usage(-verbose => 1) if ( $opt_help == 2 );pod2usage(-verbose => 2) if ( $opt_help > 2 );pod2usage(-verbose => 0, -message => "Version: $VERSION") if ( $#ARGV < 0 );## Configure the error reporting process now that we have the user options#ErrorConfig( 'name' =>'LABEL','verbose' => $opt_verbose,'on_exit' => \&display_error_list);## Validate user options# Use either -spec or one command line argument#Error ("No labels provided") if ( $#ARGV < 0);Error ("Too many labels provided") if ( $#ARGV > 0);Error ("Conflicting options: -clone and -label") if ( $opt_clone && $opt_label );Error ("Conflicting options: -entireview and -label" ) if ( $opt_entire_view && $opt_label );Error ("Conflicting options: -entireview and -exclude" ) if ( $opt_entire_view && @opt_exclude );Error ("Conflicting options: -entireview and -files" ) if ( $opt_entire_view && @opt_files );Error ("Conflicting options: -entireview and -dir" ) if ( $opt_entire_view && @opt_dirs );Error ("Conflicting options: -entireview and -norecurse" ) if ( $opt_entire_view && !$opt_recurse );$label = $ARGV[0];## Allow the exclude list to contain comma seperated names#@opt_exclude = split( /,/,join(',',@opt_exclude));@opt_files = split( /,/,join(',',@opt_files));@opt_dirs = split( /,/,join(',',@opt_dirs));## Determine the user#Error ("USER name not determined" )unless ( $USER );$opt_user = $USER unless ( $opt_user );## Ensure that the 'cleartool' program can be located#Verbose ("Locate clearcase utility in users path");Error ("Cannot locate the 'cleartool' utility in the users PATH")unless ( LocateProgInPath('cleartool', '--All') );## Convert label with embedded VCS information into a 'normal' form.# Form:# CC::label# CC::path::label# CC::::label#if ( $label =~ m~^(.+?)::(.*?)(::(.+))?$~ ){Error ("Label contains invalid Version Control Identifier($1): $_")if ( $1 ne 'CC' );my $ll = $2;my $path;if ( $3 ){$ll = $4;my @pelements = split( m'/+', $2);$path = $pelements[1] || '';if ( $path ){Error ("Multiple conflicting Embedded Vobs","Vob: $opt_vob","VCS Spec: $label" ) if ( $opt_vob && $path ne $opt_vob );$opt_vob = $path;}}$label = $ll;Verbose ("Clean URL: $opt_vob, $label");}#-------------------------------------------------------------------------------# Construct a vob descriptor, if required## There is a potential problem/race condition if doing a rename# within a static view of a label that is a part of the views config spec## Work around: If performing a rename, then ensure that we have the VOB name#if ( ($opt_rename || $opt_entire_view ) && ! $opt_vob ){Verbose ("Determine VOB name");ClearCmd ('describe', '-short', 'vob:.' );Error ("Cannot determine vob from current directory") if ( @error_list || ! $last_result );$vob_base = $last_result;$vob_desc = '@' . $vob_base;$vob_desc =~ s~/~$VOB_SEP~g;Verbose ("VOB name: $vob_base");}elsif ( $opt_vob ){Error ("-vob option cannot be used with this command")if ( $opt_clone || $opt_label || $opt_show || $opt_remove );$vob_desc = $UNIX_VOB_PREFIX if ( $UNIX );$vob_desc = '@/' . $vob_desc . '/' . $opt_vob;$vob_desc =~ s~//~/~g;$vob_desc =~ s~/~$VOB_SEP~g;}#-------------------------------------------------------------------------------# Check to see if the clone source label exists# Create a label#if ( $opt_clone ){Verbose ("Check clone label");ClearCmd ("describe", "-short", "lbtype:$opt_clone" );Error ("Clone source label does not exist") if ( @error_list );}#-------------------------------------------------------------------------------# Check to see if the label exists# Determine if its locked at the same time#Verbose ("Check label");ClearCmd ("describe", "-fmt", "%[locked]p", "lbtype:$label$vob_desc" );$label_exists = 1 unless( $opt_test|| grep ( /Label type not found/, @error_list )|| grep ( /Unable to determine VOB/, @error_list ));if ( $label_exists && $last_result ){$label_is_locked = ($last_result =~ m~unlocked~)? 0:1;}Verbose ("Check label: Exist:$label_exists, Locked:$label_is_locked");#-------------------------------------------------------------------------------# Process command# Create a label#if ( $opt_create || ( $opt_auto && ! $label_exists ) ){Verbose ("Create label");Error ("Label already exists") if ( $label_exists );my @opts;push @opts, $opt_comment ? ( '-c', '"' . $opt_comment . '"' ) : '-nc';push @opts, '-global' if ( $opt_admin_vob );ClearCmd ("mklbtype", @opts, "$label$vob_desc" ) unless $opt_test;Error ("Program Terminated") if ( @error_list );$opr_done = 1;$label_exists = 1;}#-------------------------------------------------------------------------------# Process command# Unlock a label - if it was locked#if (( $opt_unlock || $opt_smartlock ) ){Verbose ("Unlock label");if ( $label_is_locked ){ClearCmd ("unlock", "lbtype:$label$vob_desc" ) unless $opt_test;Error ("Program Terminated") if ( @error_list );$opt_lock = 1 if ( $opt_smartlock );$label_is_locked = 0;}$opr_done = 1;}#-------------------------------------------------------------------------------# Process command# Rename a labelif ( $opt_rename ){Verbose ("Rename label");ClearCmd ("rename", "lbtype:$label$vob_desc", "lbtype:$opt_rename$vob_desc" ) unless $opt_test;Error ("Program Terminated") if ( @error_list );$label = $opt_rename;## Also rename the owner of the label# This facility is used by the build process to rename WIP labels# The idea is to prevent the original owner from modifying the label#$opt_mine = 1if ( $opt_mine && ($opt_mine != 0) );$opr_done = 1;}#-------------------------------------------------------------------------------# Change label ownership#if ( $opt_mine ){Verbose ("Change label owner: $opt_user");ClearCmd ("protect", "-chown", $opt_user, "lbtype:$label$vob_desc" ) unless $opt_test;Error ("Program Terminated") if ( @error_list );$opr_done = 1;}#-------------------------------------------------------------------------------# Process command# Label files and directoriesif ( $opt_label || ( $opt_auto && ! $opt_clone && ! $opt_entire_view )){my $label_error;my @cmd_opt;my %info;push @cmd_opt, "-replace" if ( $opt_replace );## Locate and label directories first# Label dirs before we locate files as it simplifies the process# of avoiding the current directory#determine_dirs_to_label(\%info);DebugDumpData("Directory Data", \%info ) if (IsVerbose (2));## Label the directories#if ( @{$info{'dir_list'}} ){print "Root : $info{'VobRoot'}\n";foreach ( @{$info{'dir_list'}} ){my $name = $_;$name =~ s~^$info{'VobRoot'}/~~;print "Label: $name\n";}ClearCmd ("mklabel", @cmd_opt, $label, @{$info{'dir_list'}} ) unless $opt_test;$label_error = 1if ( display_error_list() );}## Locate and label files#determine_files_to_label( \%info );DebugDumpData("File Data", \%info ) if (IsVerbose (2));## Label required files# Only do a few at a time so as to limit the command line length#if ( @{$info{'label_list'}} ){print "Label: $_\n" foreach @{$info{'label_list'}};## Process the labels in groups# The command line does have a finite length#my $base = 0;my $num = $#{$info{'label_list'}};while ( $base <= $num ){my $end = $base + 10;$end = $num if ( $end > $num );print ".";ClearCmd ("mklabel", @cmd_opt, $label, @{$info{'label_list'}}[$base .. $end] ) unless ( $opt_test );$label_error = 1if ( display_error_list() );$base = $end + 1;}print "\n";}## Generate warnings based on collected data#sub show_warning{my ($text, $element, $allowed) = @_;$allowed = 0 unless ( $allowed );my $count = scalar(@{$info{$element}});print $text, ': ', $count, "\n"if ( $count > $allowed );}print "Exclude: $_\n" foreach @{$info{'exclude_list'}};print "Exclude(/main/0): $_\n" foreach @{$info{'element0_list'}};print "Missing File: $_\n" foreach @{$info{'missing_files'}};print "Checkedout File: $_\n" foreach @{$info{'checked_out_files'}};print "Checkedout Dir: $_\n" foreach @{$info{'checked_out_dirs'}};print ("Labels applied:", scalar(@{$info{'label_list'}}) + scalar(@{$info{'dir_list'}}), "\n" );show_warning ("WARNING: Labels applied to checked out parent directories", 'checked_out_pdirs' );show_warning ("WARNING: Labels applied to checked out files", 'checked_out_files' );show_warning ("WARNING: Labels applied to checked out dirs", 'checked_out_dirs' );show_warning ("WARNING: Labels NOT applied to missing files", 'missing_files' );show_warning ("WARNING: Labels NOT applied to element-0 of files", 'element0_list' );print ("WARNING: Path to the VOB root contains a symbolic link. Labeling incomplete") if ( $info{'is_symlink'} );show_warning ("WARNING: Multiple build.pl files labeled", 'build_files', 1 );Error ("Program Terminated") if ( $label_error );$opr_done = 1;}#-------------------------------------------------------------------------------# Process command# Label entire view.# Intended for 'buildtool' use as its not as flexible, bit it is faster#if ( $opt_entire_view ){## The -recurse option doesn't do a good job of reporting# errors if the label does not exist. Ensure thatit exists#Error ("Label does not exist: $label")unless ( $label_exists );## Calculate the root of the vob#my $here = getcwd();Verbose ("Current dir: $here");$here =~ m~^(.*$vob_base)~;my $base_dir = $1;Verbose ("Path of base: $base_dir");Error ("Calculating Vob Root: $base_dir" ) unless ( -d $base_dir );Message ("Labeling ENTIRE view", $base_dir);## Use -recurse option to label the entire view#my @cmd_opt = ('-recurse', '-follow');push @cmd_opt, '-replace' if ( $opt_replace );ClearCmd ("mklabel", @cmd_opt, $label, $base_dir ) unless ( $opt_test );## Can't use the return value or the error list as the command will# report errors for many different conditions## Look at the tail of @last_results# The last line is the most informative.# Check that its in the right form. ie: ' nnn failed'#Error ("Cannot parse comamnd result for recursive label", $last_result )unless ( $last_result =~ m~(\d+)\s+failed~ );my $fail_count = $1;if ( $fail_count ){## Pretty up the error list##@error_list = grep ( !/No such file or directory.$/, @error_list );@error_list = grep ( !/^Created label/, @error_list );Error ("Labeling entire view: $fail_count Errors" );}Message ("Labeling entire view", @last_results[-5 .. -1 ]);## Since we don't have 100% confidence in this 'new' labeling# process, within the auto build environment we will double# check the process.## Note: This test can be removed at some time in the future# When we have more faith in the process#unless ( $opt_test ){my %info = ();@opt_files = ();@opt_dirs = $base_dir;undef $opt_up;$opt_recurse = 1;Message ("Double checking labeling");determine_files_to_label( \%info );if ( @{$info{'label_list'}} ){DebugDumpData("DoubleCheck Data", \%info );Error ('ClearCase label problem detected','Please report to david.purdie@vix-erg.com','Directories and Files not recursively labled as requested');}}$opr_done = 1;}#-------------------------------------------------------------------------------# Process command# Cloneif ( $opt_clone ){Verbose ("Clone Label");my @cmd_opt;push @cmd_opt, "-all" if ($opt_all);my @cmd2_opt;push @cmd2_opt, "-replace" if ( $opt_replace );my $count = 0;my $checked_out_count = 0;my $cmd = QuoteCommand ("cleartool", "find", ".", @cmd_opt, "-version", "lbtype($opt_clone)", "-print");Verbose2($cmd);open(CLONECMD, "$cmd 2>&1 |") || Error( "can't run command: $!");while (<CLONECMD>){chomp;print($_ . "\n");$count++;$checked_out_count++ if ( m/CHECKEDOUT$/ );ClearCmd ("mklabel", @cmd2_opt, $label, $_ ) unless ( $opt_test );last if ( @error_list )}close(CLONECMD);Error ("Program Terminated") if ( @error_list );print "Labels applied: $count\n";print "WARNING: Labels applied to checked out files: $checked_out_count\n" if ( $checked_out_count );$opr_done = 1;}#-------------------------------------------------------------------------------# Process command# Show labeled files and directories# Remove labelsif ( $opt_show || $opt_remove ){Verbose ("Show Label");my @cmd_opt;push @cmd_opt, "-all" if ($opt_all);my $cmd = QuoteCommand("cleartool", "find", ".", @cmd_opt, "-version", "lbtype($label)", "-print");Verbose2($cmd);open(SHOWCMD, "$cmd 2>&1 |") || Error( "can't run command: $!");while (<SHOWCMD>){## Filter output from the user#chomp;print($_ . "\n");if ( $opt_remove ){ClearCmd ( "rmlabel", $label, $_ ) unless $opt_test;}}close(SHOWCMD);$opr_done = 1;}#-------------------------------------------------------------------------------# Process command# Delete a labelif ( $opt_delete ){Verbose ("Delete label");ClearCmd ("rmtype", "-force", "-rmall", "lbtype:$label$vob_desc" ) unless $opt_test;Error ("Program Terminated") if ( @error_list );$opr_done = 1;}#-------------------------------------------------------------------------------# Process command# Lock a label - if not already lockedif ( $opt_lock ){Verbose ("Lock label");unless ( $label_is_locked ){ClearCmd ("lock", "lbtype:$label$vob_desc" ) unless $opt_test;Error ("Program Terminated") if ( @error_list );}$opr_done = 1;}#-------------------------------------------------------------------------------# Process command# Display Label informationif ( $opt_info ){Verbose ("Describe label");my $cmd = 'cleartool ' . QuoteCommand('describe', '-long', "lbtype:$label$vob_desc" );Verbose2 $cmd;my $rv = system ($cmd);Error ("Program Terminated") if ( $rv / 256 );$opr_done = 1;}#-------------------------------------------------------------------------------# End of all operations# If nothing has been done, then let the user know#Error ("No valid operations specified. Try -h") unless ( $opr_done );## End of program# Highlight test mode if its been active#print ("End program", $opt_test ? " [Test Mode]":'' ,"\n");exit 0;#-------------------------------------------------------------------------------# Function : determine_dirs_to_label## Description : Determine diretories up to the VOB root that need to be# labeled.## Inputs : $data - Ref to hash to collect info## Returns : Nothing# Values populated into $data hash#sub determine_dirs_to_label{my ($data) = @_;Verbose ("Locate directories to label");## Init data - so that we can see what to expect#$data->{'dir_list'} = [];$data->{'checked_out_pdirs'} = [];$data->{'is_symlink'} = 0;$data->{'VobRoot'} = '';$data->{'DirsSeen'} = {};## Figure out what to do# Label dirs upwards if requested, or we are not doing files or dirs# Label the current directory unless asked to do files/dirs or up-only#my $do_files = scalar @opt_files;my $do_dirs = scalar @opt_dirs;my $do_up = $opt_up || ( ! $do_files && ! $do_dirs );## Build up a list of parent directories up to the root of the VOB# that do not have the desired label#if ( $do_up ){Verbose ("Examine parent directories");examine_directory (getcwd(), $data, 1);## If the user has provided a list of directories or files then we should label# the directory components too#my @dirs_from_files;foreach my $file ( @opt_files ){my $dir = $file;$dir =~ tr~\\/~/~s;$dir =~ s~/[^/]+$~~ unless ( -d $dir);push @dirs_from_files, $dir;}foreach my $dir ( @opt_dirs , @dirs_from_files){examine_directory ($dir, $data);}}}#-------------------------------------------------------------------------------# Function : examine_directory## Description : Examine one directory entry## Inputs : $path - Path to examine# $data - Ref to hash to collect info# $find_root - Finding root## Returns :#sub examine_directory{my ($path, $data, $find_root) = @_;my $is_symlink;$path =~ tr~\\/~/~s;while ( 1 ){return if ( defined $data->{'DirsSeen'}{$path} );$data->{'DirsSeen'}{$path} = 1;my $cmd = QuoteCommand ("cleartool", "describe", $path);my $has_label;my $is_versioned;my $start_labels;my $link;my $is_checkedout;Verbose($cmd);my $cmd_handle;open($cmd_handle, "$cmd 2>&1 |") || Error( "Can't run command: $!");while (<$cmd_handle>){## Filter output from the user#chomp;Verbose2($_);push @error_list, $_ if ( m~Error:~ );$link = $1 if ( m~^symbolic link.* -> (.*)~ );$is_versioned = 1 if ( m~^directory version ~ );$start_labels = 1 if ( m~^\s+Labels:$~ );$is_checkedout = 1 if ( m~[\\/]CHECKEDOUT"~ );next unless ( $start_labels );$has_label = 1 if ( m~^\s+$label$~ );}close($cmd_handle);$data->{'VobRoot'} = $path if ( $find_root );## Symbolic link located# Resolve the link and continue# The link cannot be labeled. If we can label the resolved link then# all is good, otherwise we have a a problem#if ( $link ){$is_symlink = 1;$path =~ s~[/][^/]*$~~;$path = $path . '/' . $link;$path =~ s~/[^/]+/\.\./~/~;Verbose("Symbolic link: $link, Path: $path" );next;}## Parent directory checked out. Options:# 0: Don't Label checkedout elements# 1: Do Label only checkout elements# 2: Label both (default)#if ( $is_checkedout ){$has_label = 2 if ( $opt_checkout == 0 );push @{$data->{'checked_out_pdirs'}}, $_;}else{$has_label = 2 if ( $opt_checkout == 1 );}last unless ( $is_versioned );unshift @{$data->{'dir_list'}}, $path unless ( $has_label );## Versioned directory seen# If the previous one loop was a symlink, then we have labeled# the link correctly#$is_symlink = 0;## Calculate the path of the parent directory# Stop when we get to the top ( ie z: is not good )#last unless ( $path =~ s~[/][^/]*$~~);last unless ( length $path);last if ( $path =~ m~:$~ );}## Accumulate bad symlinks#$data->{'is_symlink'}++if ( $is_symlink );}#-------------------------------------------------------------------------------# Function : determine_files_to_label## Description : Determine a list of files that need to be# labeled.## Inputs : $data - Ref to hash to collect info## Returns : Nothing# Values populated into $data hash#sub determine_files_to_label{my ($data) = @_;Verbose ("Locate files to label");## Init data - so that we can see what to expect#$data->{'label_list'} = [];$data->{'checked_out_files'} = [];$data->{'checked_out_dirs'} = [];$data->{'missing_files'} = [];$data->{'element0_list'} = [];$data->{'exclude_list'} = [];$data->{'build_files'} = [];## Figure out what to do# Label dirs upwards if requested, or we are not doing files or dirs# Label the current directory unless asked to do files/dirs or up-only#my $do_files = scalar @opt_files;my $do_dirs = scalar @opt_dirs;push @opt_dirs, '.' unless ($opt_up || $do_files || $do_dirs);my @check_these;## Examine all specified files and directories# Detect nasty files# Don't label elements that have already been labled## Use the cleartool find command as it will allow us to determine# if the element has already been labled.## Note: cleartool find works on files and directories#my $doing_files = 0;foreach my $dir (@opt_dirs ,undef, @opt_files ){if ( ! defined $dir ){$doing_files = 1;next;}## If this element is from the files option and its not a file# this skip it - the path will have been processed#next if ($doing_files && -d $dir );## Remove possible trailing / from user specified directory as# clearcase doesn't handle these too well.#$dir =~ tr~\\/~/~s;$dir =~ s~/+$~~;$dir = '/' unless ( $dir );Verbose ("Examine subdirectory: $dir");my $find_arg = $opt_recurse && !$doing_files ? '' : '-nrecurse';my $cmd = QuoteCommand ("cleartool", "find", "$dir", "-cview", $find_arg, "-version", "{!lbtype($label)}", "-print");Verbose2($cmd);my $cmd_handle;@error_list = ();@last_results = ();$last_result = undef;open($cmd_handle, "$cmd 2>&1 |") || Error( "can't run command: $!");while (<$cmd_handle>){## Filter output from the user#chomp;Verbose2($_);if ( m~Error:~ ){## In AutoBuild Mode allow the error "Not a vob object"# This may be cause by generated directory that has been checked in# If the directory gets re-generated then the Find gets confused.#if ( $autobuild && m~Not a vob object:~ ){Warning( "AutoBuildTool supressed: $_" );next;}push @error_list, $_;next;}push @check_these, $_;}close($cmd_handle);Error ("Program Terminated") if ( @error_list );}## Have a list of files to examine to see if we really want to label them#find:foreach ( @check_these ){( my $file = $_ ) =~ s~@@.*~~;## If we are not recursing - then skip directories#next findif ( ! $opt_recurse && -d $file );tr~\\/~/~s;s~^\./~~;## Exclude files and directories that are the /main/0 element# These may be in a view due to branching rules# The contents will be empty. Labeling them will create uglyness# it simplifies life if we don't label them#if ( m~/main/0$~ ){push @{$data->{'element0_list'}}, $_;next find;}## Has it been excluded#foreach my $name ( @opt_exclude ){if ( m~(^|/)$name[/@]~ ){push @{$data->{'exclude_list'}}, $_;next find;}}## Ensure that the file is really present# In a static sandbox CC retains memory of files that have been# deleted. This may be intentional it may be an error#if ( ! -e $file && ! $opt_all ){push @{$data->{'missing_files'}}, $file;next find;}## Count build.pl files# Not really useful for Ant Builds#if ( m~(^|/)build.pl@~i ){push @{$data->{'build_files'}}, $_}## Handle Checked out files#if ( m/CHECKEDOUT$/ ){next find if ( $opt_checkout == 0 );if ( -d $file ){push @{$data->{'checked_out_dirs'}}, $_;}else{push @{$data->{'checked_out_files'}}, $_;}}else{next find if ( $opt_checkout == 1 );}push @{$data->{'label_list'}}, $_ ;}}#-------------------------------------------------------------------------------# Function : display_error_list## Description : Display the error list# This function is registered as an Error callback function# it will be called on error exit## Will clear error list when called, so that it can be used# in non-exit situations.## Inputs :## Returns : true - Errors in list# false - No error in list#sub display_error_list{return 0 unless ( @error_list );print "$_\n" foreach ( @error_list );@error_list = ();return 1;}#-------------------------------------------------------------------------------# Function : ClearCmd## Description : Similar to the system command# Does allow standard output and standard error to be captured# to a log file## Used since I was having problems with calling other programs# and control-C. It could hang the terminal session.## Inputs :## Returns :#sub ClearCmd{my $cmd = QuoteCommand (@_);Verbose2 "cleartool $cmd";@error_list = ();@last_results = ();$last_result = undef;my $cmd_handle;open($cmd_handle, "cleartool $cmd 2>&1 |") || Error "can't run command: $!";while (<$cmd_handle>){chomp;$last_result = $_;$last_result =~ tr~\\/~/~s;push @last_results, $last_result;Verbose ( "cleartool resp:" . $_);push @error_list, $_ if ( m~Error:~ );}close($cmd_handle);Verbose2 "Exit Status: $?";return $? / 256;}#-------------------------------------------------------------------------------# Documentation#=pod=for htmltoc GENERAL::ClearCase::=head1 NAMEjats_cclabel - ClearCase label operations=head1 SYNOPSISjats cclabel [options] labelOptions:-help - brief help message-help -help - Detailed help message-man - Full documentation-auto - Auto create and label-clone=xxx - Apply new label to objects with label xxx-create - Create a label-label - Labels a directory tree-entireview - Labels entire view-lock - Lock the label-remove - Remove label from elements-delete - Delete label label from elements and vob-rename=xxx - Rename a label-show - Show elements with the label-unlock - Unlock the label-[no]mine - Set label owner to user.-info - Provide label information-smartlock - Unlock and Relock label, if it was lockedModifiers-admin - Modifies label creation to create global label-all - Process all the VOB. Use with -show, -remove and -clone.-replace - Replace existing labels. Use with -label-exclude=n1,n2 - Exclude files and directories from the -label process.-files=f1,f2,... - Label only the named files.-dirs=d1,d2,... - Label only the named dirs.-[no]recurse - Exclude all subdirectories from the -label process.-[no]checkout - Don't/Do label checked out files. Default - label both-up - Only label directories upwards. Do not label files/dirs-test - Just show the labels that would be added.-comment=text - Comment to add to label when created.-user=name - Used with -mine to specify user-vob=name - Specify VOB name when manipulating label.Not allowed with -label, -clone, -remove and -show=head1 OPTIONS=over 8=item B<-help>Print a brief help message and exits.=item B<-help -help>Print a detailed help message with an explanation for each option.=item B<-man>Prints the manual page and exits.=item B<-all>This option modifies the operation of the -show, -remove, -clone and -labeloperations.With this option the processing extends to the entire VOB. This is a slower, butmore complete operation.With this option the -label will label files that are not currently present in astatic view.=item B<-auto>This option will create the label if the label does not exist and then label thecurrent directory.This option is a combination of a -create and a -label, except that it willnot fail if the label already exists.=item B<-clone=xxx>This option will apply a new label to all objects that have the label xxx.The effect is that the specified label is clone of label xxx.This operation may be used to initiate a new build label by first cloning anexisting build before tailoring the file set.=item B<-create>This option will create the specified label. The operations will fail if thelabel is already present in the current VOB.The label will be created in the current VOB with a comment if one is provided.=item B<-delete>This option will delete the specified label from all objects with the labeland remove the label from the VOB. You need to be the owner of this label inorder for the operation to occur without error.=item B<-exclude name>Exclude specific files and directories from the labeling process.The names may be comma separated, or the option may be specified multiple times.Wildcards are supported in the form of regular expressions. All .hfiles may be excluded with the command "-exclude=.*\.h".examples:-exclude=test will exclude all directory trees called test-exclude=test,play will exclude all directory trees called 'test' and 'play'-exclude=test/seattle will exclude all directory trees called test/seattle=item B<-files=name>Label only the specified files. The names may be comma separated, or the optionmay be specified multiple times.The use of this option overrides the default operation of the label utilityand the entire file tree will not be scanned. Only the specified files will belabeled.Wildcards are not supported.Directories will not be recursed, but may be labeled.The component paths of the named path will also be labeled, when the B<-up> isused.=item B<-dirs=name>Label only the specified directories. The names may be comma separated, or theoption may be specified multiple times.The use of this option overrides the default operation of the label utilityand the entire file tree will not be scanned. Only the specified directorieswill be labeled.Wildcards are not supported.The component paths of the named path will also be labeled, when the B<-up> isused.=item B<-label>This option will label all the files in, and below, the current directory andall the parent directories.The -replace option may be used to force labels to be moved.The -norecurse option may be used to prevent recursion into all subdirectories,and the labeling of any directories.=item B<-entireview>This option will label all the files and directories in the current view. It may beinvoked at any point within the view.This option is intended to be used by the 'autobuild' process. It is not asflexible as the B<-label> option, nor can it be used in conjunction withmay other options.The -replace option may be used to force labels to be moved.The option will determine the root of the vob and label all components in thecurrent view, following vib-symbolic links in the process.=item B<-lock>This option will lock the specified label. This operation will be done after anyother operations have been performed. If the label is already locked thenthis operation will not attempt to lock the label.=item B<-remove>This option will remove the specified label from all objects with the label.If the -all option is present then all elements in the entire VOB will beexamined, otherwise just this in and below the current directory will beexamined.The -all operation may take some time.=item B<-rename=xxx>This option will rename a label. The new name of the label is provided as theargument after the option. If any further operation are to be performed thenew label name will be used.By default, the owner of the label will be set to the current user. Thismechanism is used in the build process. This -nomine option changes thisbehaviour.=item B<-replace>This option may be used with the -label command to force labels to be moved tothe file or directory in the current view.=item B<-[no]recurse>This option modifies the behaviour of the B<-label> operation. The defaultbehaviour is to label all files and directories in and below the currentdirectory.The B<-norecurse> option prevents recursion into subdirectories and the labelingof subdirectories. Only files in the current directory will be labeled. -together with parent directories as required.=item B<-show>This operation will show all clearcase elements with the specified label.If the -all option is present then all elements in the entire VOB will be shown,otherwise just this in and below the current directory will be displayed.The -all operation may take some time.=item B<-test>This operation will prevent the program from performing any destructiveoperation. It may be used to show what operation would be done.=item B<-unlock>This option will unlock the specified label. This operation will be done beforeany other operations have been performed. If the label is not locked thenthis operation will not attempt to unlock the label.=item B<-[no]mine>This option will set the owner of the label to the current user. Thisoperation is performed automatically when a -rename operation occurs. The"no" option allows this behaviour to be modified.=item B<-up>This option will prevent the utility from labeling files and directories belowthe current directory. Only directories above the current directory will belabeled.This option may be specifically used with -dirs and -files to label the nameddirectories and files as well as the directoires up, from the current directory.=item B<-info>This option will provide label information. It uses the clearcase describecommand.=item B<-smartlock>This option will unlock the label for the duration of the operations and thenlock the label again - if it was locked to start with. Smart locking allowslabel operations while retaining the lock state of the label.=item B<-[no]checkout>This option affects the processing of checked out files. There are three modes ofoperation:=over 4=item 1-nocheckout Checked out files are not labeled=item 2-checkout Only checked out files are labeled=item 3Neither All files are labeled.=back=item B<-comment=text>This option allows a comment to be added to a label when it is created. Theoption has no effect if the label is not created.=item B<-vob=name>This option is used by commands that do not acutally place labels on files tomanipulate when the user's current directry is not within a view. This allows lables to be created,locked and unlocked without having a view present.=item B<-admin>This option modifies the label creation process to create a global label. Thismay be used in an admin vob.=back=head1 DESCRIPTIONThe L<JATS|TOOLS::jats> wrapper script will invoke this command when the 'label'command is run and the script determine the ClearCase is the default VCS.This program provides a number of useful ClearCase labeling operations. Theseare:=over 8=item *create - create a label=item *unlock - unlock the specified label=item *rename - rename a label=item *mine - change ownership of a label=item *label - label a directory tree=item *remove - remove the label from all labeled objects=item *show - show all objects tagged with the label=item *lock - lock a label=item *delete - delete all instances of a label and the label=item *info - describe the labels properties=backThe various operations may be mixed in the one command. The order of theoperations is: create, unlock, rename, mine, label, show, remove, delete, lockand info.Thus it is possible to create a label, label a directory tree and then lock thelabel.The 'label' command line parameter may be a ClearCase VCS specification, inwhich case the VOB and the ClearCase label will be extracted and used.=head1 EXAMPLEjats label -create -label -lock daf_br_23.0.0.sydThis command will create the label 'daf_br_23.0.0.syd', then label all files andfolders in and below the current directory with that label, and then lock the label.jats label -info CC::/MASS_Dev/COTS/cots_netbula::netbula_2.10.1.cotsThis command will process the 'label' as a ClearCase VCS tag and extract thevob (MASS_Dev) and the ClearCase label (netbula_2.10.1.cots). It will thenprovide information on that label in the MASS_Dev vob.=cut