Subversion Repositories DevTools

########################################################################
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
#
# Module name   : cc2svn_labeldirs.pl
# Module type   : Makefile system
# Compiler(s)   : Perl
# Environment(s): jats
#
# Description   : Used to process package-versions that are incorrectly
#                 labled - the package has not been labeled up to the root
#                 of the VOB
#
#                 The utility works by scanning the VOB for labeled files
#                 It then determines the full path and will detect paths
#                 that have not been labled.
#
#                 It will then label them
#
#                 The search process is not fast.
#
# Usage:        jats cc2svn_labeldirs 'CC::/VobName/Path::Label'
#
#......................................................................#

require 5.008_002;
use strict;
use warnings;

use Pod::Usage;
use Getopt::Long;

use JatsError;
use JatsSystem;

#
#  Globals that can be set immediately
#
my $VERSION = "1.1.0";
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_drive = $UNIX ? '/view' : 'o:';
my $opt_viewname = 'administration_view';
my $opt_vob;
my $opt_label;
my $opt_test = 0;

my $vob_name;
my $vob_desc;
my $view_path;
my @paths;
my %usedDirs;
my %notLabled;
my $label_error = 0;

my @error_list;
my @last_results;
my $last_result;
my $label_exists = 0;
my $label_is_locked = 0;
my $label_is_unlocked;
my $label_count = 0;

#-------------------------------------------------------------------------------
# Function        : main Entry Point
#
# Description     : 
#
# Inputs          : 
#
# Returns         : 
#
my $result = GetOptions (
                "help:+"        => \$opt_help,
                "manual:3"      => \$opt_help,
                "verbose:+"     => \$opt_verbose,
                "label:s"       => \$opt_label,
                'vob:s'         => \$opt_vob,
                'test!'         => \$opt_test,
                );

                #
                #   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'    =>'LABELDIRS',
             'verbose' => $opt_verbose,
             'on_exit' => \&display_error_list
            );

#
#   Sanity test
#
Error ("No labels provided") if ( $#ARGV < 0 && ! $opt_label);
Error ("Too many labels provided") if ( $#ARGV >= 0 && $opt_label);
Error ("Too many labels provided") if ( $#ARGV > 0);
$opt_label = $ARGV[0] unless $opt_label;

#
#   Convert label with embedded VCS information into a 'normal' form.
#   Form:
#       CC::label
#       CC::path::label
#       CC::::label
#
$opt_label =~ tr~\\/~/~s;
if ( $opt_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: $opt_label" ) if ( $opt_vob && $path ne $opt_vob );
            $opt_vob = $path;
        }
    }
    $opt_label = $ll;
    Verbose ("Clean URL: $opt_vob, $opt_label");
}
else
{
    Error ("No VOB specified") unless $opt_vob;
    $opt_vob =~ s~^/~~;
    $opt_vob =~ s~/.*?$~~;
}
Error ("No VOB specified") unless ( $opt_vob );

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

$vob_name = $UNIX_VOB_PREFIX . $opt_vob if ( $UNIX && $opt_vob !~ m~^${UNIX_VOB_PREFIX}~ );
$vob_name =~ s~/~$VOB_SEP~g;

$vob_desc = '@' . $vob_name;
$vob_desc =~ s~//~/~g;

Message ("VobName: $vob_name, $vob_desc");

#
#   Mount the target VOB, but only if its not already mounted
#
ClearCmd( 'lsvob', $vob_name);
unless ( $last_result =~ m~^\*\s+$vob_name~)
{
    Message ("Mounting VOB: $vob_name");
    if( ClearCmd( 'mount', $vob_name) )
    {
        Error ("Could not mount the VOB: $vob_name");
    }
}

#
#   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
#
Verbose2 ("getIds: chdir: $view_path");
chdir ($view_path) || Error ("Did not chdir to $view_path" );
    

#
#   Ensure that the label exists inthe VOB
#
LocateLabel($opt_label);

#
#   Search the VOB for all Objects with the label
#   Then examine each object and determine the set of unique paths
#
@paths = findLabledOjects($opt_label);
processOneItem($_) foreach ( @paths );

#
#   Now have a list of paths
#
foreach my $path ( reverse sort { length($a) <=> length($b) } keys %usedDirs )
{
my $ppath = $path; $ppath =~ s~.*/vobs/~~;
    Verbose("Examine: $ppath");
    unless ( tailIsLabeled ($path) )
    {
        $notLabled{$path} = 1;
        Verbose("NotLabled: $ppath");
#print "0: $path\n";
    }
}

#
#   Walk the list of paths and label the required directories
#   Walk from bottom to top (longest first)
#
foreach my $path ( reverse sort { length($a) <=> length($b) } keys %notLabled )
{
    Verbose("Path: $path");
    my $ppath = $path;
    $ppath =~ s~.*/vobs/~~;

    my $testdir = $path;
    #
    #   One final test
    #
    unless ( tailIsLabeled ($path) )
    {
        print "$testdir - Must label\n";
        smartUnLock();
        ClearCmd ("mklabel", '-c', 'JATS cc2svn_labeldirs', $opt_label, $path ) unless $opt_test;
        if ( display_error_list() )
        {
            $label_error++;
        }
        else
        {
            $label_count++ unless ($opt_test);
        }
    }
    else
    {
        print "$ppath - Already labled\n";
    }
}

#
#   All done
#
smartLock();
Message ("Items Found: ". scalar @paths);
Message ("Labels applied: $label_count");
Message ("Label  errors : $label_error") if $label_error;
Error ("Not all required paths labled") if ( $label_error );
exit (0);

#-------------------------------------------------------------------------------
# Function        : tailIsLabeled
#
# Description     : Determine if the tail of the current path is labled
#
# Inputs          : $test   - Path to test
#
# Returns         : 1       - Is labled
#                   0       - Is not Labled
#
sub tailIsLabeled
{
    my ($test) = @_;

#    print "$path\n";
    my $found = 0;
    my $more = 100;

    #
    #   First remove the last element - it will be a label (number)
    #
    $test =~ s~/[^/]*?$~~;
    while ( $more-- )
    {
        if ( -e $test . '/' . $opt_label )
        {
            return 1;
        }
        $test =~ s~(.*)/(.*?)$~~;
        $more = 1 if ( $2 eq 'main' );
        $test = $1;
    }
    return 0;
}

#-------------------------------------------------------------------------------
# Function        : processOneItem
#
# Description     : Examine a CC extended path. Break it into bits and
#                   determine with parts of the path have not been labled
#
# Inputs          : $path               - Path to process
#
# Returns         : Fill in %usedDirs
#
sub processOneItem
{
    my ($path) = @_;

    #
    #   Break of the last bit OBJECT/main/....../nn
    #
    while ( $path =~ m~(/.*)/([^/]+/main/)(.*?)$~ )
    {
        $path = $1;
        my $tagPath = $path;
        $tagPath =~ s~/\d+$~~;
        $usedDirs{$path} = 1 if $tagPath =~ m~\@\@~;
    }
}

#-------------------------------------------------------------------------------
# Function        : findLabledOjects
#
# Description     : Find all objects on the VOB with the specified label
#
# Inputs          : $opt_label      - Label to find
#
# Returns         : Results into @paths
#
sub findLabledOjects
{
    my ($opt_label) = @_;
    my @results;
    Message ("Locate objects in VOB: $opt_vob" );

    my $cmd = QuoteCommand("cleartool", "find", "$opt_vob", '-all', "-version", "lbtype($opt_label)", "-print");
    Verbose2($cmd);

    open(SHOWCMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
    while (<SHOWCMD>)
    {
        #
        #   Filter output from the user
        #
        chomp;
        Verbose3($_);
        next if ( m~/lost\+found~ );
        push @results, $_;
    }
    close(SHOWCMD);
    return @results;
}

#-------------------------------------------------------------------------------
# Function        : LocateLabel
#
# Description     : Check that the label exists
#                   Determine if the label is locked
#
# Inputs          : $opt_label  - Label to locate
#
# Returns         : Nothing
#
sub LocateLabel
{
    Verbose ("Check label");
    ClearCmd ("describe", "-fmt", "%[locked]p", "lbtype:$opt_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");
}

#-------------------------------------------------------------------------------
# Function        : smartLock
#
# Description     : Lock, unlock label
#
# Inputs          : mode            : 1 - lock if it was unclocked
#                                     0 - unlock unless already done
#
# Returns         : 
#
sub smartUnLock
{
    if ( $label_is_locked && ! $label_is_unlocked)
    {
        ClearCmd ("unlock", "lbtype:$opt_label$vob_desc" ) unless $opt_test;
        Error ("Program Terminated") if ( @error_list );
        $label_is_unlocked = 1;
    }
}

sub smartLock
{
    if ( $label_is_unlocked)
    {
        ClearCmd ("lock", "lbtype:$opt_label$vob_desc" ) unless $opt_test;
        Error ("Program Terminated") if ( @error_list );
        $label_is_unlocked = 0;
    }
}

#-------------------------------------------------------------------------------
# Function        : ClearCmd
#
# Description     : Similar to the system command
#                   Does allow standard output and standard error to be captured
#                   to a log file
#
#                   Used since I was having problems with calling other programs
#                   and control-C. It could hang the terminal session.
#
# Inputs          :
#
# Returns         :
#
sub ClearCmd
{
    my $cmd = QuoteCommand (@_);
    Verbose2 "cleartool $cmd";

        @error_list = ();
        @last_results = ();
        $last_result = undef;
        my $cmd_handle;
        open($cmd_handle, "sudo -u buildadm cleartool $cmd  2>&1 |")    || Error "can't run command: $!";
        while (<$cmd_handle>)
        {
            chomp;
            $last_result = $_;
            $last_result =~ tr~\\/~/~s;
            push @last_results, $last_result;
            Verbose ( "cleartool resp:" . $_);
            push @error_list, $_ if ( m~Error:~ );
        }
        close($cmd_handle);

    Verbose2 "Exit Status: $?";
    return $? / 256;
}

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

    smartLock();
    return 1;
}

#-------------------------------------------------------------------------------
#   Documentation
#

=pod

=for htmltoc    SYSUTIL::cc2svn::

=head1 NAME

cc2svn_labeldirs - Locate directories that have not been labeled in ClearCase

=head1 SYNOPSIS

  jats cc2svn_labeldirs [options] [CC::/vob::label]

 Options:
    -help              - brief help message
    -help -help        - Detailed help message
    -man               - Full documentation
    -[no]test          - Only display missing labels. Default:test
    -label=label       - Specify the label
    -vob=vob           - Specify VOB

=head1 OPTIONS

=over 8

=back