Subversion Repositories DevTools

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

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

#

# Module name   : CCdiff.pl

# Module type   : Makefile system

# Compiler(s)   : n/a

# Environment(s): JATS. This script is designed to be run under JATS

#

# Description   : Make ClearCase difference report suitable for uploading

#                 to Code Striker.

#......................................................................#

require 5.6.1;

use strict;

use warnings;

use JatsError;

use JatsSystem;

use Pod::Usage;                             # required for help support

use Getopt::Long;

use FileUtils;

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

#

#  Function Prototypes

#

sub populateFilesArray($$$\%);

sub files_from_view($$$$\%);

sub generateOutputFilename(\$);

sub getTags();

sub parseTag(\$\$\$);

sub getClearToolFindOutput($$);

sub element0($);

sub getIds($@);

sub massage_path($\$$\$);

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

#

#  Global variables

#

#

# Update this:

#

my $VERSION = "1.0.3";                      

#

#  Globals that can be set immediately

#

my $ats = "@@";

my $UNIX = $ENV{'GBE_UNIX'};

my $UNIX_VOB_PREFIX = '/vobs';

my $VOB_SEP = $UNIX ? '/' : '\\';

#

#   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_manual = 0;

my $opt_drive = $UNIX ? '/view' : 'o:';

my $opt_viewname = 'administration_view';

my $opt_outfile;

my @opt_vobs;

my $opt_new;

my $opt_old;

my $opt_massage = 1;

#

#  Globals that are set within the script

#

my @error_list;                             # ClearCmd detected errors

my $view_path;

my @view_tags;

my %files;

my %clearCaseInfos;

my $oldLabel;

my $newLabel;

my $oldDirectory;

my $newDirectory;

#

#   ROOT_VOBS is a list of VOBS too look in first

#   If a label is not found in these vobs, then the program will

#   look in all vobs. This list is a hint to speed up searching

#

my @ROOT_VOBS = qw( /LMOS /DPG_SWBase /DPG_SWCode /ProjectCD /MASS_Dev_Bus

                    /MASS_Dev_Infra /MOS /MASS_Dataman /MASS_Dev /MASS_Dev_Dataman

                    /COTS /GMPTE2005 /GMPTE2005_obe /MPR /MOS );

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

#

#  Mainline entry point

#

InitFileUtils();

#

#   Parse the user options

#

my $result = GetOptions (

    "help+"         => \$opt_help,              # flag, multiple use allowed

    "manual"        => sub{ $opt_help = 3},     # flag, multiple use allowed

    "verbose+"      => \$opt_verbose,           # flag, multiple use allowed

    "output=s"      => \$opt_outfile,           # String

    "new=s"         => \$opt_new,               # String

    "old=s"         => \$opt_old,               # String

    "drive=s"       => \$opt_drive,             # String

    "vob=s"         => \@opt_vobs,              # String

    "massage!"      => \$opt_massage,           # [no]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);

#

#   Configure the error reporting process now that we have the user options

#

ErrorConfig( 'name'    => 'CCDIFF',

             'verbose' => $opt_verbose );

#

#   Work out '$oldLabel', '$newLabel', '$oldDirectory', '$newDirectory' tags

#

getTags();

Error ("Too many command line arguments" )

    unless ( $#ARGV < 0 );

generateOutputFilename($opt_outfile);

#

#   Determine the machine type

#

Verbose ("Machine Type: UNIX=$UNIX");

#

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

#

#   Ensure that the 'administration_view' is available

#   Then start the view, before checking its availability

#

if( ClearCmd('lsview', $opt_viewname) )

{

    Error ("Required view not found: $opt_viewname",

           "This is a dynamic view that should exist as it is used by the build system");

}

if( ClearCmd( 'startview', $opt_viewname) )

{

    Error ("Cannot start the required view: $opt_viewname");

}

$view_path = "$opt_drive/$opt_viewname";

$view_path .= $UNIX_VOB_PREFIX if ( $UNIX );

Error ("Cannot locate the required dynamic view: $view_path",

       "The view exits and has been started. It cannot be found")

    if ( ! -d $view_path  );

#

#   Determine the list of VOBs to scan for a label

#   This may be user specified or all the known vobs

#

if ( @opt_vobs )

{

    #

    #   User has provided a list of vobs to search

    #   Use this list

    #

    @ROOT_VOBS = ();

    foreach my $vob ( @opt_vobs )

    {

        $vob = '/' . $vob;

        $vob =~ s~^$UNIX_VOB_PREFIX~~ if ($UNIX);

        $vob =~ tr{\\/}{/}s;

        push @ROOT_VOBS, $vob;

    }

}

else

{

    #

    #   Extend the list of ROOT_VOBS with all the known vobs

    #   The initial ROOT_VOBS are treated as a "hint" to assist searching

    #

    my $cmd = "cleartool lsvob -short";

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

    while (<CMD>)

    {

        #

        #   Filter output from the user

        #

        s~[\n\r]+$~~;

        s~^$UNIX_VOB_PREFIX~~ if ($UNIX);

        Verbose2("lsvob: $_");

        tr{\\/}{/}s;

        push @ROOT_VOBS, $_;

    }

    close(CMD);

}

#

#   Ensure the two labels are present - determine the VOB root

#

my $oldLabelVob = $oldLabel ? LocateLabel( $oldLabel ) : "";

my $newLabelVob = $newLabel ? LocateLabel( $newLabel ) : "";

#

#   Massage the directory path

#   If the user has provided a directory, then we will compare the

#   entire contents of the directory against the label

#

massage_path( $oldLabelVob, $oldDirectory, $newLabelVob, $newDirectory  )

    if ( $opt_massage );

#

#   Locate all files for the two areas

#

{

    my %initialFilePaths;

    files_from_view( $oldLabelVob, $oldLabel, 1, $oldDirectory, %initialFilePaths );

    files_from_view( $newLabelVob, $newLabel, 2, $newDirectory, %initialFilePaths );

    #DebugDumpData ("initialFilePaths", \%initialFilePaths );

    populateFilesArray( $oldLabel, 1, $oldDirectory, %initialFilePaths);

    populateFilesArray( $newLabel, 2, $newDirectory, %initialFilePaths);

    #DebugDumpData ("Files", \%files );

}

#

#   Have a structure that contains files for both the old and new labels

#   Scan the list locating files that are different

#

my @no_text;

my $added = 0;

my $deleted = 0;

my $ndiffs = 0;

my $ifile = 0;

Verbose ("Opening file in current directory", $opt_outfile, Getcwd() );

open (FO, ">$opt_outfile") || Error ("Cannot open file: $opt_outfile", "Reason: $!");

foreach my $id ( sort keys %files )

{

    $ifile ++;

    Verbose("Computing differences for file $ifile/" . scalar(keys %files));

    my ($hs, $aid);

    if ( $files{$id}{1} && $files{$id}{2} ) #  File exists in both areas:

    {

        #

        #   Test for files existing in both tags and being identical

        #

        next if( $files{$id}{1} eq $files{$id}{2} );

        #

        #   Files are in both areas, but are different

        #   Perform diff. There may be cases where they are really the same text

        #   or the only change is in white space.

        #

        ($hs, $aid) = ClearDiff("-serial_format", "-blank_ignore", $files{$id}{1}, $files{$id}{2});

        $ndiffs++ if ( $hs );

    }

    elsif( $files{$id}{1} ) # File doesn't exist in 'new' area:

    {

        ($hs, $aid) = ClearDiff("-serial_format", $files{$id}{1}, element0($files{$id}{1}) );

        $deleted++ if ( $hs );

    }

    elsif( $files{$id}{2} ) # File doesn't exist in 'old' area:

    {

        ($hs, $aid) = ClearDiff("-serial_format", element0($files{$id}{2}), $files{$id}{2} );

        $added++ if ( $hs );

    }

    else # bug!

    {

        Error("Internal BUG in main line!  Please report!",

              "id='$id' ifile=$ifile neither has a 1 nor a 2 tag");

    }

    push @no_text, $files{$id}{1} if ( $files{$id}{1} && ! $hs && ! $aid );

    push @no_text, $files{$id}{2} if ( $files{$id}{2} && ! $hs && ! $aid );

}

close FO;

#

#   Warn about problem files

#

if ( @no_text )

{

    Warning ("The following files did not generate any difference report, although",

             "they are different. They may be binary files:", @no_text);

}

#

#   Summary information

#

Information ("Summary Information",

             "Old:               : " . $oldLabel ? $oldLabel : $oldDirectory,

             "New:               : " . $newLabel ? $newLabel : $newDirectory,

             "Files different    : $ndiffs",

             "Files added        : $added",

             "Files deleted      : $deleted",

             "Files not in report: " . scalar(@no_text),

             "Output file        : $opt_outfile"

             );

exit (0);

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

# Function        : generateOutputFilename

#

# Description     : Works out what the output diff filename should be

#

# Inputs          : $oldLabel, $newLabel

#

# Input/Output    : reference to $opt_outfile

#

# Returns         : 

#

sub generateOutputFilename(\$)

{

    my $refOpt_outfile = shift;

    unless( $$refOpt_outfile )

    {

        $$refOpt_outfile = "${oldLabel}-${newLabel}-diff.txt" if(  $oldLabel &&  $newLabel );

        $$refOpt_outfile = "${oldLabel}-diff.txt"             if(  $oldLabel && !$newLabel );

        $$refOpt_outfile = "${newLabel}-diff.txt"             if( !$oldLabel &&  $newLabel );

        $$refOpt_outfile = "directoryDifferences-diff.txt"    if( !$oldLabel && !$newLabel );

        #

        #   If the label has ugly characaters in it then we won't be able to create

        #   a nice file name. Sanitise the filename

        #

        $$refOpt_outfile =~ s{[\\/:]+}{_}g;

        $$refOpt_outfile =~ s{_+}{_}g;

    }

    #

    # Do an early check that output file can be written to

    #

    open( Z, ">$$refOpt_outfile") or Error("Could not open '$$refOpt_outfile' for writing");

    close( Z );

    unlink $$refOpt_outfile;

}

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

# Function        : getTags

#

# Description     : Works out whether using labels or directories, and fills in

#                   $oldLabel or $oldDirectory

#                   $newLabel or $newDirectory

#                   Function works with $opt_new, $opt_old, @ARGV

#

# Inputs          : 

#

# Returns         : 

#

sub getTags()

{

    # If we have two options and no labels, then assign them

    if ( ! $opt_new && ! $opt_old )

    {

        Error ("Must provide two labels on command line unless they are provided " .

               "via -old and -new options") if ( $#ARGV < 1 );

        $opt_old = shift @ARGV;

        $opt_new = shift @ARGV;

    }

    Error ("Need to provide the 'new' label/directory") unless ( $opt_new );

    Error ("Need to provide the 'old' label/directory") unless ( $opt_old );

    parseTag($opt_old, $oldLabel, $oldDirectory);

    parseTag($opt_new, $newLabel, $newDirectory);

    Error("Cannot compare two directories") if( $oldDirectory && $newDirectory );

}

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

# Function        : parseTags

#

# Description     : Worker function for getTags() - parses a "-new"/"-old" option

#

# Inputs          : $retOpt - reference to the command line argument

#                   $refLabel - reference to the label variable that may be initialised

#                   $refDirectory - reference to the directory variable that may be initialised

#

# Returns         : 

#

sub parseTag(\$\$\$)

{

    my ($refOpt,$refLabel,$refDirectory) = @_;

    if( $$refOpt =~ m/^dir=(.*)/ )

    {

        $$refLabel = "";

        $$refDirectory = ($1 eq "current") ? "." : $1;

        $$refDirectory =~ tr{\\/}{/}s;

        $$refDirectory =~ s~/$~~;

    }

    elsif( $$refOpt =~ m/^current/ )

    {

        $$refLabel = "";

        $$refDirectory = ".";

    }

    else

    {

        $$refLabel = $$refOpt;

        $$refDirectory = "";

        #

        #   Sanity check

        #   Labels shouldn't have directory seperator characters in them

        #   The user may have mis-used the command

        #

        if ( $$refOpt =~ m~[/\\]~  )

        {

            Warning("Label has slashes in it. Looks like a directory",

            "Did you mean 'dir=$$refOpt'?",

            "Continuing anyway...");

        }

    }

}

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

# Function        : populateFilesArray

#

# Description     : Populates the global '%files' hash array.  It does this

#                   by taking as input a hash array that is the output of cleartool

#                   find/ls, and, for files that did not come up identical for both

#                   old and new labels, calling cleartool dump to get the info

#                   to put into the '%files' hash.

#

# Inputs          : $label          - Label (not set if $directory defined)

#                   $tag            - File tag (1 for 'old' or 2 for 'new')

#                   $directory      - Directory name (not set if $label defined)

#                   $refInitialFilePaths - reference to the hash array that stores the

#                                          output of previous calls to cleartool find/ls.

#

# Returns         : Nothing

#                   Populates the %files array

#

sub populateFilesArray($$$\%)

{

    my ($label, $tag, $directory, $refInitialFilePaths) = @_;

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

    # Step 1: Get an array of filenames

    my @initialFilePaths;

    foreach my $initialFilePath (sort keys %$refInitialFilePaths)

    {

        # If a file exists in both labels and has the same initial file path

        # we just assume that the ids are identical and that 

        # cleartool dump does not need to be called

        # This saves execution time.

        # Instead - we just use the file path as the id

        #

        if( $$refInitialFilePaths{$initialFilePath}{1} && 

            $$refInitialFilePaths{$initialFilePath}{2} )

        {

            $files{$initialFilePath}{$tag} = $initialFilePath;

            next;

        }

        push @initialFilePaths, $initialFilePath 

            if( $$refInitialFilePaths{$initialFilePath}{$tag} );

    }

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

    # Step 2: Call cleartool dump on each of these initial filenames and get the ids

    # Then populate the %files array

    #

    #   In practice this will only be used when one side of the comarison

    #   is a directory. Should be able to use this knowledge

    #

    my @ids = getIds( $tag, @initialFilePaths );

#DebugDumpData ("IDS", \@ids);

    #

    #   Populate the 'files' hash

    #   Keys are: element number and tag

    #   This groups files that are the same element together

    #   They may be different versions of the element

    #

    #   The value is the vob extended pathname within the admin vob

    #   This can be used to extract the file in any view

    #

    foreach my $datap ( @ids )

    {

        my $pname = $datap->{pname};

        my $element = $datap->{element};

        $files{$element}{$tag} = $pname;

    }

}

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

# Function        : files_from_view

#

# Description     : Fills in the hash array 'initialFilePaths' with filename paths

#                   If a label, uses cleartool find

#                   If a directory, then cleartool ls is used

#

# Inputs          : $vpath          - Path to the view

#                   $label          - Label (not set if $directory defined)

#                   $tag            - File tag (1 for 'old' or 2 for 'new')

#                   $directory      - Directory name (not set if $label defined)

#                   $refInitialFilePaths - reference to hash array of filename paths

#

# Returns         : Nothing

#

sub files_from_view($$$$\%)

{

    my ($vpath, $label, $tag, $directory, $refInitialFilePaths) = @_;

    if( $label )

    {

        #

        #   Ensure that the VOB is mounted

        #   The mount command MUST have the correct vob format

        #

        my $vob_name = $vpath;

        $vob_name =~ s~^/+~~;

        ClearCmd ('mount', $VOB_SEP . $vob_name);

        my @initialFilePaths = getClearToolFindOutput( $vpath, $label );

        foreach my $initialFilePath (@initialFilePaths)

        {

            $$refInitialFilePaths{$initialFilePath}{$tag} = 1;

        }

    }    

    else

    {

        my $nfilesStartedWith = scalar(keys %$refInitialFilePaths);

        my @checkedout;

        #

        #   Locate files in the specified directory

        #   Use an absolute directory to simplify location of files

        #   Will cause output of the 'ls' to have absolute paths, which is good

        #

        $directory = FullPath( $directory );

        my $cmd = QuoteCommand( 'cleartool', 'ls', '-recurse', $directory);

        Message("Cleartool: searching for clearcase elements in '$directory'");

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

        while( <CMD> )

        {

            # Each line will be of the form (e.g.):

            # ./LIB/JatsMakeConfig.pm@@/main/4         Rule: core_devl_2.73.2000.cr

            s~[\n\r]+$~~;

            #

            #   Only want the files known to ClearCase

            #   These will have a 'Rule:'

            #

            #   If the user has checkedout files, then all of this will

            #   not work

            #

            if ( m{(.+?)\s+Rule:(.+)} )

            {

                my $files = $1;

                my $rule = $2;

                $files =~ tr{\\/}{/}s;  # Replace \ and / with /

                (my $actualFilePath = $files) =~ s~${ats}.*~~;

                if ( $rule =~ m/CHECKEDOUT/ )

                {

                    push @checkedout, $actualFilePath;

                }

                #

                #   Don't want to know about directories

                #

                next if( -d $actualFilePath );

                #

                #   Save files name, with embedded version

                #

                $$refInitialFilePaths{$files}{$tag} = 1;

            }

        }

        close( CMD );

        Message ("There are " . (scalar(keys %$refInitialFilePaths) - $nfilesStartedWith) . 

             " files in directory $directory");

        #

        #   Files that are checked otu are bad news. They cannot be reproduced

        #   on demand. Generate an error

        #

        if ( @checkedout )

        {

            Error ("Processed directory contains checked out files",

                   "Not supported by this tool. Files are:", @checkedout );

        }

    }

}

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

# Function        : getClearToolFindOutput

#

# Description     : Runs cleartool find on a label

#                   Runs in the adbinistration view so that the paths that

#                   are provided are vob extended.

#

# Inputs          : $vpath, $label

#

# Returns         : An array of the output lines of cleartool find

#

sub getClearToolFindOutput($$)

{

    my ($vpath,$label) = @_;

    my $cmd = qq(cleartool find "$opt_drive/$opt_viewname/$vpath" -all -follow -type f -element "lbtype_sub($label)" -version "lbtype_sub($label)" -print);

    Message ("Cleartool: searching for files with label '$label'");

    my @outputLines;

    # A typical line of output:

    #/view/administration_view/vobs/MASS_Dev_Infra/core_devl@@/main/mass_dev/1/BIN.win32/main/mass_dev/1/printenv.exe@@/main/mass_dev/1

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

    while (<CMD>)

    {

        s~\s+$~~;           # Remove white space including newline/returns

        tr{\\/}{/}s;        # Replace \ and / with /

        next if( -d $_ );   # -d tests if file is a directory

        Verbose2 ("ctf: $_");

        push @outputLines, $_;

    }

    close(CMD);

    Message("There are " . scalar(@outputLines) . " files in $opt_drive/$opt_viewname/$vpath");

    return @outputLines;

}

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

# Function        : getIds

#

# Description     : Calls cleartool dump to retrieve the unique identifer

#                   for each of a list of files.

#

# Inputs          : $tag

#                   @initialFilePaths - a list of filenames with @@'s in them.

#

# Returns         : An array of unique identifier strings.  This array has the same

#                   size as the input @initialFilePaths - each element is the unique

#                   identifier for the corresponding element of that array.

#

sub getIds($@)

{

    my ($tag,@initialFilePaths) = @_;

    my @ids;

    my $nfilesPerCallToDump = 20;

    #

    #   Change to the directory that contains the admin view

    #   This will ensure that the 2nd line of the dump comamnd contains

    #   the vob extended pathname within that view. This will be used

    #   to simplify the pairing of files

    #

    chdir ($view_path) || Error ("Did not chdir to $view_path" );

    while( @initialFilePaths )

    {

        #

        #   Limit the number of files to be processed in one call to the

        #   clearcase dump. Iff too many, then the command line will be long.

        #   If short ( ie 1 ), then the call overhead is very high

        #

        my @filesToDump = splice( @initialFilePaths, 0, $nfilesPerCallToDump);

        #

        #   The dump command provides two useful bits of information

        #       1) Line1: The vob extended pathname of the files as

        #                 seen in the current view, together with some junk

        #                 The line contains two @@ which is used by codestriker

        #                 Line2 would be better, but doesn't work with

        #                 Codestriker

        #

        #       2) element number

        #           This will be the same for all versions of an element

        #           This allows files from two views to be correlated

        #

        #

        my $cmd2 = QuoteCommand( "cleartool", "dump", @filesToDump);

        my @newids;

        my %data;

        my $line = 0;

        Verbose2("Cleartool: getting unique identifiers for " . scalar(@filesToDump) . " files");

        open(CCI, "$cmd2 2>&1 |") || Error "Can't run command: $!";

        while( <CCI> )

        {

            s~[\n\r]+$~~;

            #

            #   Blank entry signals new package

            #

            unless ( $_ )

            {

                $line = 0;

                %data = ();

                next;

            }

            $line++;

            #

            #   Line-1:

            #   Path to package as seen from current view

            #

            if ( $line == 1 )

            {

                s{\\}{/}g;

                s{\s+\(.+\)$}{};

                $data{pname} = $_;

                Verbose2 ("ctd: pname: $_");

                next;

            }

            #

            #   Extract the element number

            #   This will be common for each file, independent of the version of the

            #   file. This allows files from different views to be correlated

            #   Line is of the form:

            #   elem=596638  branch=596639  ver num=3  line count=526

            #

            if ( m{^(elem=\d+)} )

            {

                $data{element} = $1;

                Verbose2 ("ctd: elem: $1");

                push @newids, {%data};

            }

        }

        close(CCI);

        Error("Internal error in getIds(): Only retrieved " . scalar(@newids) . 

              " IDs from a cleartool dump command for " . scalar(@filesToDump) . " files")

            if( scalar(@newids) != scalar(@filesToDump) );

        push @ids, @newids;

    }

    chdir ($FileUtils::CwdFull) || Error ("Did not chdir to $FileUtils::CwdFull") ;

    return @ids;

}

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

# Function        : ClearDiff

#

# Description     : Issue a cleartool command

#                   Filter out many of the stupid messages

#

# Inputs          : Options and Command line

#

# Returns         : header_seen         - Bool. Header has been seen

#                   identical           - Bool. Files are really the same

#

sub ClearDiff

{

    my $header_seen = 0;

    my $identical = 0;

    my $cmd = QuoteCommand("cleardiff", @_);

    Verbose("ClearDiff cmd: $cmd");

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

    while (<CMD>)

    {

        Verbose2("ClearDiff: $_");

        $header_seen = 1

            if ( m~^[*]{32}~ );

        unless ( $header_seen )

        {

            $identical = 1 if ( m~^Files are identical~ );

            next;

        }

        #

        #   Filter output from the user

        #

        s~(file [12]: )$view_path/~$1/~i;

        print FO $_;

    }

    close(CMD);

    #

    #   Ensure the section ends with a complete line

    #   An extra line doesn't affect CS parsing, but without it any file

    #   without a trailing \n will kill the header parsing

    #

    print FO "\n" if($header_seen);

    return $header_seen, $identical;

}

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

# Function        : ClearCmd

#

# Description     : Execute a cleartool command

#                   Capture error messages only

#

# Inputs          : Command to execute

#

# Returns         : Exit code

#                   Also the global @error_list

#

sub ClearCmd

{

    my $cmd = QuoteCommand( @_ );

    @error_list = ();    

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

    while (<CMD>)

    {

        s~[\n\r]+$~~;

        Verbose2 ($_);

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

    }

    close(CMD);

    Verbose2 ("ClearCmd: Exit Status: $?");

    return ($?) / 256;

}

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

# Function        : LocateLabel

#

# Description     : Determine the VOBs that contains the specified label

#

# Inputs          : $label  - Label to locate

#

# Returns         : First VOB that contains the label

#

sub LocateLabel

{

    my ($label) = @_;

    Message ("Locate label in VOB: $label" );

    my $found = 0;

    foreach my $vob ( @ROOT_VOBS )

    {

        $vob = $UNIX_VOB_PREFIX . $vob if ( $UNIX && $vob !~ m~^${UNIX_VOB_PREFIX}~ );

        (my $vob_name = $vob) =~ s~/~$VOB_SEP~g;

        Verbose ("Examine label $label in vob: $vob" );

        my $cmd = "cleartool lstype \"lbtype:$label\@$vob_name\"";

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

        while (<CMD>)

        {

            #

            #   Filter output from the user

            #

            s~[\n\r]+$~~;

            Verbose2 ("lstype: $_");

            next if ( m~Error~ );

            next unless ( m~label type~ );

            $found = $vob;

            last;

        }

        while( <CMD> ){} # Get rid of broken pipe messages

        close(CMD);

        last if ( $found );

    }

    Error ("Label $label not found in @ROOT_VOBS")

        unless ( $found );

    Verbose ("Label $label found in $found");

    return $found;

}

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

# Function        : element0

#

# Description     : Given a branch version, this function will return the

#                   zero-th element on the branch

#

#                   ie: /DPG_SWBase/file@@some_branch/12

#                   ->  /DPG_SWBase/file@@some_branch/0

#

# Inputs          : $element

#

# Returns         : as described

#

sub element0($)

{

    my ($element) = @_;

    $element =~ s~/\d+$~/0~;

    return $element;

}

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

# Function        : massage_path

#

# Description     : Massage the user directory, if specified, such that

#                   it describes the root of the vob.

#

# Inputs          : $oldLabelVob

#                   $oldDirectory

#                 : $newLabelVob

#                   $newDirectory

#

# Returns         : Modifies $newDirectory or $oldDirectory

#

#

sub massage_path($\$$\$)

{

    my ($oldLabelVob, $oldDirectory, $newLabelVob, $newDirectory ) = @_;

    #

    #   If the user is comparing two labels, then there is nothing to do

    #

    return unless ( $$newDirectory || $$oldDirectory );

    #

    #   Figure out which ones to use

    #

    my $vob = $$newDirectory ? $oldLabelVob : $newLabelVob;

    my $directory = $$newDirectory ? $newDirectory : $oldDirectory;

    #