Subversion Repositories DevTools

Rev

Rev 2026 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed 

########################################################################
# Copyright (c) VIX TECHNOLOGY (AUST) LTD
#
# 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
                "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_pvid
#
# 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        : GetUsesBy_pvid
#
# Description     : Given an pv_id determine the packages that use this
#                   package.
#
#                   Also determine the package name and package version
#
# Inputs          : pv_id
#
# Returns         :
#
sub GetUsesBy_pvid
{
    my (@row);
    my ($pv_id) = @_;
print "Processing for: $pv_id \n";
    # 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.PV_ID" .
                   " FROM RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .
                   " WHERE pd.DPV_ID = \'$pv_id\' AND pd.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 )
                {
print ( "DATA: " . join(',', @row) . "\n");
                }
            }
            $sth->finish();
        }
    }
    else
    {
        Error("GetUsesBy_pvid: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' );

#
#   Determine root package
#
unless ( $ARGV[0] && $ARGV[1] )
{
    print "Specify a package as 'name' 'version'\n";
    exit;
}
$PNAME = $ARGV[0];
$PVER = $ARGV[1];

#
#   For each required package-version
#   Determine the packages pv_id
#
while ( $#ARGV >= 1 )
{
    my $pv_id = getPkgDetailsByName($ARGV[0], $ARGV[1]);
    Error ("Package not found: $ARGV[0] $ARGV[1]") unless ( $pv_id );

    push @ROOT_PVIDS, $pv_id;
    shift @ARGV;
    shift @ARGV;
}

#
#   For each known PVID
#   Determine the package details
#
foreach my $pv_id ( @ROOT_PVIDS )
{
    GetUsesBy_pvid($pv_id);
}
Error ("Only got this far");


#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_id1 = getPkgDetailsByName($ARGV[0], $ARGV[1]);
    my $pv_id = $ReleasePackages{$ARGV[0]}{$ARGV[1]};

print "---- $pv_id, $pv_id1\n";

    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{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" );

#
#   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 )
{
    #
    #   Directly used by
    #
    #DebugDumpData ("UsedBy:$pv_id", \$UsedBy{$pv_id} ); exit(1);

    my %directly_used;
    foreach my $pv_id ( @ROOT_PVIDS )
    {
        foreach my $entry ( @{$UsedBy{$pv_id}} )
        {
            $directly_used{$entry} = 1;
        }
    }

    foreach my $entry ( keys (%directly_used) )
    {
         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