Subversion Repositories DevTools

#! perl
########################################################################
# Copyright ( C ) 2004 ERG Limited, All rights reserved
#
# Module name   : extract_version_history.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 version history
#
#......................................................................#

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 $PNAME;
my $PVER;
my $EXT;
my $RM_DB;
my %VERSION_by_PVID;
my %NEXT;

#
#   Options
#
my $opt_help = 0;
my $opt_verbose = 0;
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        : getPkgDetailsByName
#
# Description     : Determine the PVID for a given package name and version
#
# Inputs          : $pname          - Package name
#                   $pver           - Package Version
#
# Returns         : PV_ID, PKG_ID
#

sub getPkgDetailsByName
{
    my ($pname, $pver) = @_;
    my $pv_id;
    my $pkg_id;
    my (@row);

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

    # First get details for a given package version

    my $m_sqlstr = "SELECT pv.PV_ID, pv.PKG_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];
                    $pkg_id = $row[1];
                    my $name = $row[2];
                    my $ver = $row[3];
                    Verbose( "getPkgDetailsByName :PV_ID= $pv_id, $pkg_id");
                }
            }
            else
            {
                Error ("No data");
            }
            $sth->finish();
        }
        else
        {
            Error ("Execute Error");
        }
    }
    else
    {
        Error("Prepare failure" );
    }
    return ($pv_id, $pkg_id);
}

#-------------------------------------------------------------------------------
# Function        : getAllVersions
#
# Description     : Exract all versions of a given package
#
# Inputs          : $pname          - Package name
#                   $pver           - Package Version
#                   $ext            - Extension
#
# Returns         : PV_ID, PKG_ID
#

sub getAllVersions
{
    my ($pv_id, $pkg_id, $ext) = @_;
    my (@row);

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

    # First get details for a given package version

    my $m_sqlstr = "SELECT pv.PV_ID, pv.LAST_PV_ID,  pv.PKG_VERSION" .
                    " FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv" .
                    " WHERE pv.PKG_ID = $pkg_id";# and v_ext='$ext'";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    my $pv_id = $row[0];
                    my $pv_last = $row[1];
                    my $ver = $row[2];

                    Verbose( "getAllVersions :$pv_id, $pv_last, $ver");
                    $VERSION_by_PVID{$pv_id} = $ver;
                    push @{$NEXT{$pv_last}},$pv_id;
                }
            }
            else
            {
                Error ("getAllVersions:No data");
            }
            $sth->finish();
        }
        else
        {
            Error ("getAllVersions:Execute Error");
        }
    }
    else
    {
        Error("getAllVersions:Prepare failure" );
    }
}

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


#-------------------------------------------------------------------------------
# Function        : Main
#
# Description     :
#
# Inputs          :
#
# Returns         :
#

ErrorConfig( 'name'    =>'ExtractVer',
             'verbose' => $opt_verbose );

#
#   Determine root package
#
unless ( $ARGV[0] && $ARGV[1] )
{
    print "Specify a package as 'name' 'version'\n";
    exit;
}
$PNAME = $ARGV[0];
$PVER = $ARGV[1];
my $PV_ID;
my $PKG_ID;
$PVER =~ m~(\.[a-z]+)$~;
$EXT = $1;

($PV_ID, $PKG_ID) = getPkgDetailsByName( $PNAME, $PVER );
print "Pkg: $PV_ID, $PKG_ID, $EXT\n";
getAllVersions( $PV_ID, $PKG_ID, $EXT );

#DebugDumpData("Next", \%NEXT );


my $filebase = "${PNAME}_vtree";
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 ( keys(%NEXT) )
{
    my $ref = $NEXT{$entry};
    my @data;
    foreach my $pvid (@{$ref} )
    {
        push @data, $VERSION_by_PVID{$pvid};
    }
    print FH "\t", pentry($VERSION_by_PVID{$entry})  ," -> { ", plist ( ' ; ', @data ), " }\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";



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