Subversion Repositories DevTools

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

# Copyright ( C ) 2004 ERG Limited, 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;

}