Subversion Repositories DevTools

Rev

Rev 2026 | Blame | Compare with Previous | Last modification | View Log | RSS feed 

#! perl
########################################################################
# Copyright ( C ) 2004 ERG Limited, 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 Sydney Release-1
#
#                 Creates .dot files to display the dependancy tree
#
#                  Basis for extract program used elsewhere.
#
# Usage:
#
# Version   Who      Date        Description
#
#......................................................................#

require 5.006_001;
use strict;
use warnings;
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 $opt_verbose = 1;

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;

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] || '';

#                    next if ( $ver =~ /syd$/i );
#                    next if ( $ver =~ /cr$/i );
#                    next if ( $ver =~ /mas$/i );
#                    next unless ( $ver =~ /cots$/i );

                    $path =~ tr~\\/~/~s;
#                    next if ( $path =~ m~^/~  );
#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        : getRtagId
#
# Description     : Given a release name, determine the RTAG_ID
#
# Inputs          :
#
# Returns         :
#
sub getRtagId
{
    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 rt.RTAG_ID, rt.RTAG_NAME, rt.DESCRIPTION, pj.PROJ_ID, pj.PROJ_NAME, rt.OFFICIAL FROM RELEASE_MANAGER.RELEASE_TAGS rt, RELEASE_MANAGER.PROJECTS pj WHERE rt.PROJ_ID = pj.PROJ_ID ORDER BY pj.PROJ_NAME";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    printf "%20s, %8s(%s), %40s\n", $row[4], $row[0], $row[5], $row[1];
                }
            }
            $sth->finish();
        }
    }
    else
    {
        Error("Prepare failure" );
    }

    disconnectDB();
    exit;
}


#-------------------------------------------------------------------------------
# Function        : GetDepends
#
# Description     :
#
# Inputs          : 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 ($rp) = keys %{$ReleasePackages{$pn}{$pp}};
#                    $BuildPackages{$pn}{$pp} = $rp;

                    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        : Main
#
# Description     :
#
# Inputs          :
#
# Returns         :
#

ErrorConfig( 'name'    =>'PLAY10' );

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


#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

#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 );


#DebugDumpData( "START", \$ReleasePackages{$ARGV[0] });
my $pv_id = $ReleasePackages{$ARGV[0]}{$ARGV[1]};
#DebugDumpData ("UsedBy:$pv_id", \$UsedBy{$pv_id} ); exit(1);

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} );
        }
    }
}

$AllUsedBy{$pv_id} = 1;
AddUsedBy( $UsedBy{$pv_id} );
#DebugDumpData ("AllUsedBy", \%AllUsedBy );


my $filebase = "$ARGV[0]_$ARGV[1]_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($pv_id), "; }\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  -v" );
system( "dot $filebase.dot -Tsvg -o$filebase.svg  -v" );

#
#   Complete used-by tree
#
##foreach my $entry ( sort 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");
##
##}

#
#   Directly used by
#
#DebugDumpData ("UsedBy:$pv_id", \$UsedBy{$pv_id} ); exit(1);
foreach my $entry ( sort @{$UsedBy{$pv_id}} )
{
     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 -root=. $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;
}