Subversion Repositories DevTools

#! perl

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

# COPYRIGHT - VIX IP PTY LTD ("VIX"). 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";

# End of diagraph

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

    }

}