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