Subversion Repositories DevTools

#! /usr/bin/perl

########################################################################

# Copyright (C) 1998-2004 ERG Limited, All rights reserved

#

# Module name   : jats_label.pl

# Module type   : Makefile system

# Compiler(s)   : n/a

# Environment(s):

#

# 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.006_001;

use strict;

use warnings;

use JatsError;

use JatsSystem;

use Pod::Usage;                             # required for help support

use Getopt::Long;

use Cwd;

my $VERSION = "1.2.2";                      # Update this

#

#   Options

#

my $opt_debug   = $ENV{'GBE_DEBUG'};        # Allow global debug

my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose

my $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 $label;

my $user_cwd;

my @error_list;

my $last_result;

my $opr_done;

my $label_exists = 0;

my $build_count = 0;

my $vob_desc ='';

#

#   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

                );

                #

                #   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") if ( $opt_clone && $opt_label );

$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') );

#-------------------------------------------------------------------------------

#   Construct a vob descriptor, if required

#

if ( $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

#

Verbose ("Check label");

ClearCmd ("describe", "-short", "lbtype:$label$vob_desc" ) unless $opt_test;

$label_exists = 1 unless( $opt_test || grep ( /Label type not found/, @error_list ));

Verbose ("Check label: $label_exists");

#-------------------------------------------------------------------------------

#   Process command

#       Create a label

#

if ( $opt_create || ( $opt_auto && ! $label_exists    ) )

{

    Verbose ("Create label");

    Error ("Label already exists") if ( $label_exists );

    my $opts = '-nc';

    $opts = '-c "' . $opt_comment . '"' if ( $opt_comment );

    ClearCmd ("mklbtype", $opts, "$label$vob_desc" ) unless $opt_test;

    Error ("Program Terminated") if ( @error_list );

    $opr_done = 1;

}

#-------------------------------------------------------------------------------

#   Ensure that the specified label exists

#

    Verbose ("Check label");

    ClearCmd ("describe", "-short", "lbtype:$label$vob_desc" ) unless $opt_test;

    Error ("Program Terminated") if ( @error_list );

#-------------------------------------------------------------------------------

#   Process command

#       Unlock a label - if it was locked

#

if ( $opt_unlock || $opt_smartlock )

{

    Verbose ("Unlock label");

    ClearCmd ("describe", "-fmt", "%[locked]p", "lbtype:$label$vob_desc" );

    unless ( $last_result && $last_result =~ m~unlocked~ )

    {

        ClearCmd ("unlock", "lbtype:$label$vob_desc" ) unless $opt_test;

        Error ("Program Terminated") if ( @error_list );

        $opt_lock = 1 if ( $opt_smartlock );

    }

    $opr_done = 1;

}

#-------------------------------------------------------------------------------

#   Process command

#       Rename a label

if ( $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 = 1

        if ( $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 directories

if ( $opt_label || ( $opt_auto && ! $opt_clone ) )

{

    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 = 1

            if ( 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 = 1

                if ( 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 );

    #

    #   Double check the label process

    #   We are seeing issues with ClearCase where a file, or dir, is not being

    #   labeled. The following is a quick check. See if there is any thing to

    #   label again

    #

    unless ( $opt_test )

    {

        %info = ();

        determine_dirs_to_label ( \%info );

        determine_files_to_label( \%info );

        if ( @{$info{'dir_list'}}  || @{$info{'label_list'}} )

        {

            DebugDumpData("DoubleCheck Data", \%info );

            Error ('ClearCase label problem detected',

                   'Please report to david.purdie@vix-erg.com',

                   'Directories and Files not labled as requested:',

                   @{$info{'dir_list'}},

                   @{$info{'label_list'}}

                   );

        }

    }

    $opr_done = 1;

}

#-------------------------------------------------------------------------------

#   Process command

#       Clone

if ( $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 labels

if ( $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 label

if ( $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 locked

if ( $opt_lock )

{

    Verbose ("Lock label");

    ClearCmd ("describe", "-fmt", "%[locked]p", "lbtype:$label$vob_desc" );

    if ( $last_result =~ m~unlocked~ )

    {

        ClearCmd ("lock", "lbtype:$label$vob_desc" ) unless $opt_test;

        Error ("Program Terminated") if ( @error_list );

    }

    $opr_done = 1;

}

#-------------------------------------------------------------------------------

#   Process command

#       Display Label information

if ( $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'} = '';

    #

    #   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 );

    push @opt_dirs, '.' unless ($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");

        my $path = getcwd();

        while ( 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;

            #

            #   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 )

            {

                $data->{'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

            #

            $data->{'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 ( $path =~ m~/~ );

        }

    }

}

#-------------------------------------------------------------------------------

# 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;

    my $do_up = $opt_up || ( ! $do_files && ! $do_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

    #

    foreach my $dir (@opt_files, @opt_dirs )

    {

        #

        #   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 ? '' : '-nrecurse';

        my $cmd = QuoteCommand ("cleartool", "find", "$dir", "-cview", $find_arg, "-version", "{!lbtype($label)}", "-print");

        Verbose2($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($_);

            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 find

            if ( ! $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 = ();

        my $cmd_handle;

        open($cmd_handle, "cleartool $cmd  2>&1 |")    || Error "can't run command: $!";

        while (<$cmd_handle>)

        {

            chomp;

            $last_result = $_;

            Verbose ( "cleartool resp:" . $_);

            push @error_list, $_ if ( m~Error:~ );

        }

        close($cmd_handle);

    Verbose2 "Exit Status: $?";

    return $? / 256;

}

#-------------------------------------------------------------------------------

#   Documentation

#

=pod

=head1 NAME

jats_label - Clearcase label operations

=head1 SYNOPSIS

jats label [options] C<label>

 Options:

    -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

    -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 locked

 Modifiers

    -all               - Process all the VOB. Use with -show and -remove.

    -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 and -label operations.

With this option the processing extends to the entire VOB. This is a slower, but

more complete operation.

With this option the -label will label files that are not currently present in a

static view.

=item B<-auto>

This option will create the label if the label does not exist and then label the

current directory.

This option is a combination of a -create and a -label, except that it will

not 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 an

existing build before tailoring the file set.

=item B<-create>

This option will create the specified label. The operations will fail if the

label 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 label

and remove the label from the VOB. You need to be the owner of this label in

order for the operation to occur without error.