Subversion Repositories DevTools

Rev

Rev 392 | Rev 5710 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
392 dpurdie 1 
#! perl
2 
########################################################################
3 
# Copyright ( C ) 2004 ERG Limited, All rights reserved
4 
#
5 
# Module name   : jats.sh
6 
# Module type   : Makefile system
7 
# Compiler(s)   : n/a
8 
# Environment(s): jats
9 
#
10 
# Description   : Determine all packages with DNR (Do Not Ripple)
11 
#
12 
#                 Works with specified rtag
13 
#                 Shows direct and indirect exclusions
14 
#                 Shows the root cause a package won't build
15 
#
16 
#                 Currently doesn't track versions as the 'usedby' stuff
17 
#                 doesn't work to well - it looses upwards dependencies.
18 
#
19 
#
20 
#......................................................................#
21 
 
22 
require 5.006_001;
23 
use strict;
24 
use warnings;
25 
use JatsError;
26 
use JatsSystem;
27 
use Getopt::Long;
28 
use Pod::Usage;                             # required for help support
29 
use JatsRmApi;
30 
 
31 
use DBI;
32 
 
33 
my $VERSION = "1.2.3";                      # Update this
34 
my $opt_verbose = 1;
35 
my $opt_help = 0;
36 
my $opt_manual;
37 
my $opt_rtag_id;
38 
my $RM_DB;
39 
 
40 
#
41 
#   Package information
42 
#
43 
my %Package;
44 
my %Dnr;
45 
my @StrayPackages;
46 
 
47 
#-------------------------------------------------------------------------------
48 
# Function        : Main Entry
49 
#
50 
# Description     :
51 
#
52 
# Inputs          :
53 
#
54 
# Returns         :
55 
#
56 
my $result = GetOptions (
57 
                "help+"         => \$opt_help,          # flag, multiple use allowed
58 
                "manual"        => \$opt_manual,        # flag
59 
                "verbose+"      => \$opt_verbose,       # flag
60 
                "rtag=s"        => \$opt_rtag_id,       # string
61 
                );
62 
 
63 
#
64 
#   Process help and manual options
65 
#
66 
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
67 
pod2usage(-verbose => 1)  if ($opt_help == 2 );
68 
pod2usage(-verbose => 2)  if ($opt_manual || ($opt_help > 2));
69 
 
70 
ErrorConfig( 'name'    =>'PLAY18a' );
71 
 
72 
Error ("No RTAGID specified") unless ( $opt_rtag_id );
73 
 
74 
getDNRbyRTAGID ($opt_rtag_id);
75 
getPkgDetailsByRTAG_ID($opt_rtag_id);
76 
Calc_NoRipples();
77 
 
78 
##BuildOrder();
79 
#DebugDumpData ("Package", \%Package );
80 
 
81 
exit;
82 
 
83 
 
84 
sub  getDNRbyRTAGID
85 
{
86 
    my ($RTAG_ID) = @_;
87 
    my $foundDetails = 0;
88 
    my (@row);
89 
 
90 
    # if we are not or cannot connect then return 0 as we have not found anything
91 
    connectRM( \$RM_DB);
92 
 
93 
    # First get details from pv_id
94 
 
95 
    my $m_sqlstr = "SELECT dnr.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION, rc.RTAG_ID" .
96 
                    " FROM DO_NOT_RIPPLE dnr, PACKAGE_VERSIONS pv, PACKAGES pkg, RELEASE_CONTENT rc" .
97 
                    " 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";
98 
    my $sth = $RM_DB->prepare($m_sqlstr);
99 
    if ( defined($sth) )
100 
    {
101 
        if ( $sth->execute( ) )
102 
        {
103 
            if ( $sth->rows )
104 
            {
105 
                while ( @row = $sth->fetchrow_array )
106 
                {
107 
                    my $pv_id = $row[0];
108 
                    my $name = $row[1];
109 
                    my $ver = $row[2];
110 
                    my $rtag_id = $row[3];
111 
 
112 
                    $ver = 'ZZZZ';
113 
                    $Dnr{$name,$ver} = $pv_id;
114 
print "DNR: $rtag_id, $pv_id, $name, $ver\n";
115 
                }
116 
            }
117 
            $sth->finish();
118 
        }
119 
        else
120 
        {
121 
        Error("Execute failure" );
122 
        }
123 
    }
124 
    else
125 
    {
126 
        Error("Prepare failure" );
127 
    }
128 
}
129 
 
130 
 
131 
 
132 
sub getPkgDetailsByRTAG_ID
133 
{
134 
    my ($RTAG_ID) = @_;
135 
    my $foundDetails = 0;
136 
    my (@row);
137 
 
138 
    # Connect to the database
139 
    connectRM( \$RM_DB)
140 
        unless $RM_DB;
141 
 
142 
    # First get details from pv_id
143 
 
144 
    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" .
145 
                    " FROM RELEASE_CONTENT rc, PACKAGE_VERSIONS pv, PACKAGES pkg" .
146 
                    " WHERE rc.RTAG_ID = $RTAG_ID AND rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";
147 
    my $sth = $RM_DB->prepare($m_sqlstr);
148 
    if ( defined($sth) )
149 
    {
150 
        if ( $sth->execute( ) )
151 
        {
152 
            if ( $sth->rows )
153 
            {
154 
                while ( @row = $sth->fetchrow_array )
155 
                {
156 
                    my $pv_id = $row[0];
157 
                    my $name = $row[1];
158 
                    my $ver = $row[2];
159 
                    my $label = $row[3] || '';
160 
                    my $path = $row[4] || '';
161 
                    my $deployable = $row[6];
162 
                    my $base_id = $row[7] || '';
163 
                    $ver = 'ZZZZ';
164 
 
165 
                    #
166 
                    #   Construct archive path
167 
                    #
168 
                    my $dpkg;
169 
                    foreach my $var ( 'GBE_DPKG', 'GBE_DPLY' )
170 
                    {
171 
                        my $pkg_dir="$ENV{$var}/${name}/${ver}";
172 
                        if ( -d $pkg_dir )
173 
                        {
174 
                            $dpkg = $pkg_dir;
175 
                            last;
176 
                        }
177 
                    }
178 
 
179 
                    $path =~ tr~\\/~/~s;
180 
#print "$row[5] --";
181 
#printf ( "%40s %15s %50s %s\n",  $name, $ver, $label, $path);
182 
#printf ( "copy e:\\%s\\%s .\n",  $name, $ver, $label, $path);
183 
#print "$name $ver\n";
184 
#print "$name $ver, $dpkg\n";
185 
                    $Package{$name}{$ver}{done} = 1;
186 
                    $Package{$name}{$ver}{base} = 1;
187 
                    $Package{$name}{$ver}{base_id} = $base_id;
188 
                    $Package{$name}{$ver}{deployable} = 1 if ($deployable);
189 
                    $Package{$name}{$ver}{dpkg} = $dpkg if ($dpkg);
190 
                    $Package{$name}{$ver}{label} = $label;
191 
                    $Package{$name}{$ver}{path} = $path;
192 
 
193 
                    GetDepends( $pv_id, $name, $ver );
194 
                }
195 
            }
196 
            $sth->finish();
197 
        }
198 
    }
199 
    else
200 
    {
201 
        Error("Prepare failure" );
202 
    }
203 
}
204 
 
205 
#-------------------------------------------------------------------------------
206 
# Function        : GetDepends
207 
#
208 
# Description     : Extract the dependancies for a given package version
209 
#
210 
# Inputs          : $pvid
211 
#
212 
# Returns         :
213 
#
214 
sub GetDepends
215 
{
216 
    my ($pv_id, $pname, $pver ) = @_;
217 
 
218 
    #
219 
    #   Now extract the package dependacies
220 
    #
221 
    my $m_sqlstr = "SELECT pkg.PKG_NAME, pv.PKG_VERSION, pd.DPV_ID, pv.IS_DEPLOYABLE" .
222 
                   " FROM PACKAGE_DEPENDENCIES pd, PACKAGE_VERSIONS pv, PACKAGES pkg" .
223 
                   " WHERE pd.PV_ID = \'$pv_id\' AND pd.DPV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";
224 
    my $sth = $RM_DB->prepare($m_sqlstr);
225 
    if ( defined($sth) )
226 
    {
227 
        if ( $sth->execute( ) )
228 
        {
229 
            if ( $sth->rows )
230 
            {
231 
                my %depends;
232 
                while ( my @row = $sth->fetchrow_array )
233 
                {
234 
#                    print "$name ===== @row\n";
235 
                    my $name = $row[0];
236 
                    my $ver = $row[1];
237 
                    my $deployable = $row[3];
238 
                    $ver = 'ZZZZ';
239 
 
240 
                    $depends{$name,$ver} = 1;
241 
                    $Package{$name}{$ver}{usedby}{$pname,$pver} = $pv_id;
242 
 
243 
                    unless ( exists $Package{$name}{$ver}{done} )
244 
                    {
245 
                        $Package{$name}{$ver}{needed} = 1;
246 
                        $Package{$name}{$ver}{deployable} = 1 if ($deployable);
247 
 
248 
                        my @DATA = ($name, $ver, $row[2]);
249 
                        push @StrayPackages, \@DATA;
250 
                    }
251 
                }
252 
                $Package{$pname}{$pver}{depends} = \%depends;
253 
            }
254 
            $sth->finish();
255 
        }
256 
    }
257 
    else
258 
    {
259 
        Error("GetDepends:Prepare failure" );
260 
    }
261 
}
262 
 
263 
#-------------------------------------------------------------------------------
264 
# Function        : Calc_NoRipples
265 
#
266 
# Description     :
267 
#
268 
# Inputs          :
269 
#
270 
# Returns         :
271 
#
272 
my %all_dnr;
273 
my @dnr_list;
274 
 
275 
sub Calc_NoRipples
276 
{
277 
    print "Packages not part of the build set because of Do Not Ripple\n";
278 
    @dnr_list = keys %Dnr;
279 
    while ( $#dnr_list >= 0 )
280 
    {
281 
        my $data = pop @dnr_list;
282 
        next if ( exists $all_dnr{$data} );
283 
 
284 
        my ($name, $ver ) = split $;, $data;
285 
        next unless ( exists $Package{$name} );
286 
        next unless ( exists $Package{$name}{$ver} );
287 
        $all_dnr{$name,$ver} = 1;
288 
 
289 
        push @dnr_list, keys %{$Package{$name}{$ver}{usedby}};
290 
    }
291 
 
292 
    foreach my $entry ( sort keys %all_dnr )
293 
    {
294 
        my ($name, $ver ) = split $;, $entry;
295 
        my $state = "Indirect";
296 
        $state = "" if ( exists ($Dnr{$name,$ver}) );
297 
 
298 
        printf "%-10s $name, $ver\n", $state;
299 
 
300 
#        DebugDumpData ("xxx", \$Package{$name}{$ver} );
301 
    }
302 
 
303 
 
304 
    my %ubdone;
305 
    foreach my $entry ( sort keys %Dnr )
306 
    {
307 
        my ($name, $ver ) = split $;, $entry;
308 
        $Package{$name}{$ver}{'Dnr'} = 1;
309 
 
310 
        my @ublist = keys %{$Package{$name}{$ver}{usedby}};
311 
        while ( @ublist )
312 
        {
313 
            my $data = pop @ublist;
314 
            next if ( exists $ubdone{$data} );
315 
            $ubdone{$data} = 1;
316 
 
317 
            my ($uname, $uver ) = split $;, $data;
318 
            push @ublist, keys %{$Package{$uname}{$uver}{usedby}};
319 
            $Package{$uname}{$uver}{'DnrReason'}{$entry} = 1;
320 
        }
321 
    }
322 
 
323 
    foreach my $entry ( sort keys %ubdone )
324 
    {
325 
        my ($name, $ver ) = split $;, $entry;
326 
        my @pkgs;
327 
        foreach my $data ( keys %{$Package{$name}{$ver}{DnrReason}} )
328 
        {
329 
            my ($uname, $uver ) = split $;, $data;
330 
            push @pkgs, $uname;
331 
        }
332 
        Message ("$name $ver will not build because:", @pkgs);
333 
    }
334 
 
335 
 
336 
 
337 
 
338 
#        DebugDumpData ("xxx", \%Package );
339 
 
340 
}
341