Subversion Repositories DevTools

Rev

Rev 7299 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
392 dpurdie 1 
########################################################################
7300 dpurdie 2 
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
392 dpurdie 3 
#
4 
# Module name   : jats.sh
5 
# Module type   : Makefile system
6 
# Compiler(s)   : n/a
7 
# Environment(s): jats
8 
#
9 
# Description   : For a given Package + Version display the complete upward (used-by)
10 
#                 dependancy tree
11 
#
12 
#                 Currently hard coded to a Release
13 
#
14 
#                 Creates .dot files to display the dependancy tree
15 
#
16 
# Usage         :   Package_name/Version pairs
17 
#                   The first one is usd as the base
18 
#                   Others name/version pairs onthe command line will also be
19 
#                   added to the picture
20 
#
21 
#......................................................................#
22 
 
23 
require 5.006_001;
24 
use strict;
25 
use warnings;
26 
 
27 
use Pod::Usage;
28 
use Getopt::Long;
29 
 
30 
use JatsError;
31 
use JatsVersionUtils;
32 
use JatsRmApi;
33 
 
34 
#use Data::Dumper;
35 
use DBI;
36 
use Cwd;
37 
 
38 
my $GBE_PERL     = $ENV{'GBE_PERL'};        # Essential ENV variables
39 
my $GBE_CORE     = $ENV{'GBE_CORE'};
40 
 
41 
my %ReleasePackages;            # Packages in the release
42 
my %BuildPackages;              # Packages for this build
43 
my %Depends;
44 
my %UsedBy;
45 
my %Packages;
46 
my $RM_DB;
47 
my %GDATA;
48 
my %GINDEX;
49 
my $PNAME;
50 
my $PVER;
51 
my @ROOT_PVIDS;
52 
 
53 
#
54 
#   Options
55 
#
56 
my $opt_help = 0;
57 
my $opt_verbose = 0;
58 
my $opt_rtagid;
59 
my $opt_show_extract = 0;
60 
 
61 
my $result = GetOptions (
62 
                "help|h:+"          => \$opt_help,
63 
                "manual:3"          => \$opt_help,
64 
                "verbose:+"         => \$opt_verbose,       # flag or number
65 
                "show"              => \$opt_show_extract,
66 
                );
67 
 
68 
#
69 
#   Process help and manual options
70 
#
71 
pod2usage(-verbose => 0)  if ($opt_help == 1  || ! $result);
72 
pod2usage(-verbose => 1)  if ($opt_help == 2);
73 
pod2usage(-verbose => 2)  if ($opt_help > 2);
74 
 
75 
#-------------------------------------------------------------------------------
76 
# Function        : getPkgDetailsByRTAG_ID
77 
#
78 
# Description     : Given an rtag_id, get details on all packages in the release
79 
#
80 
# Inputs          : rtag_id
81 
#
82 
# Returns         :
83 
#
84 
 
85 
sub getPkgDetailsByRTAG_ID
86 
{
87 
    my ($RTAG_ID) = @_;
88 
    my $foundDetails = 0;
89 
    my (@row);
90 
 
91 
    # if we are not or cannot connect then return 0 as we have not found anything
92 
    connectRM(\$RM_DB) unless ( $RM_DB );
93 
 
94 
    # First get details from pv_id
95 
 
96 
    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION, pv.PKG_LABEL, pv.SRC_PATH, pv.BUILD_TYPE" .
97 
                    " FROM RELEASE_MANAGER.RELEASE_CONTENT rc, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .
98 
                    " WHERE rc.RTAG_ID = $RTAG_ID AND rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";
99 
    my $sth = $RM_DB->prepare($m_sqlstr);
100 
    if ( defined($sth) )
101 
    {
102 
        if ( $sth->execute( ) )
103 
        {
104 
            if ( $sth->rows )
105 
            {
106 
                while ( @row = $sth->fetchrow_array )
107 
                {
108 
                    my %DATA;
109 
                    my $pvid = $DATA{pv_id}  = $row[0];
110 
                    my $name = $DATA{name}   = $row[1];
111 
                    my $ver = $DATA{version} = $row[2];
112 
                    my $label = $DATA{label} = $row[3] || '';
113 
                    my $path = $DATA{path}   = $row[4] || '';
114 
                    $path =~ tr~\\/~/~s;
115 
#print "$row[5] --";
116 
#printf ( "%40s %15s %50s %s\n",  $name, $ver, $label, $path);
117 
 
118 
                    $GDATA{$pvid} = (\%DATA);
119 
                    my ( $pn, $pv, $pp ) = SplitPackage( $name, $ver );
120 
                    $GINDEX{"$pn.$pp"} = $pvid;
121 
                }
122 
            }
123 
            $sth->finish();
124 
        }
125 
        else
126 
        {
127 
            Error("Execute failure");
128 
        }
129 
    }
130 
    else
131 
    {
132 
        Error("Prepare failure" );
133 
    }
134 
}
135 
 
136 
#-------------------------------------------------------------------------------
137 
# Function        : GetDepends_pvid
138 
#
139 
# Description     : Given an pv_id
140 
#
141 
# Inputs          : pv_id
142 
#                   pkg_name
143 
#                   pkg_ver
144 
#
145 
# Returns         :
146 
#
147 
sub GetDepends_pvid
148 
{
149 
    my (@row);
150 
    my ($pv_id, $name, $version) = @_;
151 
 
152 
    my ( $pn, $pv, $pp ) = SplitPackage( $name, $version );
153 
    my $ukey = "$pn.$pp";
154 
 
155 
 
156 
    $ReleasePackages{$name}{$version} = $ukey;
157 
    $Packages{$ukey} = "$name.$version";
158 
 
159 
    # if we are not or cannot connect then return 0 as we have not found anything
160 
    connectRM(\$RM_DB) unless ( $RM_DB );
161 
 
162 
    #   Now extract the package dependacies
163 
    #
164 
    my $m_sqlstr = "SELECT pkg.PKG_NAME, pv.PKG_VERSION, pd.DPV_ID" .
165 
                   " FROM RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .
166 
                   " WHERE pd.PV_ID = \'$pv_id\' AND pd.DPV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";
167 
    my $sth = $RM_DB->prepare($m_sqlstr);
168 
    if ( defined($sth) )
169 
    {
170 
        if ( $sth->execute( ) )
171 
        {
172 
            if ( $sth->rows )
173 
            {
174 
                while ( @row = $sth->fetchrow_array )
175 
                {
176 
#print ( "DATA: " . join(',', @row) . "\n");
177 
                    my $dpv_id = $row[2];
178 
                    my ( $pn, $pv, $pp ) = SplitPackage( $row[0], $row[1] );
179 
 
180 
                    my $key = "$pn.$pp";
181 
                    my @data = ( $key, $dpv_id, $pn, "$pv.$pp" );
182 
                    push @{$Depends{$ukey}}, \@data;
183 
                    push @{$UsedBy{$key}}, $ukey;
184 
 
185 
#                    print  ' ' x 4, "$pn $pv $pp";
186 
#                    if ( $rp ne $pv )
187 
#                    {
188 
#                        print "  ----- Package not in release. Needs $rp";
189 
#                    }
190 
#                    print "\n";
191 
                }
192 
            }
193 
            $sth->finish();
194 
        }
195 
    }
196 
    else
197 
    {
198 
        Error("GetDepends:Prepare failure" );
199 
    }
200 
}
201 
 
202 
#-------------------------------------------------------------------------------
203 
# Function        : GetUsesBy_pvid
204 
#
205 
# Description     : Given an pv_id determine the packages that use this
206 
#                   package.
207 
#
208 
#                   Also determine the package name and package version
209 
#
210 
# Inputs          : pv_id
211 
#
212 
# Returns         :
213 
#
214 
sub GetUsesBy_pvid
215 
{
216 
    my (@row);
217 
    my ($pv_id) = @_;
218 
print "Processing for: $pv_id \n";
219 
    # if we are not or cannot connect then return 0 as we have not found anything
220 
    connectRM(\$RM_DB) unless ( $RM_DB );
221 
 
222 
    #   Now extract the package dependacies
223 
    #
224 
    my $m_sqlstr = "SELECT pkg.PKG_NAME, pv.PKG_VERSION, pd.PV_ID" .
225 
                   " FROM RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .
226 
                   " WHERE pd.DPV_ID = \'$pv_id\' AND pd.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";
227 
    my $sth = $RM_DB->prepare($m_sqlstr);
228 
    if ( defined($sth) )
229 
    {
230 
        if ( $sth->execute( ) )
231 
        {
232 
            if ( $sth->rows )
233 
            {
234 
                while ( @row = $sth->fetchrow_array )
235 
                {
236 
print ( "DATA: " . join(',', @row) . "\n");
237 
                }
238 
            }
239 
            $sth->finish();
240 
        }
241 
    }
242 
    else
243 
    {
244 
        Error("GetUsesBy_pvid:Prepare failure" );
245 
    }
246 
}
247 
 
248 
 
249 
#-------------------------------------------------------------------------------
250 
# Function        : getPkgDetailsByName
251 
#
252 
# Description     : Determine the PVID for a given package name and version
253 
#
254 
# Inputs          : $pname          - Package name
255 
#                   $pver           - Package Version
256 
#
257 
# Returns         : PV_ID
258 
#
259 
 
260 
sub getPkgDetailsByName
261 
{
262 
    my ($pname, $pver) = @_;
263 
    my $pv_id;
264 
    my (@row);
265 
 
266 
    connectRM(\$RM_DB) unless ($RM_DB);
267 
 
268 
    # First get details for a given package version
269 
 
270 
    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION" .
271 
                    " FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .
272 
                    " WHERE pkg.PKG_NAME = \'$pname\' AND pv.PKG_VERSION = \'$pver\' AND pv.PKG_ID = pkg.PKG_ID";
273 
    my $sth = $RM_DB->prepare($m_sqlstr);
274 
    if ( defined($sth) )
275 
    {
276 
        if ( $sth->execute( ) )
277 
        {
278 
            if ( $sth->rows )
279 
            {
280 
                while ( @row = $sth->fetchrow_array )
281 
                {
282 
                    $pv_id = $row[0];
283 
                    my $name = $row[1];
284 
                    my $ver = $row[2];
285 
                    Verbose( "getPkgDetailsByName :PV_ID= $pv_id");
286 
                }
287 
            }
288 
            $sth->finish();
289 
        }
290 
    }
291 
    else
292 
    {
293 
        Error("Prepare failure" );
294 
    }
295 
    return $pv_id;
296 
}
297 
 
298 
 
299 
#-------------------------------------------------------------------------------
300 
# Function        : AddUsedBy
301 
#
302 
# Description     :
303 
#
304 
# Inputs          :
305 
#
306 
# Returns         :
307 
#
308 
 
309 
my %AllUsedBy;
310 
sub AddUsedBy
311 
{
312 
    my ($ref) = @_;
313 
    foreach my $entry ( @$ref )
314 
    {
315 
#print "Adding: $entry\n";
316 
        if ( ! exists($AllUsedBy{$entry}) )
317 
        {
318 
#print "     New Adding: $entry\n";
319 
            $AllUsedBy{$entry} = 1;
320 
#DebugDumpData ("UsedBy", \$UsedBy{$entry} );
321 
            AddUsedBy( $UsedBy{$entry} );
322 
        }
323 
    }
324 
}
325 
#-------------------------------------------------------------------------------
326 
# Function        : Main
327 
#
328 
# Description     :
329 
#
330 
# Inputs          :
331 
#
332 
# Returns         :
333 
#
334 
 
335 
ErrorConfig( 'name'    =>'ExtractUses' );
336 
 
337 
#
338 
#   Determine root package
339 
#
340 
unless ( $ARGV[0] && $ARGV[1] )
341 
{
342 
    print "Specify a package as 'name' 'version'\n";
343 
    exit;
344 
}
345 
$PNAME = $ARGV[0];
346 
$PVER = $ARGV[1];
347 
 
348 
#
349 
#   For each required package-version
350 
#   Determine the packages pv_id
351 
#
352 
while ( $#ARGV >= 1 )
353 
{
354 
    my $pv_id = getPkgDetailsByName($ARGV[0], $ARGV[1]);
355 
    Error ("Package not found: $ARGV[0] $ARGV[1]") unless ( $pv_id );
356 
 
357 
    push @ROOT_PVIDS, $pv_id;
358 
    shift @ARGV;
359 
    shift @ARGV;
360 
}
361 
 
362 
#
363 
#   For each known PVID
364 
#   Determine the package details
365 
#
366 
foreach my $pv_id ( @ROOT_PVIDS )
367 
{
368 
    GetUsesBy_pvid($pv_id);
369 
}
370 
Error ("Only got this far");
371 
 
372 
 
373 
#getPkgDetailsByRTAG_ID(2301);           # 2301 : Seattle I7
374 
#getPkgDetailsByRTAG_ID(2362);           # 2362 : Syd Release 1
375 
#getPkgDetailsByRTAG_ID(1861);           # 1861 : Syd Release Legacy
376 
#getPkgDetailsByRTAG_ID(3462);           # 3462 : Beijing Release 1
377 
#getPkgDetailsByRTAG_ID(5162);           # 5162 : NZS TP5600
378 
#getPkgDetailsByRTAG_ID(16243);          # 16243 : VTK
379 
getPkgDetailsByRTAG_ID($opt_rtagid);
380 
 
381 
#DebugDumpData("GDATA", \%GDATA);
382 
 
383 
foreach my $pv_id ( keys %GDATA )
384 
{
385 
    my $pkg = \%{$GDATA{$pv_id}};
386 
#    print "Processing: $pkg->{'name'}\n";
387 
    GetDepends_pvid( $pv_id, $pkg->{'name'}, $pkg->{'version'} );
388 
}
389 
 
390 
#DebugDumpData ("BuildPackages", \%BuildPackages );
391 
#DebugDumpData ("ReleasePackages", \%ReleasePackages );
392 
#DebugDumpData ("Depends", \%Depends );
393 
#DebugDumpData ("UsedBy", \%UsedBy );
394 
 
395 
while ( $#ARGV >= 1 )
396 
{
397 
    #DebugDumpData( "START", \$ReleasePackages{$ARGV[0] });
398 
    my $pv_id1 = getPkgDetailsByName($ARGV[0], $ARGV[1]);
399 
    my $pv_id = $ReleasePackages{$ARGV[0]}{$ARGV[1]};
400 
 
401 
print "---- $pv_id, $pv_id1\n";
402 
 
403 
    Error ("Package not found: $ARGV[0] $ARGV[1]") unless ( $pv_id );
404 
    #DebugDumpData ("UsedBy:$pv_id", \$UsedBy{$pv_id} ); exit(1);
405 
 
406 
    push @ROOT_PVIDS, $pv_id;
407 
    $AllUsedBy{$pv_id} = 1;
408 
    AddUsedBy( $UsedBy{$pv_id} );
409 
 
410 
    shift @ARGV;
411 
    shift @ARGV;
412 
}
413 
 
414 
if ( $#ARGV >= 0 )
415 
{
416 
    Error("Args shoud be name-version pairs. Appears to be a one short");
417 
}
418 
 
419 
 
420 
#DebugDumpData ("AllUsedBy", \%AllUsedBy );
421 
 
422 
 
423 
my $filebase = "${PNAME}_${PVER}_usedby";
424 
open (FH, ">$filebase.dot" ) or die "Cannot open output";
425 
print FH "digraph world {\n";
426 
print FH "\trankdir=LR;\n";
427 
print FH "\tnode[fontsize=24];\n";
428 
print FH "\t{root=", pentry($ROOT_PVIDS[0]), "; }\n";
429 
 
430 
 
431 
foreach my $entry ( sort keys(%AllUsedBy) )
432 
{
433 
    my $ref = $UsedBy{$entry};
434 
    print FH "\t", pentry($entry)  ," -> { ", plist ( ' ; ', @{$ref} ), " }\n";
435 
}
436 
 
437 
 
438 
print FH "\n};\n";
439 
close FH;
440 
 
441 
#
442 
#   Convert DOT to a SVG
443 
#
444 
system( "dot $filebase.dot -Tjpg -o$filebase.jpg" );
445 
system( "dot $filebase.dot -Tsvg -o$filebase.svg" );
446 
 
447 
#
448 
#   Complete used-by tree
449 
#
450 
##foreach my $entry ( keys(%AllUsedBy) )
451 
##{
452 
##     my $pvid = $GINDEX{$entry};
453 
###     print "$entry, $pvid\n";
454 
##    my $pkg = \%{$GDATA{$pvid}};
455 
##
456 
##    my $label = $pkg->{label};
457 
##    my $path = $pkg->{path};
458 
##    $path =~ tr~\\/~/~s;
459 
###    printf ( "%40s %15s %50s %s\n",  $pkg->{name}, $pkg->{version}, $pkg->{label}, $path);
460 
##    print ( "jats extract $label -path=$path\n");
461 
##
462 
##}
463 
 
464 
if ( $opt_show_extract )
465 
{
466 
    #
467 
    #   Directly used by
468 
    #
469 
    #DebugDumpData ("UsedBy:$pv_id", \$UsedBy{$pv_id} ); exit(1);
470 
 
471 
    my %directly_used;
472 
    foreach my $pv_id ( @ROOT_PVIDS )
473 
    {
474 
        foreach my $entry ( @{$UsedBy{$pv_id}} )
475 
        {
476 
            $directly_used{$entry} = 1;
477 
        }
478 
    }
479 
 
480 
    foreach my $entry ( keys (%directly_used) )
481 
    {
482 
         my $pvid = $GINDEX{$entry};
483 
    #     print "$entry, $pvid\n";
484 
        my $pkg = \%{$GDATA{$pvid}};
485 
 
486 
        my $label = $pkg->{label};
487 
        my $path = $pkg->{path};
488 
        $path =~ tr~\\/~/~s;
489 
    #    printf ( "%40s %15s %50s %s\n",  $pkg->{name}, $pkg->{version}, $pkg->{label}, $path);
490 
        print ( "jats extract $label -path=$path\n");
491 
    }
492 
}
493 
 
494 
exit;
495 
 
496 
 
497 
#-------------------------------------------------------------------------------
498 
# Function        : plist
499 
#
500 
# Description     : Generate an entry list as text
501 
#                   Replace "." with "_" since DOT doesn't like .'s
502 
#                   Seperate the arguments
503 
#
504 
# Inputs          : $pref       - Prefix string
505 
#                   @_          - An array of entries to process
506 
#
507 
# Returns         : A string
508 
#
509 
sub plist
510 
{
511 
    my $pref = shift;
512 
    my $result = "";
513 
    foreach  ( @_ )
514 
    {
515 
        my $x = $_;
516 
        $x =~ s~\.~_~g;
517 
        $result .= '"' . $x . '"' . $pref;
518 
    }
519 
    return $result;
520 
}
521 
 
522 
sub pentry
523 
{
524 
 
525 
    my $result = "";
526 
    foreach  ( @_ )
527 
    {
528 
        my $x = $_;
529 
        $x =~ s~\.~_~g;
530 
        $result .= '"' . $x . '"'
531 
    }
532 
    return $result;
533 
}
534 
 
535 
#-------------------------------------------------------------------------------
536 
#   Documentation
537 
#
538 
 
539 
=pod
540 
 
541 
=head1 NAME
542 
 
543 
jats etool extract_uses - Graph build dependencies
544 
 
545 
=head1 SYNOPSIS
546 
 
547 
  jats etool extract_uses [options] PackageName/Version Pairs
548 
 
549 
 Options:
550 
    -help               - brief help message
551 
    -help -help         - Detailed help message
552 
    -man                - Full documentation
553 
    -verbose            - Verbose operation
554 
    -rtag=nnn           - Release Tag
555 
    -show               - Show 'jats extract' commands
556 
 
557 
=head1 OPTIONS
558 
 
559 
=over 8
560 
 
561 
=item B<-help>
562 
 
563 
Print a brief help message and exits.
564 
 
565 
=item B<-help -help>
566 
 
567 
Print a detailed help message with an explanation for each option.
568 
 
569 
=item B<-man>
570 
 
571 
Prints the manual page and exits.
572 
 
573 
=item B<-verbose>
574 
 
575 
Increases program output. This option may be specified multiple times
576 
 
577 
 
578 
This option specifies the Release, within the Release Manager Database, that will
579 
be used to update the build dependency file.
580 
 
581 
The Release Tag is provided by the Release Manager Web Page, or by the -Show option
582 
of this utility.
583 
 
584 
=back
585 
 
586 
=head1 DESCRIPTION
587 
 
588 
This utilty will display the dependency tree for packages used by the specified
589 
packages.
590 
 
591 
=cut
592