Subversion Repositories DevTools

########################################################################
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
#
# Module name   : jats.sh
# Module type   : Makefile system
# Compiler(s)   : n/a
# Environment(s): jats
#
# Description   : Get package information
#                 for a package name and version as specified on the
#                 command line.
#
#                 Determine the package id
#                 Locate all packages that have the same package name
#                 Create a hash of previous versions
#                 Create a JPG showing the version history
#
#......................................................................#

require 5.006_001;
use strict;
use warnings;
use JatsError;
use JatsRmApi;


#use Data::Dumper;
use Cwd;
use DBI;
use Getopt::Long;
use Pod::Usage;                             # required for help support
my $RM_DB;

my $opt_package;

################################################################################
#   Global data
#
my $VERSION = "1.0.0";
my %ReleasePackages;            # Packages in the release
my %BuildPackages;              # Packages for this build
my $last_pv_id;
my $pkg_id;
my %versions;
my %suffixes;
my @startPoints;
my @endPoints;


#
#   Options
#
my $opt_help = 0;
my $opt_manual = 0;
my $opt_verbose = 0;
my $opt_flat;

my $result = GetOptions (
                "help+"     => \$opt_help,          # flag, multiple use allowed
                "manual"    => \$opt_manual,        # flag
                "verbose+"  => \$opt_verbose,       # flag
                "flat!"     => \$opt_flat,          # Flat structure
                );

#
#   Process help and manual options
#
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
pod2usage(-verbose => 1)  if ($opt_help == 2 );
pod2usage(-verbose => 2)  if ($opt_manual || ($opt_help > 2));

#
#   Configure the error reporting process now that we have the user options
#
ErrorConfig( 'name'    =>'PLAY9c',
             'verbose' => $opt_verbose );

unless ( $ARGV[0] )
{
    Error( "Specify a package as 'name'" );
}
$opt_package = $ARGV[0];
Verbose( "Base Package: $opt_package");

#
#   Body of the process
#
GetPkgIdByName ( $opt_package );
GetData_by_pkg_id ( $pkg_id );
MassageData();

DebugDumpData ("Versions", \%versions );
DebugDumpData ("Starts", \@startPoints );
DebugDumpData ("Ends", \@endPoints );
#DebugDumpData ("Suffixes", \%suffixes );

#
#   Ordered by PVID. Which will be creation date
#   as they are created sequentially.
#
#foreach my $entry (sort {$versions{$a}{version} cmp $versions{$b}{version}} keys(%versions) )
#{
#    print GetVname($entry)," $versions{$entry}{version}\n";
#}


my $filebase = "$ARGV[0]_versions";
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";

sub GetVname
{
    my ($entry) = @_;
    my $me = $versions{$entry}{vname};
    unless ( $me )
    {
        $me = 'Unknown-' . $entry;
    }
    return $me;
}

if ( $opt_flat )
{
    my $last = 0;
    foreach my $entry (sort {$versions{$a}{version} cmp $versions{$b}{version}} keys(%versions) )
    {
print "-- $entry, $versions{$entry}{version}, $versions{$entry}{vname}\n";
        if ( $last )
        {
            my $me = GetVname($last);
            print FH "\t", pentry($me)  ," -> { ", plist ( ' ; ', GetVname( $entry) ), " }\n";
            print FH "\t", pentry($me)  ,"[label=\"$me\\n$last\"];\n";
        }
        $last = $entry;
    }
}
else
{
    foreach my $entry ( sort keys(%versions) )
    {
        my @versions;
        my $me = GetVname($entry);
        my $distanceCount = $versions{$entry}{distance};
        foreach ( @{ $versions{$entry}{next}} )
        {
            push @versions, GetVname( $_);
        }

        print FH "\t", pentry($me)  ," -> { ", plist ( ' ; ', @versions ), " }\n";
        print FH "\t", pentry($me)  ,"[label=\"$versions{$entry}{vname}\"];\n";
 #       print FH "\t", pentry($me)  ,"[label=\"$me\\n$distanceCount\\n$entry\"];\n";
        print FH "\t", pentry($me)  ,"[shape=rectangle];\n" if ($versions{$entry}{main});
    #    print FH "\t", pentry($me)  ,"[shape=circle];\n" if ($versions{$entry}{main});
        print FH "\t", pentry($me)  ,"[shape=octagon];\n" if ($versions{$entry}{branchPoint});
        print FH "\t", pentry($me)  ,"[shape=invhouse];\n" if ($versions{$entry}{newSuffix});

    }
}


print FH "\n};\n";
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

#
#   Display a list of terminal packages
#   These are packages that are not used by any other package
#
print "\n";
print "Generated: $filebase.dot\n";
print "Generated: $filebase.jpg\n";
print "Generated: $filebase.svg\n";


exit 0;


#-------------------------------------------------------------------------------
# Function        : MassageData
#
# Description     : 
#
# Inputs          : 
#
# Returns         : 
#
my %seenSuffixes;
sub MassageData
{
    #
    #   Process the 'versions' hash and:
    #   Add back references
    #   Find starts and ends
    #       Entry with no previous
    #       Entry with no next
    #
    foreach my $entry ( keys(%versions) )
    {
        foreach ( @{ $versions{$entry}{next}} )
        {
            $versions{$_}{last} = $entry;
        }
    }
    foreach my $entry ( keys(%versions) )
    {
        push @startPoints, $entry
            unless ( exists $versions{$entry}{last} );

        push @endPoints, $entry
            unless ( @{$versions{$entry}{next}} > 0  )
    }

    #
    #   Walk each starting point list and determine new Projects
    #
    foreach my $entry ( @startPoints )
    {
        processBranchLists($entry);

        sub processBranchLists
        {
            foreach my $entry ( @_ )
            {
                my $s = $versions{$entry}{suffix};
                unless ( exists $seenSuffixes{$s} )
                {
                    $seenSuffixes{$s} = 1;
                    $versions{$entry}{branchPoint} = 1;
                    $versions{$entry}{newSuffix} = 1;
                }
                processBranchLists (@{$versions{$entry}{next}});
            }
        }
    }

    #
    #   For each leaf ( end point ), walk backwards and mark each node with the
    #   distance from the end. If we get to a node which already has been marked then
    #   stop if our length is less. We want the value to be the longest distance to
    #   a leaf
    #
    my $distanceCount;
    foreach my $entryPoint ( @endPoints )
    {
        $distanceCount = 0;
        my $entry = $entryPoint;
        while ( $entry )
        {
            if ( defined $versions{$entry}{distance} )
            {
                if ( $versions{$entry}{distance} > $distanceCount )
                {
                    last;
                }
            }
            $versions{$entry}{distance} = $distanceCount++;
            $entry = $versions{$entry}{last};
        }
    }

    #
    #   Locate all instances where a package-version branches
    #   Determine the version that should be on the non-branching path
    #
    #   Reorder the 'next' list so that the first item is the non-branching
    #   path. This will be used in the data-insertion phase to simplify the
    #   processing.
    #
    foreach my $entry ( sort keys(%versions) )
    {
        my @next = @{$versions{$entry}{next}};
        my $count = @next;
        my @ordered;
        my $main;

        if ( $count > 0 )
        {
            my %nexts = map { $_ => 1 } @next;
            foreach my $e ( @next )
            {
                #
                #   Remove those that already have a branch
                #
                if ( $versions{$e}{branchPoint} || $versions{$e}{newSuffix}  )
                {
                    push @ordered, $e;
                    delete $nexts{$e};
                }
            }

            #
            #   Select longest arm as the non-branching path
            #
            my $count = -1;
            my $countEntry;
            foreach my $e ( sort keys %nexts )
            {
                if ( $versions{$e}{distance} > $count )
                {
                    $count = $versions{$e}{distance};
                    $countEntry = $e;
                }
            }
            if ($countEntry)
            {
                $main = $countEntry;
                delete $nexts{$countEntry};
            }

            #
            #   Mark remaining as non-main
            #
            foreach my $e ( keys %nexts )
            {
                push @ordered, $e;
                $versions{$e}{branchPoint} = 1;
            }

            #
            #   Re-order 'next' so that the main path is first
            #
            @ordered = sort @ordered;
            unshift @ordered, $main if ( $main );
            @{$versions{$entry}{next}} = @ordered;
        }
    }
}

#-------------------------------------------------------------------------------
# Function        : GetPkgIdByName
#
# Description     :
#
# Inputs          : pkg_name
#
# Returns         :
#
sub GetPkgIdByName
{
    my ( $pkg_name ) = @_;
    my (@row);
    my $pv_id;

    #
    #   Establish a connection to Release Manager
    #
    connectRM(\$RM_DB) unless ( $RM_DB );

    #
    #   Extract data from Release Manager
    #
    my $m_sqlstr = "SELECT pkg.PKG_NAME, pkg.PKG_ID" .
                   " FROM RELEASE_MANAGER.PACKAGES pkg" .
                   " WHERE pkg.PKG_NAME = \'$pkg_name\'";
                   
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    Verbose( "DATA: " . join(',', @row) );
                    $pkg_id = $row[1] || 0;
                    last;
                }
            }
            else
            {
                Warning("GetPkgIdByName:No Data for: $pkg_name");
            }
            $sth->finish();
        }
    }
    else
    {
        Error("GetPkgIdByName:Prepare failure" );
    }
}

#-------------------------------------------------------------------------------
# Function        : GetData_by_pkg_id
#
# Description     :
#
# Inputs          : pv_id
#
# Returns         :
#
sub GetData_by_pkg_id
{
    my ( $pkg_id ) = @_;
    my (@row);

    #
    #   Establish a connection to Release Manager
    #
    connectRM(\$RM_DB) unless ( $RM_DB );

    #
    #   Extract data from Release Manager
    #
    my $m_sqlstr = "SELECT pkg.PKG_NAME, pv.PKG_VERSION, pkg.PKG_ID, pv.PV_ID, pv.LAST_PV_ID, pv.CREATED_STAMP, release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID)".
                   " FROM RELEASE_MANAGER.PACKAGES pkg, RELEASE_MANAGER.PACKAGE_VERSIONS pv" .
                   " WHERE pv.PKG_ID = \'$pkg_id\' AND pkg.PKG_ID = pv.PKG_ID";
                   
                   
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    Verbose( "DATA: " . join(',', @row) );
                    my $pkg_name = $row[0] || 'Unknown';
                    my $pkg_ver = $row[1] || 'Unknown';
                    my $pv_id = $row[3] || 'Unknown';
                    my $last_pv_id = $row[4] || 'Unknown';
                    my $created =  $row[5] || 'Unknown';
                    my $vcstag =  $row[6] || 'Unknown';
                    print "$pkg_name, $pkg_ver, $pv_id, $last_pv_id, $created\n";

                    #
                    #   Add data to the hash
                    #       Remove entries that address themselves
                    #
                    push (@{$versions{$last_pv_id}{next}}, $pv_id) unless ($pv_id == $last_pv_id) ;
                    $versions{$pv_id}{vname} = $pkg_ver;
                    $versions{$pv_id}{vcsTag} = $vcstag;

                    #
                    #   Convert version into full form for comparisions
                    #
                    my $version = $pkg_ver;
                    my $suffix;
                    if ( $version =~ m~(\d+)\.(\d+)\.(\d+)(\.(.*))?~ )
                    {
                        my $patch = $3;
                        my $build = '000';
                        if ( length( $patch) >= 4 )
                        {
                            $build = substr( $patch, -3 ,3);
                            $patch = substr( $patch,  0 ,length($patch)-3);
                        }

                        $version = sprintf("%3.3d.%3.3d.%3.3d.%3.3d%s", $1,$2,$patch,$build,$4 || '.0000');
                        $suffix = $4 || '';
                    }
                    elsif ( $version =~ m~(.*)\.cots$~ ) {
                        my $cots_base = $1;
                        $suffix = '.cots';
                        unless ( $version =~ m~(.*)(\.[0-9]4)\.cots~ )
                        {
                            $version = $cots_base . '.0000.cots';
                        }
                    }
                    else
                    {
                        $pkg_ver =~ m~(\.\w+)$~;
                        $suffix = $1 || '';
                    }
                    $versions{$pv_id}{version} = $version;

                    #
                    #   Process suffix
                    #
                    $suffix = 'Unknown' unless ( $suffix );
                    $suffix = lc ($suffix);
                    $versions{$pv_id}{suffix} = $suffix;
                    push @{$suffixes{$suffix}}, $pv_id;

#                    if ( $suffix eq '.syd' )
#                    {
#                        delete $versions{$pv_id};
#                    }

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

sub pentry
{

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