Subversion Repositories DevTools

########################################################################
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
#
# Module name   : cc_find_roots.pl
# Module type   : Makefile system
# Compiler(s)   : Perl
# Environment(s): jats
#
# Description   :
#
# Usage:
#
# Version   Who      Date        Description
#
#......................................................................#

require 5.008_002;
use strict;
use warnings;

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

use JatsError;
use JatsSystem;

#
#   Globals
#
my @ROOT_VOBS;
my @error_list;                             # ClearCmd detected errors

my %ROOTS;

#
#   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 = ClearToolCmd ('lsvob', '-short');
open(CMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
while (<CMD>)
{
    #
    #   Filter output from the user
    #
    chomp;
    Verbose2("lsvob: $_");
    tr~\\/~/~s;
    push @ROOT_VOBS, $_;
}
close(CMD);

#
#   Process each VOB
#
foreach my $vob ( @ROOT_VOBS )
{
    print "processing $vob\n";
    $ROOTS{$vob}{'main'} = 1;
    
    my $cmd = ClearToolCmd ('lsvtree', '-short' , "o:/dpurdie_view4/$vob/@@/main/0" );
    open(CMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
    while (<CMD>)
    {
        #
        #   Filter output from the user
        #
        chomp;
        Verbose2("lsvtree: $_");
        tr~\\/~/~s;
        next if ( m~/\d+$~ );
#        print "----- $_\n";
        if ( m~/main/([^/]+)$~ )
        {
            print "---------------- $1\n";
            $ROOTS{$vob}{$1} = 1;
        }
    }
    close(CMD);
}

DebugDumpData("ROOTS", \%ROOTS );




#-------------------------------------------------------------------------------
# Function        : ClearCmd
#
# Description     : Execute a cleartool command
#                   Capture error messages only
#
# Inputs          : Command to execute
#                   Takes an array of command argumeents and will quote them
#
# Returns         : Exit code
#                   Also the global @error_list
#
sub ClearCmd
{
    @error_list = ();

    my $cmd = ClearToolCmd(@_);
    open(CMD, "$cmd  2>&1 |")    || Error "can't run command: $!";
    while (<CMD>)
    {
        chomp;
        Verbose ($_);
        push @error_list, $_ if ( m~Error:~ );
    }
    close(CMD);

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

#-------------------------------------------------------------------------------
# Function        : ClearToolCmd
#
# Description     : Create a nice escaped cleartool command
#
# Inputs          : An array of cleartool command line arguments
#
# Returns         : A string that has been quoted
#
sub ClearToolCmd
{
    my $cmd = 'cleartool ' . QuoteCommand( @_);
    Verbose2 $cmd;
    return $cmd;
}