Subversion Repositories DevTools

#! perl
########################################################################
# Copyright ( C ) 2004 ERG Limited, All rights reserved
#
# Module name   : extract_depends.pl
# Module type   : Makefile system
# Compiler(s)   : n/a
# Environment(s): jats
#
# Description   : Given a package name and version, this program will interogate
#                 the release manager database and create a directed graph of
#                 the packages depenancies - as described by the package entry.
#
# Usage:
#
# Version   Who      Date        Description
#
#......................................................................#

require 5.006_001;
use strict;
use warnings;
use Data::Dumper;
use Cwd;
use DeployUtils::RmPkgInfo;


#-------------------------------------------------------------------------------
#   Globals
#
my %packages;
my %required_packages;
my $root_package;
my @logs;

#-------------------------------------------------------------------------------
#   Extract package dependancy information
#
my  %Package;
my $ONLY_DISPLAY_ONCE = 1;

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

GetDepends (0, $ARGV[0], $ARGV[1] );

#-------------------------------------------------------------------------------
# Function        : GetDepends
#
# Description     :
#
# Inputs          : pkg_name
#                   pkg_ver
#
# Returns         :
#
sub GetDepends
{
    my ($level, $pkg_name, $pkg_ver ) = @_;

#    return
#        if ( defined($Package{$pkg_name}) );

    displayName( $level, $pkg_name, $pkg_ver );

    my $pkgInfo = $Package{$pkg_name}{$pkg_ver};
    unless ( defined $pkgInfo )
    {
        $pkgInfo = DeployUtils::RmPkgInfo->new( { PKG_NAME => $pkg_name , PKG_VERSION => $pkg_ver } );
        $Package{$pkg_name}{$pkg_ver} = $pkgInfo;
        if ( ! $pkgInfo->foundDetails() )
        {
            logit ("PACKAGE DETAILS NOT FOUND: $pkg_name $pkg_ver\n");
        }
    }
    else
    {
        return if ( $ONLY_DISPLAY_ONCE );
    }


    #
    #   Save package information
    #
    my $alias = $pkg_name . '_' . $pkg_ver;
    $root_package = $alias unless ( $root_package );

    $packages{$alias}{'name'} = $pkg_name;
    $packages{$alias}{'ext'}  = $pkg_ver;
    $packages{$alias}{'version'} = $pkg_ver;
    $packages{$alias}{'label'} = $alias;

    my @clean_depends;
    foreach my $depName ( $pkgInfo->getDependencyNames() )
    {
        my $depPkg = $pkgInfo->getDependencyObject($depName);
        my $depVer = $depPkg->pkg_version();

        # Skip some known packages
        next if ( $depName =~ m~^ant~ );
        next if ( $depName =~ m~^deployfiles~ );
        next if ( $depName =~ m~^ishieldlib~ );
        next if ( $depName =~ m~^Dinkumware~i );

        my $dalias = $depName . '_' . $depVer;
        push @clean_depends, $dalias;

        GetDepends( $level + 1, $depName, $depVer );
    }
    
    $packages{$alias}{'depends'} = \@clean_depends;
    $required_packages{$alias} = 1;

}

sub displayName
{
    my ($level, $name, $ver ) = @_;
    if ( $ONLY_DISPLAY_ONCE )
    {
        logit  ("Package $name $ver\n") unless $Package{$name};
    }
    else
    {
        logit  (' ' x ($level * 4), "Package $name $ver\n");
    }

}

#DebugDumpData ('Needed Packages', \%required_packages );

#
#   Display details of the required packages
#
print "Required Packages and versions\n";
my $filebase = $root_package;
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";

my @dep;

#delete $required_packages{$root_package};
#@dep =  sort keys %required_packages;
#print FH  "\t", pentry($root_package), " -> { ", plist(' ; ', @dep) ," }\n";

@dep = grep /^daf_/, @{$packages{$root_package}{'depends'}};;
#print FH "\t{rank=same; ", plist(' ', @dep) , "; }\n";

@dep = grep /^dac_/, @{$packages{$root_package}{'depends'}};;
#print FH "\t{rank=same; ", plist(' ', @dep) , "; }\n";

@dep = grep /cots$/, keys %required_packages;;
#print FH "\t{rank=max; ", plist(' ', @dep) , "; }\n";
print FH "\t{rank=min; ", pentry($root_package) , "; }\n";
print FH "\t{root=", pentry($root_package), "; }\n";


my @no_dep;
foreach my $alias ( sort keys %required_packages )
{
    my $name       = $packages{$alias}{'name'};
    my $ext        = $packages{$alias}{'ext'};
    my $version    = $packages{$alias}{'version'};
    my $label      = $packages{$alias}{'label'};

    print STDERR "ERROR: No name for: $alias\n" unless $name;
    print STDERR "ERROR: No version for: $alias\n" unless $version;

    my $deplist = $packages{$alias}{'depends'};
    print FH  "\t", pentry($alias)  ," -> { ", plist ( ' ; ', @{$deplist} ), " }\n";

    push @no_dep, $alias unless ( @{$deplist} );

    print FH "\t", pentry($alias), "[label=\"$label\"]\n";

}

#
#   Set rank on components with no dependancies
#
print FH "\t{rank=max; ", plist(' ', @no_dep) , "; }\n";

print FH "\n};\n";
close FH;

#
#   Write out logs
#
#unless ( $ONLY_DISPLAY_ONCE )
{
    open (FH, ">$filebase.txt" ) or die "Cannot open output";
    foreach  ( @logs )
    {
        print FH $_;
    }
    close FH;
}

#
#   Convert DOT to a SVG
#
print "Generating graphical images\n";
system( "dot $filebase.dot -Tjpg -o$filebase.jpg  -v" );
system( "dot $filebase.dot -Tsvg -o$filebase.svg  -v" );

print "\n";
print "Generated: $filebase.dot\n";
print "Generated: $filebase.jpg\n";
print "Generated: $filebase.svg\n";
print "Generated: $filebase.txt\n";


exit 0;


#-------------------------------------------------------------------------------
# Function        : log
#
# Description     : Log packages
#
# Inputs          : text
#
# Returns         : 
#
sub logit
{
    print @_;
    push @logs, "@_";
}


#-------------------------------------------------------------------------------
# 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  ( @_ )
    {
        $_ =~ s~\.~_~g;
        $result .= '"' . $_ . '"' . $pref;
    }
    return $result;
}

sub pentry
{

    my $result = "";
    foreach  ( @_ )
    {
        $_ =~ s~\.~_~g;
        $result .= '"' . $_ . '"'
    }
    return $result;
}

#-------------------------------------------------------------------------------
# Function        : DebugDumpData
#
# Description     : Display data structures
#
# Inputs          :
#
# Returns         :
#
sub DebugDumpData
{
    my ($name, @refp) = @_;

    my $ii = 0;
    foreach  ( @refp )
    {
        print Data::Dumper->Dump ( [$_], ["[Arg:$ii] $name" ]);
        $ii++
    }
}