Subversion Repositories DevTools

#! perl
########################################################################
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
#
# Module name   : gen_dirlist.pl
# Module type   : JATS Makefile system
# Compiler(s)   : n/a
# Environment(s): JATS
#
# Description   : Post process the JATS build and makefiles and generate
#                 a list of directories that need to be labeled
#
# Usage:          JATS etool gen_dirlist
#
# Version   Who     Date        Description
#           DDP     05-Sep-05   Created
#......................................................................#

require 5.006_001;

use strict;
use warnings;
use JatsError;
use JatsMakeInfo;
use ReadBuildConfig qw(:All);
use FileUtils;
use JatsMakeConfig;

use Pod::Usage;                             # Required for help support
use Getopt::Long;                           # Option processing

#
#   Global variables
#
my  $VERSION = "1.0.0";                     # Update this
my  %include;                               # Local include directories

#
#   Global variables - Options
#
my  $opt_help = 0;
my  $opt_manual;
my  $opt_verbose = 0;

my $result = GetOptions (
                "help+"         => \$opt_help,              # flag, multiple use allowed
                "manual"        => \$opt_manual,            # flag, multiple use allowed
                "verbose+"      => \$opt_verbose,           # flag, multiple use allowed
                );

                #
                #   UPDATE THE DOCUMENTATION AT THE END OF THIS FILE !!!
                #

#-------------------------------------------------------------------------------
# Function        : Main entry point
#
# Description     : Parse user arguments
#                   Generate metrics
#
# Inputs          : None
#
# Returns         : Error code
#

#
#   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_manual || ($opt_help > 2));

ErrorConfig( 'name'    =>'DIRLIST',
             'verbose' => $opt_verbose,
            );

#
#   Ensure that we are in a suitable directory
#   Need to be in the project root directory
#
Verbose ("Locate project root directory");

#
#   Locate the base of the JATS build
#   This will be provided by Makefile.gbe
#
ReadMakeInfo();
my $interface_path = "$::ScmRoot/$::ScmInterface";

#
#   Read in all the makefile data in one hit
#
my $mfdata = JatsMakeConfigReader::GetAllMakeInfo();

#-------------------------------------------------------------------------------
#   Generate a list of known VOBS
#
    my %VOBS;
    my $cmd = "cleartool lsvob -short";
    open(CMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
    while (<CMD>)
    {
        #
        #   Filter output from the user
        #
        chomp;
        tr~\\/~/~s;
        s~^/[^/]/~/~;
        s~^/~~;
        s~^vobs/~~;                             # Unix vobs prefix
        Verbose("lsvob: $_");
        $VOBS{$_} = 1;
    }
    close(CMD);


#-------------------------------------------------------------------------------
#   Process all the constituent makefile data and buildup a list of source directories
#
foreach my $dir ( $mfdata->AllDirs() )
{
    my $mff = $mfdata->GetEntry($dir);

    Verbose ("Processing: $dir");

    #
    #   Add the location of the makefile
    #   This will include the root makefile - even if it doesn't exist
    #
    AddToList( $dir, '.' );
    

    foreach my $tgt ( $mff->GetPlatforms() )
    {
        my $cwd = $mff->GetDataItem($tgt, '$Cwd');
        Verbose( "Target: $tgt, CWD: $cwd\n");

        #
        #   Add the location of the makefile
        #
        AddToList( $cwd, '.' );

        #
        #   Locate all the sources
        #
        foreach my $var ( '%SRCS' )
        {
            if ( my $data = $mff->GetDataItem($tgt, $var) )
            {
                Verbose2( "$var : ", values %{$data});
                foreach my $file ( values %$data )
                {
                    my $dir = $file;
                    $dir =~ s~[^/]*$~~;
                    AddToList( $cwd, $dir );
                }
            }
        }

        #
        #   Locate all the included directories in case we need
        #   an exhaustive search of all header files
        #
        foreach my $var ( '@INCDIRS', '@SRCDIRS' )
        {
            if ( my $data = $mff->GetDataItem($tgt, $var) )
            {
                Verbose2( "$var : @{$data}");
                foreach my $dir ( @$data )
                {
                    AddToList( $cwd, $dir );
                }
            }
        }
    }
}

#-------------------------------------------------------------------------------
#   Display the results
#       Display directories that are within a VOB
#       Display directories not within a VOB
#       Warn if multiple VOBS have been found
#
my @no_vob;
my %vobs_used;
foreach ( sort keys %include )
{
    my $vob = $include{$_};
    push( @no_vob, $_ ) unless ( $vob );
    print "$_\n" if $vob;
    $vobs_used{$vob} = 1 if ( $vob );
}

if ( @no_vob )
{
    print "\nItems not located in a VOB\n";
    foreach (@no_vob )
    {
        print "    $_\n";
    }
}


my @vobs_used = sort keys %vobs_used;
my $vob_count = $#vobs_used + 1;

if ( $vob_count > 1 )
{
    print "\nWarning: Multiple VOBS used: @vobs_used\n";
}



#print Data::Dumper->Dump([\%include]);


#-------------------------------------------------------------------------------
# Function        : AddToList
#
# Description     : Add the specified directory to the list
#
# Inputs          : A directory
#
# Returns         : Nothing
#
sub AddToList
{
    my ($cwd, $dir) = @_;

    #
    #   Ignore paths that have a $(xxx) construct
    #
    return if ( $dir =~ m~\$\(~ );

    #
    #   Ignore entrires that have a drive letter
    #   These are external packages
    #
#    return if ( $dir =~ m~^\w\:~ );

    #
    #   Convert relative address into absolute address
    #

    $dir = $cwd . "/" . $dir unless ( $dir =~ m~^/~ || $dir =~ m~^\w\:~);
    $dir = CleanDirName( $dir );
    unless ( $include{$dir} )
    {
        my $vob = FindVob($dir);
        $include{$dir} = $vob;
        Verbose ("Adding dir: $dir");
    }
}

#-------------------------------------------------------------------------------
# Function        : FindVob
#
# Description     : Determine the VOB that contains a specified directory
#
# Inputs          : Directory
#
# Returns         : The name of the VOB that contains the directory
#
sub FindVob
{
    my($udir) = @_;

    #
    #   Split into parts
    #
    my @dirs = split( '/', $udir );
    foreach ( @dirs )
    {
        return $_
            if exists( $VOBS{$_} );
    }

    return undef;
}

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

=pod

=for htmltoc    SYSUTIL::

=head1 NAME

gen_metrics - Create Metrics

=head1 SYNOPSIS

 jats etool gen_metrics [options]

 Options:
    -help              - Brief help message
    -help -help        - Detailed help message
    -man               - Full documentation
    -verbose           - Verbose display of operation

=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-help -help>

Print a detailed help message with an explanation for each option.

=item B<-man>

Prints the manual page and exits.

=item B<-verbose>

Prints internal information during the execution of the script.

=back

=head1 DESCRIPTION

The program will Post process the JATS build and makefiles and generate a list
of directories that need to be labeled. It does this by examining all the source
files located in the generated makefiles.

=cut