WebSVN – DevTools – Blame – /core_devl/trunk/TOOLS/LOCAL/jats_rm_play10.pl

Rev	Author	Line No.	Line
392	dpurdie	1	`#! perl`
		2	`########################################################################`
5710	dpurdie	3	`# Copyright (c) VIX TECHNOLOGY (AUST) LTD`
392	dpurdie	4	`#`
		5	`# Module name : jats.sh`
		6	`# Module type : Makefile system`
		7	`# Compiler(s) : n/a`
		8	`# Environment(s): jats`
		9	`#`
		10	`# Description : For a given Package + Version display the complete upward (used-by)`
		11	`# dependancy tree`
		12	`#`
		13	`# Currently hard coded to Sydney Release-1`
		14	`#`
		15	`# Creates .dot files to display the dependancy tree`
		16	`#`
		17	`# Basis for extract program used elsewhere.`
		18	`#`
		19	`# Usage:`
		20	`#`
		21	`# Version Who Date Description`
		22	`#`
		23	`#......................................................................#`
		24
		25	`require 5.006_001;`
		26	`use strict;`
		27	`use warnings;`
		28	`use JatsError;`
		29	`use JatsVersionUtils;`
		30	`use JatsRmApi;`
		31
		32	`#use Data::Dumper;`
		33	`use DBI;`
		34	`use Cwd;`
		35
		36	`my $GBE_PERL = $ENV{'GBE_PERL'}; # Essential ENV variables`
		37	`my $GBE_CORE = $ENV{'GBE_CORE'};`
		38	`my $opt_verbose = 1;`
		39
		40	`my %ReleasePackages; # Packages in the release`
		41	`my %BuildPackages; # Packages for this build`
		42	`my %Depends;`
		43	`my %UsedBy;`
		44	`my %Packages;`
		45	`my $RM_DB;`
		46	`my %GDATA;`
		47	`my %GINDEX;`
		48
		49	`sub getPkgDetailsByRTAG_ID`
		50	`{`
		51	`my ($RTAG_ID) = @_;`
		52	`my $foundDetails = 0;`
		53	`my (@row);`
		54
		55	`# if we are not or cannot connect then return 0 as we have not found anything`
		56	`connectRM(\$RM_DB) unless ( $RM_DB );`
		57
		58	`# First get details from pv_id`
		59
		60	`my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION, pv.PKG_LABEL, pv.SRC_PATH, pv.BUILD_TYPE" .`
		61	`" FROM RELEASE_MANAGER.RELEASE_CONTENT rc, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .`
		62	`" WHERE rc.RTAG_ID = $RTAG_ID AND rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";`
		63	`my $sth = $RM_DB->prepare($m_sqlstr);`
		64	`if ( defined($sth) )`
		65	`{`
		66	`if ( $sth->execute( ) )`
		67	`{`
		68	`if ( $sth->rows )`
		69	`{`
		70	`while ( @row = $sth->fetchrow_array )`
		71	`{`
		72	`my %DATA;`
		73	`my $pvid = $DATA{pv_id} = $row[0];`
		74	`my $name = $DATA{name} = $row[1];`
		75	`my $ver = $DATA{version} = $row[2];`
		76	`my $label = $DATA{label} = $row[3] \|\| '';`
		77	`my $path = $DATA{path} = $row[4] \|\| '';`
		78
		79	`# next if ( $ver =~ /syd$/i );`
		80	`# next if ( $ver =~ /cr$/i );`
		81	`# next if ( $ver =~ /mas$/i );`
		82	`# next unless ( $ver =~ /cots$/i );`
		83
		84	`$path =~ tr~\\/~/~s;`
		85	`# next if ( $path =~ m~^/~ );`
		86	`#print "$row[5] --";`
		87	`#printf ( "%40s %15s %50s %s\n", $name, $ver, $label, $path);`
		88
		89	`$GDATA{$pvid} = (\%DATA);`
		90	`my ( $pn, $pv, $pp ) = SplitPackage( $name, $ver );`
		91
		92	`$GINDEX{"$pn.$pp"} = $pvid;`
		93	`}`
		94	`}`
		95	`$sth->finish();`
		96	`}`
		97	`else`
		98	`{`
		99	`Error("Execute failure");`
		100	`}`
		101	`}`
		102	`else`
		103	`{`
		104	`Error("Prepare failure" );`
		105	`}`
		106	`}`
		107
		108	`#-------------------------------------------------------------------------------`
		109	`# Function : getRtagId`
		110	`#`
		111	`# Description : Given a release name, determine the RTAG_ID`
		112	`#`
		113	`# Inputs :`
		114	`#`
		115	`# Returns :`
		116	`#`
		117	`sub getRtagId`
		118	`{`
		119	`my ($RTAG_ID) = @_;`
		120	`my $foundDetails = 0;`
		121	`my (@row);`
		122
		123	`# if we are not or cannot connect then return 0 as we have not found anything`
		124	`connectRM(\$RM_DB) unless ( $RM_DB );`
		125
		126	`# First get details from pv_id`
		127
		128	`my $m_sqlstr = "SELECT rt.RTAG_ID, rt.RTAG_NAME, rt.DESCRIPTION, pj.PROJ_ID, pj.PROJ_NAME, rt.OFFICIAL FROM RELEASE_MANAGER.RELEASE_TAGS rt, RELEASE_MANAGER.PROJECTS pj WHERE rt.PROJ_ID = pj.PROJ_ID ORDER BY pj.PROJ_NAME";`
		129	`my $sth = $RM_DB->prepare($m_sqlstr);`
		130	`if ( defined($sth) )`
		131	`{`
		132	`if ( $sth->execute( ) )`
		133	`{`
		134	`if ( $sth->rows )`
		135	`{`
		136	`while ( @row = $sth->fetchrow_array )`
		137	`{`
		138	`printf "%20s, %8s(%s), %40s\n", $row[4], $row[0], $row[5], $row[1];`
		139	`}`
		140	`}`
		141	`$sth->finish();`
		142	`}`
		143	`}`
		144	`else`
		145	`{`
		146	`Error("Prepare failure" );`
		147	`}`
		148
		149	`disconnectDB();`
		150	`exit;`
		151	`}`
		152
		153
		154	`#-------------------------------------------------------------------------------`
		155	`# Function : GetDepends`
		156	`#`
		157	`# Description :`
		158	`#`
		159	`# Inputs : pkg_name`
		160	`# pkg_ver`
		161	`#`
		162	`# Returns :`
		163	`#`
		164	`sub GetDepends_pvid`
		165	`{`
		166	`my (@row);`
		167	`my ($pv_id, $name, $version) = @_;`
		168
		169	`my ( $pn, $pv, $pp ) = SplitPackage( $name, $version );`
		170	`my $ukey = "$pn.$pp";`
		171
		172
		173	`$ReleasePackages{$name}{$version} = $ukey;`
		174	`$Packages{$ukey} = "$name.$version";`
		175
		176	`# if we are not or cannot connect then return 0 as we have not found anything`
		177	`connectRM(\$RM_DB) unless ( $RM_DB );`
		178
		179	`# Now extract the package dependacies`
		180	`#`
		181	`my $m_sqlstr = "SELECT pkg.PKG_NAME, pv.PKG_VERSION, pd.DPV_ID FROM RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg WHERE pd.PV_ID = \'$pv_id\' AND pd.DPV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";`
		182	`my $sth = $RM_DB->prepare($m_sqlstr);`
		183	`if ( defined($sth) )`
		184	`{`
		185	`if ( $sth->execute( ) )`
		186	`{`
		187	`if ( $sth->rows )`
		188	`{`
		189	`while ( @row = $sth->fetchrow_array )`
		190	`{`
		191	`#print ( "DATA: " . join(',', @row) . "\n");`
		192	`my $dpv_id = $row[2];`
		193	`my ( $pn, $pv, $pp ) = SplitPackage( $row[0], $row[1] );`
		194
		195	`# my ($rp) = keys %{$ReleasePackages{$pn}{$pp}};`
		196	`# $BuildPackages{$pn}{$pp} = $rp;`
		197
		198	`my $key = "$pn.$pp";`
		199	`my @data = ( $key, $dpv_id, $pn, "$pv.$pp" );`
		200	`push @{$Depends{$ukey}}, \@data;`
		201	`push @{$UsedBy{$key}}, $ukey;`
		202
		203	`# print ' ' x 4, "$pn $pv $pp";`
		204	`# if ( $rp ne $pv )`
		205	`# {`
		206	`# print " ----- Package not in release. Needs $rp";`
		207	`# }`
		208	`# print "\n";`
		209	`}`
		210	`}`
		211	`$sth->finish();`
		212	`}`
		213	`}`
		214	`else`
		215	`{`
		216	`Error("GetDepends:Prepare failure" );`
		217	`}`
		218	`}`
		219
		220	`#-------------------------------------------------------------------------------`
		221	`# Function : Main`
		222	`#`
		223	`# Description :`
		224	`#`
		225	`# Inputs :`
		226	`#`
		227	`# Returns :`
		228	`#`
		229
		230	`ErrorConfig( 'name' =>'PLAY10' );`
		231
		232	`#`
		233	`# Determine root package`
		234	`#`
		235	`unless ( $ARGV[0] && $ARGV[1] )`
		236	`{`
		237	`print "Specify a package as 'name' 'version'\n";`
		238	`exit;`
		239	`}`
		240
		241
		242	`#getPkgDetailsByRTAG_ID(2301); # 2301 : Seattle I7`
		243	`#getPkgDetailsByRTAG_ID(2362); # 2362 : Syd Release 1`
		244	`#getPkgDetailsByRTAG_ID(1861); # 1861 : Syd Release Legacy`
		245	`#getPkgDetailsByRTAG_ID(3462); # 3462 : Beijing Release 1`
		246	`#getPkgDetailsByRTAG_ID(5162); # 5162 : NZS TP5600`
		247	`getPkgDetailsByRTAG_ID(16243); # 16243 : VTK`
		248
		249	`#DebugDumpData("GDATA", \%GDATA);`
		250
		251	`foreach my $pv_id ( keys %GDATA )`
		252	`{`
		253	`my $pkg = \%{$GDATA{$pv_id}};`
		254	`# print "Processing: $pkg->{'name'}\n";`
		255	`GetDepends_pvid( $pv_id, $pkg->{'name'}, $pkg->{'version'} );`
		256	`}`
		257
		258	`#DebugDumpData ("BuildPackages", \%BuildPackages );`
		259	`#DebugDumpData ("ReleasePackages", \%ReleasePackages );`
		260	`#DebugDumpData ("Depends", \%Depends );`
		261	`#DebugDumpData ("UsedBy", \%UsedBy );`
		262
		263
		264	`#DebugDumpData( "START", \$ReleasePackages{$ARGV[0] });`
		265	`my $pv_id = $ReleasePackages{$ARGV[0]}{$ARGV[1]};`
		266	`#DebugDumpData ("UsedBy:$pv_id", \$UsedBy{$pv_id} ); exit(1);`
		267
		268	`my %AllUsedBy;`
		269	`sub AddUsedBy`
		270	`{`
		271	`my ($ref) = @_;`
		272	`foreach my $entry ( @$ref )`
		273	`{`
		274	`#print "Adding: $entry\n";`
		275	`if ( ! exists($AllUsedBy{$entry}) )`
		276	`{`
		277	`#print " New Adding: $entry\n";`
		278	`$AllUsedBy{$entry} = 1;`
		279	`#DebugDumpData ("UsedBy", \$UsedBy{$entry} );`
		280	`AddUsedBy( $UsedBy{$entry} );`
		281	`}`
		282	`}`
		283	`}`
		284
		285	`$AllUsedBy{$pv_id} = 1;`
		286	`AddUsedBy( $UsedBy{$pv_id} );`
		287	`#DebugDumpData ("AllUsedBy", \%AllUsedBy );`
		288
		289
		290	`my $filebase = "$ARGV[0]_$ARGV[1]_usedby";`
		291	`open (FH, ">$filebase.dot" ) or die "Cannot open output";`
		292	`print FH "digraph world {\n";`
		293	`print FH "\trankdir=LR;\n";`
		294	`print FH "\tnode[fontsize=24];\n";`
		295	`print FH "\t{root=", pentry($pv_id), "; }\n";`
		296
		297
		298	`foreach my $entry ( sort keys(%AllUsedBy) )`
		299	`{`
		300	`my $ref = $UsedBy{$entry};`
		301	`print FH "\t", pentry($entry) ," -> { ", plist ( ' ; ', @{$ref} ), " }\n";`
		302	`}`
		303
		304
		305	`print FH "\n};\n";`
		306	`close FH;`
		307
		308	`#`
		309	`# Convert DOT to a SVG`
		310	`#`
		311	`system( "dot $filebase.dot -Tjpg -o$filebase.jpg -v" );`
		312	`system( "dot $filebase.dot -Tsvg -o$filebase.svg -v" );`
		313
		314	`#`
		315	`# Complete used-by tree`
		316	`#`
		317	`##foreach my $entry ( sort keys(%AllUsedBy) )`
		318	`##{`
		319	`## my $pvid = $GINDEX{$entry};`
		320	`### print "$entry, $pvid\n";`
		321	`## my $pkg = \%{$GDATA{$pvid}};`
		322	`##`
		323	`## my $label = $pkg->{label};`
		324	`## my $path = $pkg->{path};`
		325	`## $path =~ tr~\\/~/~s;`
		326	`### printf ( "%40s %15s %50s %s\n", $pkg->{name}, $pkg->{version}, $pkg->{label}, $path);`
		327	`## print ( "jats extract $label -path=$path\n");`
		328	`##`
		329	`##}`
		330
		331	`#`
		332	`# Directly used by`
		333	`#`
		334	`#DebugDumpData ("UsedBy:$pv_id", \$UsedBy{$pv_id} ); exit(1);`
		335	`foreach my $entry ( sort @{$UsedBy{$pv_id}} )`
		336	`{`
		337	`my $pvid = $GINDEX{$entry};`
		338	`# print "$entry, $pvid\n";`
		339	`my $pkg = \%{$GDATA{$pvid}};`
		340
		341	`my $label = $pkg->{label};`
		342	`my $path = $pkg->{path};`
		343	`$path =~ tr~\\/~/~s;`
		344	`# printf ( "%40s %15s %50s %s\n", $pkg->{name}, $pkg->{version}, $pkg->{label}, $path);`
		345	`print ( "jats extract -root=. $label -path=$path\n");`
		346
		347	`}`
		348
		349	`exit;`
		350
		351
		352	`#-------------------------------------------------------------------------------`
		353	`# Function : plist`
		354	`#`
		355	`# Description : Generate an entry list as text`
		356	`# Replace "." with "_" since DOT doesn't like .'s`
		357	`# Seperate the arguments`
		358	`#`
		359	`# Inputs : $pref - Prefix string`
		360	`# @_ - An array of entries to process`
		361	`#`
		362	`# Returns : A string`
		363	`#`
		364	`sub plist`
		365	`{`
		366	`my $pref = shift;`
		367	`my $result = "";`
		368	`foreach ( @_ )`
		369	`{`
		370	`my $x = $_;`
		371	`$x =~ s~\.~_~g;`
		372	`$result .= '"' . $x . '"' . $pref;`
		373	`}`
		374	`return $result;`
		375	`}`
		376
		377	`sub pentry`
		378	`{`
		379
		380	`my $result = "";`
		381	`foreach ( @_ )`
		382	`{`
		383	`my $x = $_;`
		384	`$x =~ s~\.~_~g;`
		385	`$result .= '"' . $x . '"'`
		386	`}`
		387	`return $result;`
		388	`}`
		389
		390

Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/LOCAL/jats_rm_play10.pl – Rev 5710