Subversion Repositories DevTools

#! 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   : Determine all packages with DNR (Do Not Ripple)
#
#                 Works with specified rtag
#                 Shows direct and indirect exclusions
#                 Shows the root cause a package won't build
#
#                 Currently doesn't track versions as the 'usedby' stuff
#                 doesn't work to well - it looses upwards dependencies.
#
#
#......................................................................#

require 5.006_001;
use strict;
use warnings;
use JatsError;
use JatsSystem;
use Getopt::Long;
use Pod::Usage;                             # required for help support
use JatsRmApi;

use DBI;

my $VERSION = "1.2.3";                      # Update this
my $opt_verbose = 1;
my $opt_help = 0;
my $opt_manual;
my $opt_rtag_id;
my $RM_DB;

#
#   Package information
#
my %Package;
my %Dnr;
my @StrayPackages;

#-------------------------------------------------------------------------------
# Function        : Main Entry
#
# Description     :
#
# Inputs          :
#
# Returns         :
#
my $result = GetOptions (
                "help+"         => \$opt_help,          # flag, multiple use allowed
                "manual"        => \$opt_manual,        # flag
                "verbose+"      => \$opt_verbose,       # flag
                "rtag=s"        => \$opt_rtag_id,       # string
                );

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

ErrorConfig( 'name'    =>'PLAY18a' );

Error ("No RTAGID specified") unless ( $opt_rtag_id );

getDNRbyRTAGID ($opt_rtag_id);
getPkgDetailsByRTAG_ID($opt_rtag_id);
Calc_NoRipples();

##BuildOrder();
#DebugDumpData ("Package", \%Package );

exit;


sub  getDNRbyRTAGID
{
    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);

    # First get details from pv_id

    my $m_sqlstr = "SELECT dnr.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION, rc.RTAG_ID" .
                    " FROM DO_NOT_RIPPLE dnr, PACKAGE_VERSIONS pv, PACKAGES pkg, RELEASE_CONTENT rc" .
                    " WHERE dnr.RTAG_ID = $RTAG_ID AND dnr.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID AND rc.PV_ID = pv.PV_ID AND dnr.RTAG_ID = rc.RTAG_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 $ver = $row[2];
                    my $rtag_id = $row[3];

                    $ver = 'ZZZZ';
                    $Dnr{$name,$ver} = $pv_id;
print "DNR: $rtag_id, $pv_id, $name, $ver\n";
                }
            }
            $sth->finish();
        }
        else
        {
        Error("Execute failure" );
        }
    }
    else
    {
        Error("Prepare failure" );
    }
}



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

    # Connect to the database
    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, pv.PKG_LABEL, pv.SRC_PATH, pv.BUILD_TYPE, pv.IS_DEPLOYABLE, rc.BASE_VIEW_ID" .
                    " 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 $ver = $row[2];
                    my $label = $row[3] || '';
                    my $path = $row[4] || '';
                    my $deployable = $row[6];
                    my $base_id = $row[7] || '';
                    $ver = 'ZZZZ';

                    #
                    #   Construct archive path
                    #
                    my $dpkg;
                    foreach my $var ( 'GBE_DPKG', 'GBE_DPLY' )
                    {
                        my $pkg_dir="$ENV{$var}/${name}/${ver}";
                        if ( -d $pkg_dir )
                        {
                            $dpkg = $pkg_dir;
                            last;
                        }
                    }

                    $path =~ tr~\\/~/~s;
#print "$row[5] --";
#printf ( "%40s %15s %50s %s\n",  $name, $ver, $label, $path);
#printf ( "copy e:\\%s\\%s .\n",  $name, $ver, $label, $path);
#print "$name $ver\n";
#print "$name $ver, $dpkg\n";
                    $Package{$name}{$ver}{done} = 1;
                    $Package{$name}{$ver}{base} = 1;
                    $Package{$name}{$ver}{base_id} = $base_id;
                    $Package{$name}{$ver}{deployable} = 1 if ($deployable);
                    $Package{$name}{$ver}{dpkg} = $dpkg if ($dpkg);
                    $Package{$name}{$ver}{label} = $label;
                    $Package{$name}{$ver}{path} = $path;

                    GetDepends( $pv_id, $name, $ver );
                }
            }
            $sth->finish();
        }
    }
    else
    {
        Error("Prepare failure" );
    }
}

#-------------------------------------------------------------------------------
# Function        : GetDepends
#
# Description     : Extract the dependancies for a given package version
#
# Inputs          : $pvid
#
# Returns         :
#
sub GetDepends
{
    my ($pv_id, $pname, $pver ) = @_;

    #
    #   Now extract the package dependacies
    #
    my $m_sqlstr = "SELECT pkg.PKG_NAME, pv.PKG_VERSION, pd.DPV_ID, pv.IS_DEPLOYABLE" .
                   " 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";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                my %depends;
                while ( my @row = $sth->fetchrow_array )
                {
#                    print "$name ===== @row\n";
                    my $name = $row[0];
                    my $ver = $row[1];
                    my $deployable = $row[3];
                    $ver = 'ZZZZ';

                    $depends{$name,$ver} = 1;
                    $Package{$name}{$ver}{usedby}{$pname,$pver} = $pv_id;

                    unless ( exists $Package{$name}{$ver}{done} )
                    {
                        $Package{$name}{$ver}{needed} = 1;
                        $Package{$name}{$ver}{deployable} = 1 if ($deployable);

                        my @DATA = ($name, $ver, $row[2]);
                        push @StrayPackages, \@DATA;
                    }
                }
                $Package{$pname}{$pver}{depends} = \%depends;
            }
            $sth->finish();
        }
    }
    else
    {
        Error("GetDepends:Prepare failure" );
    }
}

#-------------------------------------------------------------------------------
# Function        : Calc_NoRipples
#
# Description     : 
#
# Inputs          : 
#
# Returns         : 
#
my %all_dnr;
my @dnr_list;

sub Calc_NoRipples
{
    print "Packages not part of the build set because of Do Not Ripple\n";
    @dnr_list = keys %Dnr;
    while ( $#dnr_list >= 0 )
    {
        my $data = pop @dnr_list;
        next if ( exists $all_dnr{$data} );

        my ($name, $ver ) = split $;, $data;
        next unless ( exists $Package{$name} );
        next unless ( exists $Package{$name}{$ver} );
        $all_dnr{$name,$ver} = 1;

        push @dnr_list, keys %{$Package{$name}{$ver}{usedby}};
    }

    foreach my $entry ( sort keys %all_dnr )
    {
        my ($name, $ver ) = split $;, $entry;
        my $state = "Indirect";
        $state = "" if ( exists ($Dnr{$name,$ver}) );

        printf "%-10s $name, $ver\n", $state;

#        DebugDumpData ("xxx", \$Package{$name}{$ver} );
    }


    my %ubdone;
    foreach my $entry ( sort keys %Dnr )
    {
        my ($name, $ver ) = split $;, $entry;
        $Package{$name}{$ver}{'Dnr'} = 1;

        my @ublist = keys %{$Package{$name}{$ver}{usedby}};
        while ( @ublist )
        {
            my $data = pop @ublist;
            next if ( exists $ubdone{$data} );
            $ubdone{$data} = 1;

            my ($uname, $uver ) = split $;, $data;
            push @ublist, keys %{$Package{$uname}{$uver}{usedby}};
            $Package{$uname}{$uver}{'DnrReason'}{$entry} = 1;
        }
    }

    foreach my $entry ( sort keys %ubdone )
    {
        my ($name, $ver ) = split $;, $entry;
        my @pkgs;
        foreach my $data ( keys %{$Package{$name}{$ver}{DnrReason}} )
        {
            my ($uname, $uver ) = split $;, $data;
            push @pkgs, $uname;
        }
        Message ("$name $ver will not build because:", @pkgs);
    }




#        DebugDumpData ("xxx", \%Package );
    
}