Rev 5709 | Blame | Compare with Previous | Last modification | View Log | RSS feed
######################################################################### COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.## Module name : cc2svn_gendata.pl# Module type : Makefile system# Compiler(s) : Perl# Environment(s): jats## Description : Get all packages that are used in all releases# Create a data file that can be used offline## The process will exclude some old releases## Generate data on Essential Package Versions to be# transferred from CC to Subversion##......................................................................#require 5.006_001;use strict;use warnings;use JatsError;use JatsSystem;use Getopt::Long;use Pod::Usage; # required for help supportuse JatsRmApi;use ConfigurationFile;use DBI;use HTTP::Date;my $VERSION = "1.2.3"; # Update thismy $opt_verbose = 0;my $opt_help = 0;my $opt_manual;my $opt_test;my $opt_limit;my $opt_quick;my $opt_mode = '';my $RM_DB;my $now = time();## Package information#my %Releases;my %Packages;my %Suffixes;my @StrayPackages;my %AllPackages;my $doAllReleases = 0;my $doIncludeOnly = 0;my @includedProjects = (# 481, # UK BUS HOPS);my @includedReleases = (6222, # HOME > UK STAGE COACH (SSW) > Mainline14503, # HOME > UK STAGE COACH (SSW) > ITSO_HOPS_321303, # HOME > UK STAGE COACH (SSW) > SUPPORT_HOPS_REPORTS21343, # HOME > UK STAGE COACH (SSW) > SUPPORT_CIPP17223, # HOME > UK STAGE COACH (SSW) > ITSO HOPS 421864, # Hops3.6'22303 # Hops3.7);my @excludeProjects = ( 162, # WASHINGTON (WDC)341, # TUTORIAL (TUT)142, # SYDNEY (SYD)182 , # ROME (ROM)6 , # GMPTE/PCL (GMP)521, # NSW CLUB CARD221, # NZ STAGE COACH (NZS)82, # LVS42, # SFO# 641, # BCC Releaeses62, # OSLO4, # Singapore441, # Tas102, # Ventura);my @excludeReleases = ( 20424, # MASS_REF (MAS) > test# RJACK 9043, # TECHNOLOGY GROUP > Development Environment - For Test Setup# RJACK 14383, # TECHNOLOGY GROUP > eBrio TDS# RJACK 20463, # TECHNOLOGY GROUP > TPIT - BackOffice Linux build# RJACK 14603, # TECHNOLOGY GROUP > TPIT - BackOffice 64 bit [CCB Mode!]#9263, # TECHNOLOGY GROUP > Buildtool DEVI&TEST22163, # GLOBAL PRODUCT MGMT > Rio Tinto - Remote Draught Survey19483, # SEATTLE (SEA) > Phase 2 - I18 [backup] [Restrictive Mode]20403, # SEATTLE (SEA) > Phase 2 - I19 [backup]20983, # ??? May have been deleted13083, # TECHNOLOGY GROUP > TRACS15224, # 64Bit Solaris Test);my %sillyVersions =('2b6' => '2.6.0.cots','1.0b2' => '1.0.2.cots','1.6.x' => '1.6.0.cots','3.5beta12.5' => '3.5.12.5.cots','1.0b1.1.mas' => '1.1.1.mas',);my %suffixFixup = ('.sf' => '.sfo','.vt' => '.vtk','.lv' => '.lvs','.was' => '.wdc','.uk.1' => '.uk','.ssts.demo' => '.ssts','.u244.syd' => '.syd','.pxxx.sea' => '.sea','.pxxx.syd' => '.syd','.pxxx.sydddd' => '.syd','.oslo' => '.oso',);#-------------------------------------------------------------------------------# Function : Main Entry## Description :## Inputs :## Returns :#my $result = GetOptions ("help+" => \$opt_help, # flag, multiple use allowed"manual" => \$opt_manual, # flag"verbose+" => \$opt_verbose, # flag"test:s" => \$opt_test, # Test a version string"limit:n" => \$opt_limit, #"quick" => \$opt_quick, # Don't look for indirects'mode:s' => \$opt_mode, # Mode of operation);## 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' =>'CC2SVN_GENDATA' );if ( $opt_test ){my @results = massageVersion( $opt_test, 'DummyName' );Message ("Version", $opt_test, @results);exit 1;}## Set up the mode# Must be specified#if ( $opt_mode eq 'all' ) {$doAllReleases = 1;$doIncludeOnly = 0;} elsif ( $opt_mode eq 'hops' ) {$doAllReleases = 0;$doIncludeOnly = 1;} elsif ( $opt_mode eq 'standard' ) {$doAllReleases = 0;$doIncludeOnly = 0;} else {Error ("Mode not specified: all, hops, standard");}GetAllPackageNames();getPackagesInSvn();getReleaseDetails();getPkgDetailsByRTAG_ID();my ($pcount, $vcount) = countPackages();print "Directly referenced Packages: $pcount Versions: $vcount\n";LocateStrays() unless ($opt_quick);($pcount, $vcount) = countPackages();print "Indirectly referenced Packages: $pcount Versions: $vcount\n";getSourcePaths();processData();outputData();if ( $opt_verbose > 1 ){print "=========================================================================\n";DebugDumpData("Releases", \%Releases);print "=========================================================================\n";DebugDumpData("Packages", \%Packages );print "=========================================================================\n";DebugDumpData("Suffixes", \%Suffixes );}($pcount, $vcount) = countPackages();print "Total References Packages: $pcount Versions: $vcount\n";exit;#-------------------------------------------------------------------------------# Function : getPackagesInSvn## Description : Determine packages that have been migrated# Done by looking up RM for any version that has been migrated## Inputs :## Returns :#sub getPackagesInSvn{my (@row);# if we are not or cannot connect then return 0 as we have not found anythingconnectRM(\$RM_DB) unless $RM_DB;# First get all packages that are referenced in a Release# This will only get the top level packages# From non-archived releasesmy $m_sqlstr = "SELECT UNIQUE" ." pv.PKG_ID ". #[0]" FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv"." WHERE pv.VCS_TYPE_ID=23";my $sth = $RM_DB->prepare($m_sqlstr);if ( defined($sth) ){if ( $sth->execute( ) ){# print "--- Execute\n";if ( $sth->rows ){#print "--- Execute ROWS\n";while ( @row = $sth->fetchrow_array ){my $id = $row[0];next unless ( $id );$AllPackages{$id}{inSvn} = 1;#print "Data: @row\n";}}# print "--- Finish\n";$sth->finish();}else{Error("Execute failure: $m_sqlstr", $sth->errstr() );}}else{Error("Prepare failure" );}}#-------------------------------------------------------------------------------# Function : getReleaseDetails## Description : Determine all candiate releases## Inputs :## Returns :#sub getReleaseDetails{my (@row);# if we are not or cannot connect then return 0 as we have not found anythingconnectRM(\$RM_DB) unless $RM_DB;# First get all packages that are referenced in a Release# This will only get the top level packages# From non-archived releasesmy $m_sqlstr = "SELECT prj.PROJ_NAME, rt.RTAG_NAME, rt.PROJ_ID, rt.RTAG_ID, rt.official" ." FROM release_manager.release_tags rt, release_manager.projects prj" ." WHERE prj.PROJ_ID = rt.PROJ_ID " .# " AND rt.official != 'A' ".# " AND rt.official != 'Y'" ." order by prj.PROJ_NAME";my $sth = $RM_DB->prepare($m_sqlstr);if ( defined($sth) ){if ( $sth->execute( ) ){# print "--- Execute\n";if ( $sth->rows ){# print "--- Execute ROWS\n";while ( @row = $sth->fetchrow_array ){my $rtag_id =$row[3];my $proj_id = $row[2];$Releases{$rtag_id}{pName} = $row[0];$Releases{$rtag_id}{name} = $row[1];$Releases{$rtag_id}{proj_id} = $proj_id;$Releases{$rtag_id}{rtag_id} = $rtag_id;$Releases{$rtag_id}{official} = $row[4];unless ( $doAllReleases ){if (grep {$_ eq $proj_id} @excludeProjects) {$Releases{$rtag_id}{excluded} = 'E';}if (grep {$_ eq $rtag_id} @excludeReleases) {$Releases{$rtag_id}{excluded} = 'E';}}if ( $doIncludeOnly ){if (grep {$_ eq $proj_id} @includedProjects){delete $Releases{$rtag_id}{excluded};}else{$Releases{$rtag_id}{excluded} = 'E';}if (grep {$_ eq $rtag_id} @includedReleases){delete $Releases{$rtag_id}{excluded};}}unshift @row, $Releases{$rtag_id}{excluded} || ' ';print join (',',@row), "\n" if ($opt_verbose);}}# print "--- Finish\n";$sth->finish();}else{Error("Execute failure: $m_sqlstr", $sth->errstr() );}}else{Error("Prepare failure" );}}sub getPkgDetailsByPVID{my (@plist) = @_;my (@row);## Only do once## return if ( exists $Packages{$pv_id}{name} );# if we are not or cannot connect then return 0 as we have not found anythingconnectRM(\$RM_DB) unless $RM_DB;my $m_sqlstr = "SELECT" ." pv.PV_ID, ". #[0]" pkg.PKG_NAME, ". #[1]" pv.PKG_VERSION, ". #[2]" pv.DLOCKED," . #[3]" release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), ". #[4]" pv.PKG_ID," . #[5]" pv.MODIFIED_STAMP, ". #[6]" pv.CREATOR_ID ". #[7]" FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv,"." RELEASE_MANAGER.PACKAGES pkg "." WHERE pv.PKG_ID = pkg.PKG_ID "." AND pv.PV_ID in ( " . join(',', @plist) . " )" ;my $sth = $RM_DB->prepare($m_sqlstr);if ( defined($sth) ){if ( $sth->execute( ) ){# print "--- Execute\n";if ( $sth->rows ){# print "--- Execute ROWS\n";while ( @row = $sth->fetchrow_array ){print join (',',@row), "\n" if ($opt_verbose);my $pvid = $row[0];my $pkgid = $row[5];$Packages{$pvid}{name} = $row[1];next if ( exists $Packages{$pvid}{version} );$Packages{$pvid}{version} = $row[2];$Packages{$pvid}{locked} = $row[3];$row[4] =~ tr~\\/~/~;$Packages{$pvid}{vcstag} = $row[4];$Packages{$pvid}{pkgid} = $pkgid;# $Packages{$pvid}{tlp} = 1;($Packages{$pvid}{suffix}, $Packages{$pvid}{fullVersion},$Packages{$pvid}{isaRipple} ) = massageVersion( $Packages{$pvid}{version}, $Packages{$pvid}{name} );$Suffixes{$Packages{$pvid}{suffix}}++;$Packages{$pvid}{Age} = ($now - str2time( $row[6] )) / (60 * 60 * 24);$Packages{$pvid}{Creator} = $row[7];$AllPackages{$pkgid}{essential} = 1;}}# print "--- Finish\n";$sth->finish();}else{Error("getPkgDetailsByPVID:Execute failure: $m_sqlstr", $sth->errstr() );}}else{Error("getPkgDetailsByPVID:Prepare failure" );}}sub getPkgDetailsByRTAG_ID{my (@row);my $excludes = '';my $count = 0;# if we are not or cannot connect then return 0 as we have not found anythingconnectRM(\$RM_DB) unless $RM_DB;Message ("Extract toplevel dependencies");# First get all packages that are referenced in a Release# This will only get the top level packages# From non-archived releasesunless ($doAllReleases){foreach ( @excludeProjects ){$excludes .= " AND prj.PROJ_ID != $_ ";}foreach ( @excludeReleases ){$excludes .= " AND rt.RTAG_ID != $_ ";}}my $m_sqlstr = "SELECT DISTINCT " ."pv.PV_ID, " . #[0]"pkg.PKG_NAME, " . #[1]"pv.PKG_VERSION, " . #[2]"pv.DLOCKED, " . #[3]"release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), " . #[4]"pv.PKG_ID," . #[5]"rt.RTAG_ID, " . #[6]"rmv.VIEW_NAME, " . #[7]"pv.MODIFIED_STAMP, " . #[8]"prj.PROJ_ID, " . #[9]"pv.CREATOR_ID " . #[10]" FROM RELEASE_MANAGER.RELEASE_CONTENT rc, RELEASE_MANAGER.PACKAGE_VERSIONS pv,"." RELEASE_MANAGER.PACKAGES pkg, release_manager.release_tags rt, release_manager.projects prj" ." , release_manager.views rmv" ." WHERE rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID" ." AND rmv.VIEW_ID = rc.BASE_VIEW_ID" ." AND prj.PROJ_ID = rt.PROJ_ID and rt.RTAG_ID = rc.RTAG_ID" .# " AND rt.official != 'A'" .# " AND rt.official != 'Y' " .$excludes ." order by pkg.PKG_NAME";my $sth = $RM_DB->prepare($m_sqlstr);if ( defined($sth) ){if ( $sth->execute( ) ){# print "--- Execute\n";if ( $sth->rows ){# print "--- Execute ROWS\n";while ( @row = $sth->fetchrow_array ){$count++;print join (',',@row), "\n" if ($opt_verbose);my $pvid = $row[0];unless ( exists $Packages{$pvid}{name} ){my $pkgid = $row[5];$Packages{$pvid}{name} = $row[1];$Packages{$pvid}{version} = $row[2];$Packages{$pvid}{locked} = $row[3];$row[4] =~ tr~\\/~/~;$Packages{$pvid}{vcstag} = $row[4];$Packages{$pvid}{pkgid} = $pkgid;$Packages{$pvid}{tlp} = 1;($Packages{$pvid}{suffix}, $Packages{$pvid}{fullVersion},$Packages{$pvid}{isaRipple} ) = massageVersion( $Packages{$pvid}{version}, $Packages{$pvid}{name} );$Suffixes{$Packages{$pvid}{suffix}}++;$AllPackages{$pkgid}{essential} = 1;push @StrayPackages, $pvid;}my $rtag_id = $row[6];push @{$Packages{$pvid}{release}}, $rtag_id;$Packages{$pvid}{view}{$row[7]}++ if ( $row[7] );$Packages{$pvid}{Age} = ($now - str2time( $row[8] )) / (60 * 60 * 24);$Packages{$pvid}{Creator} = $row[10];my $proj_id = $row[9];push @{$Packages{$pvid}{projects}}, $proj_idunless (grep {$_ eq $proj_id} @{$Packages{$pvid}{projects}});if ( $doIncludeOnly ){if (grep {$_ eq $proj_id} @includedProjects){$Packages{$pvid}{NamedProject} = 1;}if (grep {$_ eq $rtag_id} @includedReleases){$Packages{$pvid}{NamedProject} = 2;}}else{$Packages{$pvid}{NamedProject} = 3;}if ( $opt_limit ){last if ( $count > $opt_limit );}}}# print "--- Finish\n";$sth->finish();}else{Error("Execute failure: $m_sqlstr", $sth->errstr() );}}else{Error("Prepare failure" );}Message ("Extract toplevel dependencies: $count rows");}#-------------------------------------------------------------------------------# Function : GetDepends## Description :## Inputs : @plist - list of pvid's to process## Returns :#sub GetDepends{my (@plist) = @_;## Ensure we have package information#getPkgDetailsByPVID( @plist );# return if ( $Packages{$pv_id}{depend} );# $Packages{$pv_id}{depend} = 1;## Now extract the package dependacies# There may not be any#my $m_sqlstr = "SELECT "." pd.PV_ID, "." pd.DPV_ID " ." FROM RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd "." WHERE pd.PV_ID in ( " . join(',', @plist) . " )";my $sth = $RM_DB->prepare($m_sqlstr);if ( defined($sth) ){if ( $sth->execute( ) ){if ( $sth->rows ){while ( my @row = $sth->fetchrow_array ){my $pvid = $row[0];my $dpvid = $row[1];push @StrayPackages, $dpvid;push @{$Packages{$dpvid}{usedBy}}, $pvid;}}$sth->finish();}else{Error("GetDepends:Execute failure: $m_sqlstr", $sth->errstr() );}}else{Error("GetDepends:Prepare failure" );}}#-------------------------------------------------------------------------------# Function : GetAllPackageNames## Description :## Inputs : None## Returns :#sub GetAllPackageNames{# if we are not or cannot connect then return 0 as we have not found anythingconnectRM(\$RM_DB) unless $RM_DB;## Now extract all the package names#my $m_sqlstr = "SELECT pkg.PKG_ID, pkg.PKG_NAME" ." FROM RELEASE_MANAGER.PACKAGES pkg";my $sth = $RM_DB->prepare($m_sqlstr);if ( defined($sth) ){if ( $sth->execute( ) ){if ( $sth->rows ){while ( my @row = $sth->fetchrow_array ){my $id = $row[0];my $name = $row[1];next unless ( $id );$AllPackages{$id}{name} = $name;}}$sth->finish();}else{Error("GetAllPackageNames:Execute failure: $m_sqlstr", $sth->errstr() );}}else{Error("GetAllPackageNames:Prepare failure" );}}#-------------------------------------------------------------------------------# Function : getSourcePaths## Description : Get source paths for all packages# Really only want those not in SVN## Inputs : Globals## Returns : Globals#sub getSourcePaths{Message("Get source paths for all packages");# if we are not or cannot connect then return 0 as we have not found anythingconnectRM(\$RM_DB) unless $RM_DB;## Process on blocks for speed#my @needed;foreach my $pkgid ( keys %AllPackages, 0 ){if ( $pkgid ){next unless ( exists $AllPackages{$pkgid}{essential} );next if ( $AllPackages{$pkgid}{inSvn} );$AllPackages{$pkgid}{essential} = 2;push @needed, $pkgid;#print "= $pkgid, $AllPackages{$pkgid}{name}\n";}## Have enough for a query#if ( scalar @needed > 100 || (! $pkgid && scalar @needed > 0) ){## Now extract all the source paths#my $m_sqlstr = "SELECT UNIQUE" ." pv.PKG_ID, ". #[0]" pv.SRC_PATH, ". #[1]" pv.VCS_TYPE_ID ". #[2]" FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv"." WHERE pv.PKG_ID in (" . join(',', @needed) . ")";my $sth = $RM_DB->prepare($m_sqlstr);if ( defined($sth) ){if ( $sth->execute( ) ){if ( $sth->rows ){while ( my @row = $sth->fetchrow_array ){#print "--- @row\n";my $pkgid = $row[0];my $type = $row[2] || '2';if ( $row[1] ){## Trivial cleanup#my $path = '/' . $row[1]; # Force initial /$path =~ tr~\\/~/~s; # Force / and single /$path =~ s~/+$~~; # Remove Trailing /$AllPackages{$pkgid}{srcPath}{$path}++;}}}$sth->finish();}else{Error("getSourcePaths:Execute failure: $m_sqlstr", $sth->errstr() );}}else{Error("getSourcePaths:Prepare failure" );}## Reset the list#@needed = ();}}}#-------------------------------------------------------------------------------# Function : massageVersion## Description : Process a version number and return usful bits## Inputs : Version Number# Package Name - debug only## Returns : An array# suffix# multipart version string useful for text comparisons#sub massageVersion{my ($version, $name) = @_;my ($major, $minor, $patch, $build, $suffix);my $result;my $buildVersion;my $isaRipple;my $isaWIP;$build = 0;#print "--- $name, $version\n";$version =~ s~^_~~;$version =~ s~^\Q${name}\E_~~;## Pre-massage some silly ones#if ( exists $sillyVersions{$version} ) {$version = $sillyVersions{$version};}if ( $name eq 'ReleaseName' ) {$version =~ s~[a-z]~.~g;$version =~ s~\.+~.~g;$version =~ s~\.$~~g}## xxxxxxxxx.nnnn.cots#if ( $version =~ m~(.*)\.cots$~ ) {my $cots_base = $1;$suffix = '.cots';if ( $version =~ m~(.*?)\.([0-9]{4})\.cots$~ ){$result = $1 . sprintf (".%4.4d", $2) . $suffix;}else{$result = $cots_base . '.0000.cots';}}## Convert version into full form for comparisions# nnn.nnn.nnn.[p]nnn.xxx# nnn.nnn.nnn.[p]nnn-xxx# nnn.nnn.nnn-[p]nnn.xxx# nnn.nnn.nnn-[p]nnn-xxx# nnn.nnn.nnn[p]nnn-xxx# Don't flag as ripples - they are patches#elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-.p][p]?(\d+)([-.](.*))?$~ ) {$major = $1;$minor = $2;$patch = $3;$build = $4;$suffix = defined $6 ? ".$6" : '';$isaRipple = 0;}## nn.nnn.nnnnn.xxx# nn.nnn.nnnnn-xxx# nnn.nnn.nnnx.xxx# Don't flag as ripples - they are patches#elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)\w?([-.](.*))?$~ ) {$major = $1;$minor = $2;$patch = $3;if ( length( $patch) >= 4 ){$build = substr( $patch, -3 ,3);$patch = substr( $patch, 0 ,length($patch)-3);}$suffix = defined $5 ? ".$5" : '';}## nnn.nnn.nnn# nnn.nnn-nnn# nnn.nnn_nnn#elsif ( $version =~ m~^(\d+)\.(\d+)[-._](\d+)$~ ) {$major = $1;$minor = $2;$patch = $3;$suffix = '';}## nnn.nnn.nnn.nnn# nnn.nnn.nnn-nnn# nnn.nnn.nnn_nnn#elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-._](\d+)$~ ) {$major = $1;$minor = $2;$patch = $3;$build = $4;$suffix = '';$isaRipple = 0;}## nnn.nnn#elsif ( $version =~ m~^(\d+)\.(\d+)$~ ) {$major = $1;$minor = $2;$patch = 0;$suffix = '';}## nnn.nnn.xxx#elsif ( $version =~ m~^(\d+)\.(\d+)(\.\w+)$~ ) {$major = $1;$minor = $2;$patch = 0;$suffix = $3;}## nnn.nnn.nnnz#elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)([a-z])$~ ) {$major = $1;$minor = $2;$patch = $3;$build = ord($4) - ord('a');$suffix = '.cots';$isaRipple = 0;}## ???REV=???#elsif ( $version =~ m~REV=~ ) {$suffix = '.cots';$result = $version . '.0000.cots';}## Wip Packages# (nnnnnn).xxx# Should be essential, but want to sort very low#elsif ($version =~ m~\((.*)\)(\..*)?~) {$suffix = $2 || '';$result = "000.000.000.000$suffix";$isaWIP = 1;}## !current#elsif ($version eq '!current' || $version eq 'current_$USER' || $version eq 'current' || $version eq 'beta' || $version eq 'latest' || $version eq 'beta.cr' || $version eq 'CREATE') {$suffix = '';$result = "000.000.000.000$suffix";$isaWIP = 1;}## Also WIP: FINRUN.103649.BEI.WIPelsif ($version =~ m~(\.[a-zA-Z]+)\.WIP$~) {$suffix = lc($1);$result = "000.000.000.000$suffix";$isaWIP = 1;}## Also ERGOFSSLS190100_015# Don't flag as a rippleelsif ($version =~ m~^ERG[A-Z]+(\d\d)(\d\d)(\d\d)[-_](\d+)(\.\w+)?$~) {$major = $1;$minor = $2;$patch = $3;$build = $4;$suffix = $5 || '.sls';$isaRipple = 0;}## Stuff we don't yet handle#else {Warning ("Unknown version number: $name,$version");$version =~ m~(\.\w+)$~;$suffix = $1 || '';$result = $version;}$isaRipple = ($build > 0) unless defined $isaRipple;unless ( $result ){# Major and minor of 99.99 are normally funny versions# Don't make important decisions on them#if (defined $major && defined $minor && $major == 99 && $minor == 99 ){$major = 0;$minor = 0;$patch = 0;}$result = sprintf("%3.3d.%3.3d.%3.3d.%3.3d%s", $major,$minor,$patch,$build,$suffix || '.0000');$buildVersion = [ $major, $minor, $patch, $build ];}$suffix = lc( $suffix );if ( exists $suffixFixup{$suffix} ){$suffix = $suffixFixup{$suffix} ;}return ($suffix, $result, $isaRipple, $isaWIP, $buildVersion );}#-------------------------------------------------------------------------------# Function : LocateStrays## Description : Locate stray packages# Try to do several at a time to speed up processing## Inputs :## Returns :#sub LocateStrays{Message ("Locate indirectly referenced packages");while ( $#StrayPackages >= 0 ){#print "Strays Remaining: ", scalar @StrayPackages ,"\n";my @plist;while ( $#plist <= 200 && @StrayPackages ){my $pv_id = pop @StrayPackages;next if ( exists $Packages{$pv_id}{done} );push @plist, $pv_id;}GetDepends(@plist) if @plist;foreach ( @plist){$Packages{$_}{done} = 1;}}}#-------------------------------------------------------------------------------# Function : countPackages## Description :## Inputs :## Returns : Number of packages and number oof versions#sub countPackages{my $v = 0;my $p = 0;my %names;foreach ( keys %Packages ){my $name = $Packages{$_}{name};next unless ( $name );$names{$name} = 1;$v++;}$p = keys %names;return $p,$v;}#-------------------------------------------------------------------------------# Function : processData## Description : Process data before its written out# Remove a few packages that we do not want to now about# Determine Reason that a version is in the list# Finish taging packages in NamedProject## Inputs :## Returns :#sub processData{foreach ( keys %Packages ){delete $Packages{$_}{done};next if ( $Packages{$_}{name} =~ ~m~CSWcfengine~ );if ($Packages{$_}{name} eq 'Activestate Perl - Solaris'){delete $Packages{$_};next;}if ( $Packages{$_}{name} =~ m/^CSW/ || $Packages{$_}{name} =~ m/^Solaris$/){delete $Packages{$_};next;}if ( $Packages{$_}{name} =~ m/^jats_/){delete $Packages{$_};next;}## Catch packages that are dependents of NamedProject's#if ( $doIncludeOnly ){if ( exists $Packages{$_}{'sbomBase'} || exists $Packages{$_}{'sbomOsid'} ){$Packages{$_}{NamedProject} = 4;}unless ( $Packages{$_}{NamedProject} ){my $named;my %usedBy;if ( exists $Packages{$_}{'usedBy'}){my @examineThese = @{$Packages{$_}{'usedBy'}};while ( @examineThese ){my $pvid = pop @examineThese;next if ( $usedBy{$pvid} );if ( $Packages{$pvid}{NamedProject} ){$named = 1;last;}push @examineThese, @{$Packages{$pvid}{'usedBy'}}if (exists $Packages{$pvid}{'usedBy'});}$Packages{$_}{NamedProject} = 5if ( $named );}# else# {# Warning("Not Named and not usedBy: $Packages{$_}{name} $Packages{$_}{'version'}");# }}}else{$Packages{$_}{NamedProject} = 6;}}}#-------------------------------------------------------------------------------# Function : outputData## Description : Write out data in a form to allow post processing## Inputs :## Returns :#sub outputData{my $file = "cc2svn.raw.txt";Message ("Create: $file");my $fh = ConfigurationFile::New( $file );$fh->DumpData("\n# Releases.\n#\n","ScmReleases", \%Releases );$fh->DumpData("\n# Packages.\n#\n","ScmPackages", \%Packages );$fh->DumpData("\n# Suffixes.\n#\n","ScmSuffixes", \%Suffixes );$fh->DumpData("\n# All Package Names.\n#\n","ScmAllPackages", \%AllPackages );## Close out the file#$fh->Close();# ## # Split up package data into small files for easy consumption# ### foreach ( keys %Packages )# {# my $file = "cc2svn.raw.${_}.txt";# Message ("Create: $file");# my $fh = ConfigurationFile::New( $file );## $fh->DumpData(# "\n# Releases.\n#\n",# "ScmReleases", \$Packages{$_} );# $fh->Close();# }}#-------------------------------------------------------------------------------# Documentation#=pod=for htmltoc SYSUTIL::cc2svn::=head1 NAMEcc2svn_gendata - Extract CC2SVN Essential Package Data from Release Manager=head1 SYNOPSISjats cc2svn_gendata [options]Options:-help - brief help message-help -help - Detailed help message-man - Full documentation-test=version - Test a version string, then exit-limit=n - Limit packages processed. Test only-mode=xxx - Set Mode: all, hops, standard=head1 OPTIONS=over 8=item B<-help>Print a brief help message and exits.=item B<-help -help>Print a detailed help message with an explanation for each option.=item B<-man>Prints the manual page and exits.=item B<-test=version>Examine a package version string and report how the tool will parse it.=item B<-limit=n>Limit the number of packages processed by the tool. This is only used tosimplify testing of the program=back=head1 DESCRIPTIONThis program is a tool used in the conversion of ClearCase VOBS to subversion.It will:=over 8=item *Determine all Releases in Release manager and mark those thatare to be excluded.=item *Determine all the package-versions used by the releases that arenot excluded. These are called 'direct' dependencies.=item *Recursively find all the dependent packages of all packages. New packageversions are called 'indirect' dependencies. They are buried. This process cantake several minutes.=backThe data collected is dumped into a text file for later processing.=cut