Subversion Repositories DevTools

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

# 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 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 $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 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 && ! $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 = 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 );

    $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

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

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

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