WebSVN – DevTools – /core_devl/trunk/TOOLS/LOCAL/jats_rm_play06.pl

#! perl
########################################################################
# 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   : Proto type for package ripple
#                 Needs CWD = sandbox with build.pl
#                 Needs command - package name and version
#                 Assumes Sydney Release-1 as an RTAG_ID
#
#                 Will create an auto.pl file
#
# Usage:
#
# Version   Who      Date        Description
#
#......................................................................#

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

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

my $GBE_PERL     = $ENV{'GBE_PERL'};        # Essential ENV variables
my $GBE_CORE     = $ENV{'GBE_CORE'};
my $RM_DB;

################################################################################
#   Global data
#
my $VERSION = "1.0.0";
my %ReleasePackages;            # Packages in the release
my %BuildPackages;              # Packages for this build
my $base_name;
my $base_version;


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

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

#
#   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'    =>'PLAY6',
             'verbose' => $opt_verbose );

unless ( $ARGV[0] && $ARGV[1] )
{
    Error( "Specify a package as 'name' 'version'" );
}
$base_name = $ARGV[0];
$base_version = $ARGV[1];
Verbose( "Base Package: $base_name, $base_version");

#
#   Create a hash of all the packages in the current release
#       Need this generate basis for WIP labels
#       Need this to create current versions
#
#getPkgDetailsByRTAG_ID ( 2362 );                    # Sydney Release-1
getPkgDetailsByRTAG_ID ( 2301 );                    # Seattle I7
#getPkgDetailsByRTAG_ID ( 2102 );                    # Sydney Future
#getPkgDetailsByRTAG_ID ( 1861 );                    # Sydney Legacy

#
#   Assume that we need to ripple the current build version
#   Generate a new build version. The package may be a WIP
#
my ($pkg_name, $pkg_ver, $pkg_proj ) = NextBuildVersion( $base_name, $base_version ,'r' );

#
#   Body of the process
#
GetDepends ( $base_name, $base_version );

#
#   Create a configuration file for use by the JATS rewrite tool
#   This will allow the build.pl file to be re-written
#
my $file = "jats_rewrite.cfg";
open CFG, ">$file" || Error("Cannot create $file" );
print CFG "${pkg_name} ${pkg_ver}.${pkg_proj}\n";

foreach my $pkg ( keys %BuildPackages )
{
    foreach my $prj ( keys %{$BuildPackages{$pkg}} )
    {
        my $ver = $BuildPackages{$pkg}{$prj};
        print CFG "${pkg} ${ver}.${prj}\n";
    }
}
close CFG;

#
#   Massage the build.pl file to create the auto.pl file
#   That will be used to create the final package.
#
JatsTool ("jats_rewrite.pl", "-conf", "$file", "-verb" ) && Error("Did not rewrite build.pl file");

exit 0;

#-------------------------------------------------------------------------------
# Function        : NextBuildVersion
#
# Description     : Determine the next build version number
#                   Assume this is a SIMPLE ripple build
#
# Inputs          : pkg_name
#                   pkg_ver
#                   type        - M,m,p,r
#                               Major, Minor, Patch or Ripple
#
# Returns         :
#
sub NextBuildVersion
{
    my ( $name, $ver, $type ) = @_;

    #
    #   Extract the version number from the project name
    #
    my ( $pn, $pv, $pp ) = SplitPackage( $name, $ver );
    if ( $pv eq 'WIP' )
    {
        ($pv) = keys %{$ReleasePackages{$pn}{$pp}};
        Error ("Cannot determine current version for package", "$name $ver" ) unless ( $pv );

        $type = GetWipChangeType($name, $ver);
        Error ("Cannot determine WIP change Type", "$name $ver" ) unless ( $type );
    }

    #
    #   Create a hash of existing versions for the required package
    #   These will be used to assist in determing the next version number
    #
    my $versions = GetPackageVersions( $name );
    $versions = $versions->{$pp};

    #
    #   Scan the versions and create a hash to assist in determing if a version
    #   already exists.
    #       Key it by MAJOR, MINOR, PATCH
    #
    my %vhash;
    foreach ( @{$versions} )
    {
        next if ( m/WIP/i );
        my ($major, $minor, $patch, $build ) = SplitVersion( $_ );
        $vhash{$major}{$minor}{$patch}{$build} = 1;
    }
#    DebugDumpData ("VVVV", \%vhash );

    #
    #   Extract the major, minor, patch and build number
    #
    my ($major, $minor, $patch, $build ) = SplitVersion( $pv );

#print "Base: $major, $minor, $patch, $build, Type: $type\n";
    my $done = 0;
    while ( !$done )
    {
        #
        #   Bump the reqired part of the version number
        #
        if ( $type eq 'M' ) {
            $major++;
            next if ( exists $vhash{$major} );
            $minor = 0;
            $patch = 0;
            $build = 0;

        } elsif ( $type eq 'm' || $type eq 'N' ) {
            $minor++;
            next if ( exists $vhash{$major}{$minor} );
            $patch = 0;
            $build = 0;

        } elsif ( $type eq 'p' || $type eq 'P' ) {
            $patch++;
            next if ( exists $vhash{$major}{$minor}{$patch} );
            $build = 0;
        } else {
            $build++;
            next if ( exists $vhash{$major}{$minor}{$patch}{$build} );
        }
        $done = 1;
    }

    #
    #   Build number retains its 3 character extension
    #
    Error ("Build number is too big: $build" )
        if ( $build >= 999 );
    $build = sprintf( "%-03.3d", $build );


    #
    #   Join them back again
    #
    print "NextBuildVersion: $name, $ver ==> ${name}_$major.$minor.${patch}${build}.$pp\n";
    return ( $name, "$major.$minor.${patch}${build}", $pp  );
}

#-------------------------------------------------------------------------------
# Function        : GetWipChangeType
#
# Description     : The current data is a WIP
#                   Determine the true type of the change requested
#
# Inputs          : pkg_name
#                   pkg_ver
#
# Returns         :
#
sub GetWipChangeType
{
    my ( $pkg_name, $pkg_ver ) = @_;
    my (@row);
    my $pv_id;
    my $change_type;

    # if we are not or cannot connect then return 0 as we have not found anything
    connectRM(\$RM_DB) unless ( $RM_DB );

    #
    #   First determine the PV_ID for the specified version of the package
    #
    my $m_sqlstr = "SELECT pkg.PKG_NAME, pkg.PKG_ID, pv.PKG_VERSION, pv.PV_ID, pv.CHANGE_TYPE FROM PACKAGES pkg, PACKAGE_VERSIONS pv WHERE pkg.PKG_NAME = \'$pkg_name\' AND pkg.PKG_ID = pv.PKG_ID AND pv.PKG_VERSION = \'$pkg_ver\'";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    $pv_id = $row[3];
                    $change_type = $row[4];
                    last;
                }
            }
            $sth->finish();
        }
    }
    else
    {
        Error("GetDepends:Prepare failure" );
    }

    return $change_type;
}

#-------------------------------------------------------------------------------
# Function        : GetPackageVersions
#
# Description     : Get a hash of package versions for the named package
#
# Inputs          : $name           - Package name
#
# Returns         :
#
sub GetPackageVersions
{
    my ($name ) = @_;

    my $foundDetails = 0;
    my (@row);
    my %versions;

    # if we are not or cannot connect then return 0 as we have not found anything
    connectRM(\$RM_DB) unless ( $RM_DB );

    #
    #   Determine all versions of the named package
    #

    my $m_sqlstr = "SELECT pkg.PKG_NAME, pkg.PKG_ID, pv.PKG_VERSION FROM PACKAGES pkg, PACKAGE_VERSIONS pv WHERE pkg.PKG_NAME = \'$name\' 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 )
                {
                    my $id = $row[1];
                    my ( $name, $ver, $proj ) = SplitPackage( $row[0], $row[2] );
                    push @{$versions{$proj}}, $ver;
                }
            }
            $sth->finish();
        }
    }
    else
    {
        Error("GetPackageVersions:Prepare failure" );
    }

#    DebugDumpData("Versions", \%versions );
    return \%versions;
}


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

    # if we are not or cannot connect then return 0 as we have not found anything
    connectRM(\$RM_DB) unless ( $RM_DB );

    #
    #   First determine the PV_ID for the specified version of the package
    #
    my $m_sqlstr = "SELECT pkg.PKG_NAME, pkg.PKG_ID, pv.PKG_VERSION, pv.PV_ID FROM PACKAGES pkg, PACKAGE_VERSIONS pv WHERE pkg.PKG_NAME = \'$pkg_name\' AND pkg.PKG_ID = pv.PKG_ID AND pv.PKG_VERSION = \'$pkg_ver\'";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    $pv_id = $row[3];
                    last;
                }
            }
            $sth->finish();
        }
    }
    else
    {
        Error("GetDepends:Prepare failure" );
    }

    Error ("GetDepends: PV_ID not located") unless ( $pv_id );

    #
    #   Noew extract the package dependacies
    #
    $m_sqlstr = "SELECT pkg.PKG_NAME, pv.PKG_VERSION FROM PACKAGE_DEPENDENCIES pd, PACKAGE_VERSIONS pv, PACKAGES pkg WHERE pd.PV_ID = \'$pv_id\' AND pd.DPV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";
    $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    my ( $pn, $pv, $pp ) = SplitPackage( $row[0], $row[1] );
                    my ($rp) = keys %{$ReleasePackages{$pn}{$pp}};

                    $BuildPackages{$pn}{$pp} = $rp;

#                    print  ' ' x 4, "$pn $pv $pp";
#                    if ( $rp ne $pv )
#                    {
#                        print "  ----- Package not in release. Needs $rp";
#                    }
#                    print "\n";
                }
            }
            $sth->finish();
        }
    }
    else
    {
        Error("GetDepends:Prepare failure" );
    }
}

#-------------------------------------------------------------------------------
# Function        : getPkgDetailsByRTAG_ID
#
# Description     : Build up a structure for all the currently released
#                   packages in a given release
#
# Inputs          : rtag_id
#
# Returns         : Hash
#

sub getPkgDetailsByRTAG_ID
{
    my ($RTAG_ID) = @_;
    my $foundDetails = 0;
    my (@row);

    # if we are not or cannot connect then return 0 as we have not found anything
    connectRM(\$RM_DB) unless ( $RM_DB );

    # First get details from pv_id

    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION FROM RELEASE_CONTENT rc, PACKAGE_VERSIONS pv, PACKAGES pkg WHERE rc.RTAG_ID = $RTAG_ID AND rc.PV_ID = pv.PV_ID 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 )
                {
                    my $pv_id   = $row[0];
                    my $name    = $row[1];
                    my $version = $row[2];

                    my ( $pn, $pv, $pp ) = SplitPackage( $name,  $version );
                    $ReleasePackages{$pn}{$pp}{$pv} = $pv_id;
                }
            }
            $sth->finish();
        }
    }
    else
    {
        Error("Prepare failure" );
    }
}
Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/LOCAL/jats_rm_play06.pl – Rev 6177
