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