Rev 2026 | Blame | Compare with Previous | Last modification | View Log | RSS feed
#! perl######################################################################### Copyright ( C ) 2004 ERG Limited, All rights reserved## Module name : jats.sh# Module type : Makefile system# Compiler(s) : n/a# Environment(s): jats## Description : Walk compete dependency tree to locate unused packages## Currently hard coded to NZ STAGE COACH (NZS) > Phase 1## Usage:## Version Who Date Description##......................................................................#require 5.006_001;use strict;use warnings;use JatsError;use JatsSystem;use Getopt::Long;use Pod::Usage; # required for help supportuse JatsRmApi;use DBI;my $VERSION = "1.2.3"; # Update thismy $opt_verbose = 1;my $opt_help = 0;my $opt_manual;my $opt_rtag_id = 2641; # 2641 : NZ STAGE COACH (NZS) > Phase 1my $opt_no_ver = 1;my $RM_DB;## Package information#my %Package;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_id=s" => \$opt_rtag_id, # string"ignorever!" => \$opt_no_ver, # [no]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));ErrorConfig( 'name' =>'PLAY14' );Error ("No RTAGID specified") unless ( $opt_rtag_id );getPkgDetailsByRTAG_ID($opt_rtag_id);LocateStrays();LocatePackages();#DebugDumpData ("Package", \%Package );exit;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 anythingconnectRM(\$RM_DB);# First get details from pv_idmy $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] || '';if ($opt_no_ver){push @{$Package{$name}{'xxx'}{ver_list}}, $ver;$ver = 'xxx';}$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";$Package{$name}{$ver}{done} = 1;$Package{$name}{$ver}{base} = 1;$Package{$name}{$ver}{base_id} = $base_id;$Package{$name}{$ver}{deployable} = 1 if ($deployable);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];if ($opt_no_ver){push @{$Package{$name}{'xxx'}{ver_list}}, $ver;$ver = 'xxx';}push @depends, [ $name, $ver ];push @{$Package{$name}{$ver}{usedby}}, [ $pname, $pver ];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 : LocateStrays## Description :## Inputs :## Returns :#sub LocateStrays{while ( $#StrayPackages >= 0 ){my $DATA = pop @StrayPackages;my $name = $DATA->[0];my $ver = $DATA->[1];my $pv_id = $DATA->[2];next if ( exists $Package{$name}{$ver}{done} );GetDepends( $pv_id, $name, $ver );$Package{$name}{$ver}{done} = 1;}}#-------------------------------------------------------------------------------# Function : LocatePackages## Description : Locate Packages that are not used## Inputs :## Returns :#sub LocatePackages{# DebugDumpData ("Package", \%Package); exit 1;my @unused;foreach my $name ( keys %Package ){foreach my $ver ( keys %{$Package{$name}} ){next if ( exists $Package{$name}{$ver}{usedby} );## Ignore packages marked as deployable#next if ( exists $Package{$name}{$ver}{deployable} );## Kludge# Ignore PRODUCTS and AUTO_PRODUCTS#my $base_id = $Package{$name}{$ver}{base_id};next if ( $base_id eq 2067 );next if ( $base_id eq 2602 );# print "Unused Package: $name: $ver\n";if ($opt_no_ver){push @unused, "$name, @{$Package{$name}{'xxx'}{ver_list}}";}else{push @unused, "$name, $ver";}}}foreach (sort @unused ){print "Unused Package: $_\n";}}