Subversion Repositories DevTools

########################################################################

# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.

#

# Module name   : jats.sh

# Module type   : Makefile system

# Compiler(s)   : n/a

# Environment(s): jats

#

# Description   : For a given Package + Version display the complete upward (used-by)

#                 dependancy tree

#

#                 Currently hard coded to a Release

#

#                 Creates .dot files to display the dependancy tree

#

# Usage         :   Package_name/Version pairs

#                   The first one is usd as the base

#                   Others name/version pairs onthe command line will also be

#                   added to the picture

#

#......................................................................#

require 5.006_001;

use strict;

use warnings;

use Pod::Usage;

use Getopt::Long;

use JatsError;

use JatsVersionUtils;

use JatsRmApi;

#use Data::Dumper;

use DBI;

use Cwd;

my $GBE_PERL     = $ENV{'GBE_PERL'};        # Essential ENV variables

my $GBE_CORE     = $ENV{'GBE_CORE'};

my %ReleasePackages;            # Packages in the release

my %BuildPackages;              # Packages for this build

my %Depends;

my %UsedBy;

my %Packages;

my $RM_DB;

my %GDATA;

my %GINDEX;

my $PNAME;

my $PVER;

my @ROOT_PVIDS;

#

#   Options

#

my $opt_help = 0;

my $opt_verbose = 0;

my $opt_rtagid;

my $opt_show_extract = 0;

my $result = GetOptions (

                "help|h:+"          => \$opt_help,

                "manual:3"          => \$opt_help,

                "verbose:+"         => \$opt_verbose,       # flag or number

                "rtagid|rtag_id=s"  => \$opt_rtagid,

                "show:+"            => \$opt_show_extract,

                );

#

#   Process help and manual options

#

pod2usage(-verbose => 0)  if ($opt_help == 1  || ! $result);

pod2usage(-verbose => 1)  if ($opt_help == 2);

pod2usage(-verbose => 2)  if ($opt_help > 2);

#-------------------------------------------------------------------------------

# Function        : getPkgDetailsByRTAG_ID

#

# Description     : Given an rtag_id, get details on all packages in the release

#

# Inputs          : rtag_id

#

# Returns         : 

#

sub getPkgDetailsByRTAG_ID

{

    my ($RTAG_ID) = @_;

    my $foundDetails = 0;

    my (@row);

    # if we are not or cannot connect then return 0 as we have not found anything

    connectRM(\$RM_DB) unless ( $RM_DB );

    # First get details from pv_id

    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION, pv.PKG_LABEL, pv.SRC_PATH, pv.BUILD_TYPE" .

                    " FROM RELEASE_MANAGER.RELEASE_CONTENT rc, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .

                    " WHERE rc.RTAG_ID = $RTAG_ID AND rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";

    my $sth = $RM_DB->prepare($m_sqlstr);

    if ( defined($sth) )

    {

        if ( $sth->execute( ) )

        {

            if ( $sth->rows )

            {

                while ( @row = $sth->fetchrow_array )

                {

                    my %DATA;

                    my $pvid = $DATA{pv_id}  = $row[0];

                    my $name = $DATA{name}   = $row[1];

                    my $ver = $DATA{version} = $row[2];

                    my $label = $DATA{label} = $row[3] || '';

                    my $path = $DATA{path}   = $row[4] || '';

                    $path =~ tr~\\/~/~s;

#print "$row[5] --";

#printf ( "%40s %15s %50s %s\n",  $name, $ver, $label, $path);

                    $GDATA{$pvid} = (\%DATA);

                    my ( $pn, $pv, $pp ) = SplitPackage( $name, $ver );

                    $GINDEX{"$pn.$pp"} = $pvid;

                }

            }

            $sth->finish();

        }

        else

        {

            Error("Execute failure");

        }

    }

    else

    {

        Error("Prepare failure" );

    }

}

#-------------------------------------------------------------------------------

# Function        : GetDepends

#

# Description     : Given an pv_id

#

# Inputs          : pv_id

#                   pkg_name

#                   pkg_ver

#

# Returns         :

#

sub GetDepends_pvid

{

    my (@row);

    my ($pv_id, $name, $version) = @_;

    my ( $pn, $pv, $pp ) = SplitPackage( $name, $version );

    my $ukey = "$pn.$pp";

    $ReleasePackages{$name}{$version} = $ukey;

    $Packages{$ukey} = "$name.$version";

    # if we are not or cannot connect then return 0 as we have not found anything

    connectRM(\$RM_DB) unless ( $RM_DB );

    #   Now extract the package dependacies

    #

    my $m_sqlstr = "SELECT pkg.PKG_NAME, pv.PKG_VERSION, pd.DPV_ID" .

                   " FROM RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .

                   " WHERE pd.PV_ID = \'$pv_id\' AND pd.DPV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";

    my $sth = $RM_DB->prepare($m_sqlstr);

    if ( defined($sth) )

    {

        if ( $sth->execute( ) )

        {

            if ( $sth->rows )

            {

                while ( @row = $sth->fetchrow_array )

                {

#print ( "DATA: " . join(',', @row) . "\n");

                    my $dpv_id = $row[2];

                    my ( $pn, $pv, $pp ) = SplitPackage( $row[0], $row[1] );

                    my $key = "$pn.$pp";

                    my @data = ( $key, $dpv_id, $pn, "$pv.$pp" );

                    push @{$Depends{$ukey}}, \@data;

                    push @{$UsedBy{$key}}, $ukey;

#                    print  ' ' x 4, "$pn $pv $pp";

#                    if ( $rp ne $pv )

#                    {

#                        print "  ----- Package not in release. Needs $rp";

#                    }

#                    print "\n";

                }

            }

            $sth->finish();

        }

    }

    else

    {

        Error("GetDepends:Prepare failure" );

    }

}

#-------------------------------------------------------------------------------

# Function        : getPkgDetailsByName

#

# Description     : Determine the PVID for a given package name and version

#

# Inputs          : $pname          - Package name

#                   $pver           - Package Version

#

# Returns         : PV_ID

#

sub getPkgDetailsByName

{

    my ($pname, $pver) = @_;

    my $pv_id;

    my (@row);

    connectRM(\$RM_DB) unless ($RM_DB);

    # First get details for a given package version

    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION" .

                    " FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .

                    " WHERE pkg.PKG_NAME = \'$pname\' AND pv.PKG_VERSION = \'$pver\' AND pv.PKG_ID = pkg.PKG_ID";

    my $sth = $RM_DB->prepare($m_sqlstr);

    if ( defined($sth) )

    {

        if ( $sth->execute( ) )

        {

            if ( $sth->rows )

            {

                while ( @row = $sth->fetchrow_array )

                {

                    $pv_id = $row[0];

                    my $name = $row[1];

                    my $ver = $row[2];

                    Verbose( "getPkgDetailsByName :PV_ID= $pv_id");

                }

            }

            $sth->finish();

        }

    }

    else

    {

        Error("Prepare failure" );

    }

    return $pv_id;

}

#-------------------------------------------------------------------------------

# Function        : AddUsedBy

#

# Description     : 

#

# Inputs          : 

#

# Returns         : 

#

my %AllUsedBy;

sub AddUsedBy

{

    my ($ref) = @_;

    foreach my $entry ( @$ref )

    {

#print "Adding: $entry\n";

        if ( ! exists($AllUsedBy{$entry}) )

        {

#print "     New Adding: $entry\n";

            $AllUsedBy{$entry} = 1;

#DebugDumpData ("UsedBy", \$UsedBy{$entry} );

            AddUsedBy( $UsedBy{$entry} );

        }

    }

}

#-------------------------------------------------------------------------------

# Function        : Main

#

# Description     :

#

# Inputs          :

#

# Returns         :

#

ErrorConfig( 'name'    =>'ExtractUses',

             'verbose' => $opt_verbose );

#

#

#

unless ( $opt_rtagid )

{

    Error ("Must supply -rtag_id, Try -rtag_id=16243");

}

#

#   Determine root package

#

unless ( $ARGV[0] && $ARGV[1] )

{

    print "Specify a package as 'name' 'version'\n";

    exit;

}

$PNAME = $ARGV[0];

$PVER = $ARGV[1];

#getPkgDetailsByRTAG_ID(2301);           # 2301 : Seattle I7

#getPkgDetailsByRTAG_ID(2362);           # 2362 : Syd Release 1

#getPkgDetailsByRTAG_ID(1861);           # 1861 : Syd Release Legacy

#getPkgDetailsByRTAG_ID(3462);           # 3462 : Beijing Release 1

#getPkgDetailsByRTAG_ID(5162);           # 5162 : NZS TP5600

#getPkgDetailsByRTAG_ID(16243);          # 16243 : VTK

getPkgDetailsByRTAG_ID($opt_rtagid);

#DebugDumpData("GDATA", \%GDATA);

foreach my $pv_id ( keys %GDATA )

{

    my $pkg = \%{$GDATA{$pv_id}};

#    print "Processing: $pkg->{'name'}\n";

    GetDepends_pvid( $pv_id, $pkg->{'name'}, $pkg->{'version'} );

}

#DebugDumpData ("BuildPackages", \%BuildPackages );

#DebugDumpData ("ReleasePackages", \%ReleasePackages );

#DebugDumpData ("Depends", \%Depends );

#DebugDumpData ("UsedBy", \%UsedBy );

while ( $#ARGV >= 1 )

{

    #DebugDumpData( "START", \$ReleasePackages{$ARGV[0] });

    my $pv_id = $ReleasePackages{$ARGV[0]}{$ARGV[1]};

    Error ("Package not found: $ARGV[0] $ARGV[1]") unless ( $pv_id );

    #DebugDumpData ("UsedBy:$pv_id", \$UsedBy{$pv_id} ); exit(1);

    push @ROOT_PVIDS, $pv_id;

    $AllUsedBy{$pv_id} = 1;

    AddUsedBy( $UsedBy{$pv_id} );

    shift @ARGV;

    shift @ARGV;

}

if ( $#ARGV >= 0 )

{

    Error("Args shoud be name-version pairs. Appears to be a one short");

}

#DebugDumpData ("AllUsedBy", \%AllUsedBy );

my $filebase = "${PNAME}_${PVER}_usedby";

open (FH, ">$filebase.dot" ) or die "Cannot open output";

print FH "digraph world {\n";

print FH "\trankdir=LR;\n";

print FH "\tnode[fontsize=24];\n";

print FH "\t{rank=min; ", pentry(@ROOT_PVIDS) , "; }\n";

print FH "\t{root=", pentry($ROOT_PVIDS[0]), "; }\n";

foreach my $entry ( sort keys(%AllUsedBy) )

{

    my $ref = $UsedBy{$entry};

    print FH "\t", pentry($entry)  ," -> { ", plist ( ' ; ', @{$ref} ), " }\n";

}

print FH "\n};\n";

close FH;

#

#   Convert DOT to a SVG

#

system( "dot $filebase.dot -Tjpg -o$filebase.jpg" );

system( "dot $filebase.dot -Tsvg -o$filebase.svg" );

print "Generated: $filebase.dot\n";

print "Generated: $filebase.jpg\n";

print "Generated: $filebase.svg\n";

#

#   Complete used-by tree

#

##foreach my $entry ( keys(%AllUsedBy) )

##{

##     my $pvid = $GINDEX{$entry};

###     print "$entry, $pvid\n";

##    my $pkg = \%{$GDATA{$pvid}};

##

##    my $label = $pkg->{label};

##    my $path = $pkg->{path};

##    $path =~ tr~\\/~/~s;

###    printf ( "%40s %15s %50s %s\n",  $pkg->{name}, $pkg->{version}, $pkg->{label}, $path);

##    print ( "jats extract $label -path=$path\n");

##

##}

if ( $opt_show_extract )

{

    my @entries;

    #

    #   Directly used by

    #

    #DebugDumpData ("UsedBy:$pv_id", \$UsedBy{$pv_id} ); exit(1);

    if ( $opt_show_extract > 1 )

    {

        @entries = keys(%AllUsedBy)

    }

    else

    {

        my %directly_used;

        foreach my $pv_id ( @ROOT_PVIDS )

        {

            foreach my $entry ( @{$UsedBy{$pv_id}} )

            {

                $directly_used{$entry} = 1;

            }

        }

        @entries = keys (%directly_used);

    }

    foreach my $entry ( @entries )

    {

         my $pvid = $GINDEX{$entry};

    #     print "$entry, $pvid\n";

        my $pkg = \%{$GDATA{$pvid}};

        my $label = $pkg->{label};

        my $path = $pkg->{path};

        $path =~ tr~\\/~/~s;

    #    printf ( "%40s %15s %50s %s\n",  $pkg->{name}, $pkg->{version}, $pkg->{label}, $path);

        print ( "jats extract $label -path=$path\n");

    }

}

exit;

#-------------------------------------------------------------------------------

# Function        : plist

#

# Description     : Generate an entry list as text

#                   Replace "." with "_" since DOT doesn't like .'s

#                   Seperate the arguments

#

# Inputs          : $pref       - Prefix string

#                   @_          - An array of entries to process

#

# Returns         : A string

#

sub plist

{

    my $pref = shift;

    my $result = "";

    foreach  ( @_ )

    {

        my $x = $_;

        $x =~ s~\.~_~g;

        $result .= '"' . $x . '"' . $pref;

    }

    return $result;

}

sub pentry

{

    my $result = "";

    foreach  ( @_ )

    {

        my $x = $_;

        $x =~ s~\.~_~g;

        $result .= '"' . $x . '"'

    }

    return $result;

}

#-------------------------------------------------------------------------------

#   Documentation

#

=pod

=head1 NAME

jats etool extract_uses - Graph build dependencies

=head1 SYNOPSIS

  jats etool extract_uses [options] PackageName/Version Pairs

 Options:

    -help               - brief help message

    -help -help         - Detailed help message

    -man                - Full documentation

    -verbose            - Verbose operation

    -rtag=nnn           - Release Tag

    -show               - Show 'jats extract' commands

=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>

Increases program output. This option may be specified multiple times

This option specifies the Release, within the Release Manager Database, that will

be used to update the build dependency file.

The Release Tag is provided by the Release Manager Web Page, or by the -Show option

of this utility.

=back

=head1 DESCRIPTION

This utilty will display the dependency tree for packages used by the specified

packages.

=cut