Blame | Last modification | View Log | RSS feed
######################################################################### COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.## Module name : rmMerge_process.pl# Module type : JATS Utility# Compiler(s) : Perl# Environment(s): jats## Description :## Usage : See POD at the end of this file##......................................................................#require 5.008_002;use strict;use warnings;use Pod::Usage;use Getopt::Long;use JatsError;use JatsRmApi;use JatsSystem;use FileUtils;use ConfigurationFile;use File::Copy;use DBI;my $RM_DB;my $opt_reuse=1;my $opt_help=0;my $opt_verbose=0;my $opt_debug=0;my $opt_order;my $opt_type;my $opt_noShow = 0;my $opt_refresh;my $opt_commands;my @opt_rtagId;my $opt_dependents = 0;our %basePackageVersions;our %testPackageTip;our %usedBy;my %old;my %oldPnames;my %oldPackages;my %newPnames;my %new;my %essential;my %releaseContents;my %releaseNames;my %pvidLookup;my %pvidLookupOld;my %pulseImport;my %data;my %stats;my $VERSION = "1.0";my $SplitPvid = 1150630;my @essentialRtags = (34929, 37552, 6884, 37749 );my @EMVRtags = (34090,35929,36050,36151,36169,36172,36193,36212,36214,36216,36217,36249,36250,36270,36271,36272,36273,36309,36411,36589,36609,36749,36750,37229,37451,37695);my @essentialRtagsWhisp = (34929, 36551, 6886, 6884, 37229, 37451);my @xxxxessentialRtags = (34929, 37452, 37350, 37489, 37411, 37353, 37150, 37090, 36551, 37490, 37329,37369,37431, 37552);@essentialRtags = @EMVRtags;Message("Using EMV tags");my @oldEssential = (36969, 36689, 36754,36949,37289, 37230, 37110, 36970, 37030);my @oldRMCred = ('OLD', 'jdbc:oracle:thin:@auawsards001:1521:RELEASEM', 'RM_READONLY', 'RM_READONLY');my @newRMCred = ('NEW', 'jdbc:oracle:thin:@auawsards002:1521:RELEASEM', 'RM_READONLY', 'Tp8WmmDKMq2Z');my $oldFile = 'old_rm_export.txt';my $newFile = 'new_rm_export.txt';my $newVersions = 'essential_pkgs.txt';my $versionData = 'version_data.txt';my $rtagData = 'rtag_data.txt';my $rcData = 'rc_data.txt';my $localDataStore = "LocalData.txt";my $dirSame = 'data/same';my $dirDiff = 'data/diff';my $dirBuildDiff = 'data/build_diff';my $dirSkip = 'data/skip';my $dirBroken = 'data/broken';my $dirWork = 'data/work';my $dirLog = 'data/log';mkdir ('data');mkdir ($dirWork);mkdir ($dirLog);unlink 'stopfile';#-------------------------------------------------------------------------------# Function : Mainline Entry Point## Description :## Inputs :#my $result = GetOptions ("help:+" => \$opt_help,"manual:3" => \$opt_help,"verbose:+" => \$opt_verbose,"debug:+" => \$opt_debug,"reuse!" => \$opt_reuse,"order:n" => \$opt_order,"rtagid:n" => \@opt_rtagId,"type:s" => \$opt_type,"refresh!" => \$opt_refresh,"commands!" => \$opt_commands,"dependents!" => \$opt_dependents,);## UPDATE THE DOCUMENTATION AT THE END OF THIS FILE !!!### 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_help > 2 );#pod2usage(-verbose => 0, -message => "Version: $VERSION") if ( $#ARGV < 0 );## Configure the error reporting rmMerge_process now that we have the user options#ErrorConfig( 'name' =>'PROC','verbose' => $opt_verbose,'debug' => $opt_debug,);## Control output#if ($opt_order || $opt_type || $opt_commands) {$opt_noShow = 1;}# User the user provided list of rtags#if (@opt_rtagId){@essentialRtags = @opt_rtagId;my $prefix = join('-', sort @essentialRtags);$newVersions = join('-',$prefix,$newVersions);$versionData = join('-',$prefix,$versionData);$rtagData = join('-',$prefix,$rtagData );$rcData = join('-',$prefix,$rcData );}Message ("Process for: @essentialRtags");## Extract data from the database# Save to text files so that it can be reused#unless ($opt_reuse) {GetEssentialVersions( $newVersions, @newRMCred);#GetDataFromRM ($oldFile, 0, @oldRMCred );#GetDataFromRM ($newFile, 0, @newRMCred );GetRtagData($rtagData,@newRMCred);GetReleaseContents($rcData,@newRMCred);SuckReleaseContents();#unlink $localDataStore;} else {Message ("Reuse old data");}if ($opt_refresh) {GetDataFromRM ($oldFile, 0, @oldRMCred );GetDataFromRM ($newFile, 0, @newRMCred );}## Read in the database info from the text files# These must have been created from the database## $old. Hash of {$pname.$proj}{version} -> pvid(old),vcsPath#open (FH, '<', $oldFile) || Error("Cannot open $oldFile");while (<FH>) {my ($pvid, $pname, $pver, $vcs, $idext) = split(/\s+/,$_);$pver =~ m~(.*)\.(.*)$~;my $proj = $2;$pver = $1;# next unless $pver =~ m~000$~;$pver = 'NoVersion' unless defined $pver;$proj = 'noProj' unless defined $proj;my $key = $pname . '.' . $proj;$old{$key}{$pver} = join($;,$pvid, $vcs, $pname, $proj, $idext);$oldPnames{$key} = 1;$oldPackages{$pname} = 1;$pvidLookupOld{$pvid} = join($;, $key, $pname, $pver, $proj);# Capture PulseImport tags# Handle:# PulseImport# PulseImport.Branch.<BranchName>if ($idext =~ m/PulseImport/){if ( !exists($pulseImport{$key}) || $pvid > $pulseImport{$key}{pvid} ) {delete $pulseImport{$key};$pulseImport{$key}{pvid} = $pvid;if ($idext =~ m~PulseImport\.Branch\.(.*)~) {$pulseImport{$key}{branchName} = $1;}}}}## $new. Hash of {$pname.$proj}{version} -> pvid(new),vcsPath#open (FH, '<', $newFile) || Error("Cannot open $newFile");while (<FH>) {my ($pvid, $pname, $pver, $vcs, $idext) = split(/\s+/,$_);$pver =~ m~(.*)\.(.*)$~;my $proj = $2;$pver = $1;# next unless $pver =~ m~000$~;$pver = 'NoVersion' unless defined $pver;$proj = 'noProj' unless defined $proj;my $key = $pname . '.' . $proj;$new{$key}{$pver} = join($;,$pvid, $vcs, $pname, $proj, $idext);$newPnames{$key} = 1;$pvidLookup{$pvid} = join($;, $key, $pname, $pver, $proj);}#DebugDumpData("OLD", \%old);#DebugDumpData("NEW", \%new);### Import essential package data# A hash of pvid(new) -> dependencies# Need to handle those that don't have a dependency#open (FH, '<', $newVersions) || Error("Cannot open $newVersions");while (<FH>) {chomp;my ($pvid, $dpvid) = split(/\s+/,$_);$essential{$pvid} = {} unless exists $essential{$pvid};if (defined $dpvid) {$essential{$pvid}{$dpvid}=1;}}## Import Release Content Data# pvid(new) --> rtagId(new) with mode. Mode == 1 direct, Mode ==2 indirect#open (FH, '<', $rcData) || Error("Cannot open $rcData");while (<FH>) {chomp;my ($pvid, $rtagId, $mode) = split(/\s+/,$_);$releaseContents{$pvid}{$rtagId}=$mode}## Import Release Names# rtagId(new) --> name#open (FH, '<', $rtagData) || Error("Cannot open $rtagData");while (<FH>) {chomp;my ($rtagId, $name) = split(/\s+/,$_,2);$releaseNames{$rtagId}= $name}restoreLocalData();procData();saveLocalData();#-------------------------------------------------------------------------------# Function : SuckReleaseContents## Description :## Inputs :## Returns :sub SuckReleaseContents{foreach my $rtag ( @essentialRtags) {Message ("Serialise Release - $rtag");JatsCmd ('eprog', 'rmMerge_suckRelease.pl','-rtag', $rtag);}}#-------------------------------------------------------------------------------# Function : procData## Description : rmMerge_process the collected data## Inputs :## Returns :#sub procData{Message("Process Data");foreach my $pvid ( keys %essential) {Warning("No data in pvidLookup for $pvid") unless exists $pvidLookup{$pvid};}foreach my $pvid ( sort {uc $pvidLookup{$a} cmp uc $pvidLookup{$b}} keys %essential) {next unless exists $releaseContents{$pvid};## Examine this package#my ($key,$pname, $pver, $proj) = split($;, $pvidLookup{$pvid});$data{$key}{$pver}{pvid} = $pvid;$data{$key}{$pver}{proj} = $proj;$data{$key}{$pver}{txt} = "$pname $pver.$proj";$data{$key}{$pver}{ver} = "$pver.$proj";$stats{"Total Packages"} ++;## If the packageName.Proj does not exist in the old then its a simple transfer#if ( ! exists $releaseContents{$pvid} ) {$data{$key}{$pver}{state} = 'U'; # Not essential$stats{"Not Essential"}++;}elsif ( ! exists ($oldPackages{$pname}) ) {$data{$key}{$pver}{state} = 'N'; # New package$stats{"New Package"} ++;} elsif (! exists $old{$key}) {$data{$key}{$pver}{state} = 'n'; # New Project in an existing package$stats{"New Project"} ++;} elsif ($pvid < $SplitPvid ) {## PV is a pre-split version no work to be done#$data{$key}{$pver}{state} = 'P'; # Pre Clone version$stats{"Pre Clone"} ++;} elsif (! exists $old{$key}{$pver}) {## If the packageName.Proj does exist, but the version does not then# is a mostly simple transfer#$data{$key}{$pver}{state} = 'S'; # Not a clash$stats{"No Clash"} ++;} else {testPackage($key, $pver);$data{$key}{$pver}{state} = getState($key, $pver);$stats{"Total Clashes"} ++;$stats{"ClashMode-" . getState($key, $pver)}++;}}unless ($opt_noShow) {print("Packages to Merge\n");print("Keys: N: New Package, n:New Project, P:PreClone, S:No Clash, D:Diff, d: Build Diff, G:Identical in both, K:Skip Diff, U:unessential\n");foreach my $pname ( sort keys %data){foreach my $pver ( sort keys %{$data{$pname}}) {print(" ",$data{$pname}{$pver}{state}, ' ' ,$data{$pname}{$pver}{txt}, "\n");}}}#DebugDumpData("Data", \%data);DebugDumpData("Stats", \%stats) unless ($opt_noShow);print("Clashes to resolve\n");foreach my $pname ( sort keys %data){foreach my $pver ( sort keys %{$data{$pname}}) {next unless ($data{$pname}{$pver}{state} =~ m/[dD]/ );my ($oldPvid, $oldVcs, $oldPname, $oldProj) = split($;, $old{$pname}{$pver} );my $newPvid = $data{$pname}{$pver}{pvid};print(" ",$data{$pname}{$pver}{state}, " $pname, $pver (N:$newPvid, O:$oldPvid)\n");foreach my $rtagId (keys %{$releaseContents{$newPvid}} ) {my $mode = $releaseContents{$newPvid}{$rtagId} > 1 ? " [indirectly]": "";print(" Used by: $rtagId, $releaseNames{$rtagId}$mode\n");}if (my $usageData = GetUsedProjects($oldPvid,@oldRMCred)) {foreach my $entry ( @$usageData) {print(" Used by Old Release: $entry->[2], $entry->[1] - $entry->[3]\n");}}if (my $usageData = GetUsedSdks($oldPvid,@oldRMCred)) {foreach my $entry ( @$usageData) {print(" Used by Old SDK: $entry->[2], $entry->[1] - $entry->[3]\n");}}if (my $usageData = GetUsedSboms($oldPvid,@oldRMCred)) {foreach my $entry ( @$usageData) {print(" Used by Old SBOM: $entry->[2], $entry->[1] - $entry->[3]\n");}}}}## Examine packages that do exist in the old system to determine if they can be# merged to the SVN tip in the old system## Only need to rmMerge_process those package-versions that do not clash (S)# New 'projects' (n) may need to be branched#Verbose("Determine SVN branch needs\n");foreach my $pname ( sort keys %data){foreach my $pver ( sort keys %{$data{$pname}}) {if ($data{$pname}{$pver}{state} eq 'n' ) {$data{$pname}{$pver}{bstate} = 'F';$data{$pname}{$pver}{numChanges} = 0;next;}next unless ($data{$pname}{$pver}{state} =~ m/[S]/ );Verbose("Examine ($data{$pname}{$pver}{state}) $pname, $pver");my $bstate = '-';my $numChanges = 0;if ($numChanges = testPackageChanges($pname,$pver) ) {$bstate = testPackageTip($pname,$pver);}$data{$pname}{$pver}{bstate} = $bstate;$data{$pname}{$pver}{numChanges} = $numChanges;$data{$pname}{$pver}{branchVersion} = getBranchVersion($pname, $pver);}}unless ($opt_noShow) {print("SVN branching\n");print("Key. Col1: N: New Package, n:New Project, P:PreClone, S:No Clash, D:Diff, d: Build Diff, G:Identical in both, K:Skip Diff\n");print("Key. Col2 -: No Changes to old Repo, S:Tip Identical, D:Tip Diff, d: Tip Build Diff, F:Force Branch\n");print("Those marked as 'D' will need to be branched\n");my $branchCount = 0;foreach my $pname ( sort {uc $a cmp uc $b } keys %data){foreach my $pver ( sort {$data{$pname}{$a} cmp $data{$pname}{$b} } keys %{$data{$pname}}) {next unless (exists $data{$pname}{$pver}{bstate} );printf( " %s%s %3.3s %s %s\n",$data{$pname}{$pver}{state},$data{$pname}{$pver}{bstate}, $data{$pname}{$pver}{numChanges} , $pname, $pver);$branchCount++ if $data{$pname}{$pver}{bstate} =~ m/[DF]/;}}print("Number of branches: $branchCount\n");}############################################################################ Determine the rmMerge_processing order# Test essential data#foreach my $pvid ( keys %essential) {unless (exists $pvidLookup{$pvid} ) {ReportError ("PVID not in lookup: $pvid");}}ErrorDoExit();my %depOrder;my $order=0;my %depData;foreach my $pvid ( keys %essential) {$depData{$pvid} = {};foreach my $dpvid ( keys %{$essential{$pvid}}) {$depData{$pvid}{$dpvid} = 1;}}## Cleanup# Also delete those where we know the package has been transferred to the old Repo already#foreach my $key ( sort keys %data){foreach my $pver ( sort keys %{$data{$key}}) {next unless ( exists ($data{$key}{$pver}{state}));#next unless ( exists ($data{$key}{$pver}{bstate}));#next unless ($data{$key}{$pver}{bstate} =~ m~-~);next unless ($data{$key}{$pver}{state} =~ m~[PGK]~);delete $depData{$data{$key}{$pver}{pvid}} ;}}## First pass - remove dependencies that don't exists in the set# Hopefully these have already been rmMerge_processed#foreach my $pvid ( keys %depData) {foreach my $dpvid ( keys %{$depData{$pvid}} ) {delete $depData{$pvid}{$dpvid} unless exists( $depData{$dpvid});}}while (1) {$order++;my @found;last unless scalar keys %depData;# locate items that have no dependenciesforeach my $pvid ( keys %depData) {my @deps = keys %{$depData{$pvid}};unless (@deps) {$depOrder{$pvid} = $order;push @found, $pvid;delete $depData{$pvid};if (exists $pvidLookup{$pvid} ) {my ($key,$pname, $pver, $proj) = split($;, $pvidLookup{$pvid});if (exists ($data{$key}) && exists ($data{$key}{$pver})) {$data{$key}{$pver}{order} = $order;}}}}# Remove those items that have been rmMerge_processedforeach my $pvid (keys %depData) {foreach my $dpvid ( @found) {delete $depData{$pvid}{$dpvid};}}}## Print summary of what we have discovered#my $pkgCount = 0;my @commands;print("Packages to Merge\n");print("Col1 - Keys: N: New Package, -:New Project, P:PreClone, S:No Clash, D:Diff, d: Build Diff, G:Identical in both, K:Skip Diff\n");print("Col2 - Keys -: No Changes to old Repo, S:Tip Identical, D:Tip Diff, d: Tip Build Diff, F: Force Branch\n");print("Col3 - Increment Code\n");print("Col4 - Increment type\n");print("Col5 - Increment warning\n");print("Col6 - Insertion Order\n");print("Col7 - Number of changes in oldRm since split\n");print("Col8 - Package Name and Version\n");foreach my $pname ( sort { uc $a cmp uc $b } keys %data){foreach my $pver ( sort {uc $a cmp uc $b} keys %{$data{$pname}}) {## If filtering the order#if ($opt_order) {next unless exists $data{$pname}{$pver}{order};next unless (($data{$pname}{$pver}{order} <= $opt_order) || ($data{$pname}{$pver}{order} == -$opt_order));}if ($opt_type) {next unless ($data{$pname}{$pver}{proj} eq $opt_type);}if ($opt_commands) {if (exists $data{$pname}{$pver}{order}){push @commands, join($;, $data{$pname}{$pver}{order}, $data{$pname}{$pver}{txt} );}}$pkgCount++;## Determine branch point information# Display old version and branch name#my $bpText = "";my $it = "";if (exists($pulseImport{$pname})) {my ($okey,$opname, $opver, $oproj) = split($;, $pvidLookupOld{$pulseImport{$pname}{pvid}});$bpText = "$opver.$oproj ($pulseImport{$pname}{pvid})";if (exists($pulseImport{$pname}{branchName})) {$bpText .= " Branch:" . $pulseImport{$pname}{branchName};}my ($itype, $icode) = isVersionGreater($data{$pname}{$pver}{ver}, "$opver.$oproj");$it = $icode . $itype;if ($itype == 2 || $itype == 0) {$it .= '?';$stats{Warnings}++;}}printf(" %s%s %-3.3s %3.3s %3.3s %s , %s , %s\n",$data{$pname}{$pver}{state},$data{$pname}{$pver}{bstate} || ' ',$it || ' ',$data{$pname}{$pver}{order} || 'x',$data{$pname}{$pver}{numChanges} || ' ' ,$data{$pname}{$pver}{txt},$data{$pname}{$pver}{branchVersion} || '',$bpText);}}print("Packages displayed: $pkgCount\n");if ($opt_commands) {my $lastSort = '';foreach ( sort @commands) {my ($order, $text) = split($;, $_);if ($order ne $lastSort){$lastSort = $order;print("# Order: $order\n");}print("jats eprog rmMerge_migrate_package.pl $text\n");}}DebugDumpData("Stats", \%stats);#DebugDumpData("Data", \%data);#DebugDumpData("Essentials", \%essential);#DebugDumpData("depOrder", \%depOrder);}#-------------------------------------------------------------------------------# Function : testPackageChanges## Description : See if there have been any changes to a package in the OLD# RM since the clone## Inputs : $key (pname + proj)# $pver - version to test## Returns : Number of versions in the old RM created since the split#sub testPackageChanges{my ($key,$pver) = @_;my $found =0;foreach my $pver ( keys %{$old{$key}}) {my ($oldPvid, $oldVcs, $oldPname, $oldProj) = split($;, $old{$key}{$pver} );if ($oldPvid > $SplitPvid) {$found ++;}}return $found;}#-------------------------------------------------------------------------------# Function : getBranchVersion## Description : Determine the package-version in the old Release Manager that would# be a suitable branch point for this package-version## Assume:# For a given packageName/Extension determine the highest PVID before the split## Inputs : $key (pname + proj)# $pver - version to test## Returns : The package version in the old RM#sub getBranchVersion{my ($key,$pver) = @_;my $maxPvid = 0;my $maxPver;foreach my $pver ( keys %{$old{$key}}) {my ($oldPvid, $oldVcs, $oldPname, $oldProj) = split($;, $old{$key}{$pver} );if ($oldPvid <= $SplitPvid) {if ($oldPvid > $maxPvid) {$maxPvid = $oldPvid;$maxPver = $pver;}}}return $maxPver;}#-------------------------------------------------------------------------------# Function : testPackageTip## Description : Test a new packageVersion against the tip of the same package# in the old Repo. If there are only build file changes, then# its a simple merge.## Inputs : $key (pname + proj)# $pver - version to test## Returns : Diff Mode# 'D' - Code diff# 'd' - Build Diff# 'S' - Same# '?' - Error#sub testPackageTip{my ($key,$pver) = @_;my $rCode = "?";if (-f 'stopfile') {Error('StopFile detected');}if (exists $testPackageTip{$key}{$pver}) {return $testPackageTip{$key}{$pver};}my ($newPvid, $newVcs, $newPname, $newProj) = split($;, $new{$key}{$pver} );## Need to massage the newVcs to extract the tip of the package in the old system#my $oldVcs = $newVcs;$oldVcs =~ s~AUPERASVN02~AUPERASVN01~;$oldVcs =~ m~(.*)::~;$oldVcs = $1;my $pname = $key;my $version= $pver;print("Extract $pname $version, $oldVcs, $newVcs\n");my $oldName = join('_', $pname, $version, 'oldTip');my $newName = join('_', $pname, $version, 'new');my $diffLog = join('_', $pname, $version, 'tipDiff.txt');my $buildDiffLog = join('_', $pname, $version, 'BuildTipDiff.txt');my $oldView = catdir($dirWork,$oldName );my $newView = catdir($dirWork,$newName );my $diffLogPath = catfile($dirLog, $diffLog);my $buildDiffLogPath = catfile($dirLog, $buildDiffLog);JatsCmd('-logfile', catfile($dirLog, $oldName.'.log'),'jats_vcsrelease.pl', '-extractfiles', '-noprefix', '-root',$dirWork, '-view', $oldName ,'-label', $oldVcs );JatsCmd('-logfile', catfile($dirLog, $newName.'.log'),'jats_vcsrelease.pl', '-extractfiles', '-noprefix', '-root',$dirWork, '-view', $newName ,'-label', $newVcs );my $rv = System('--Shell','diff', '-rq', $oldView, $newView, "1>$diffLogPath");print("TipDiff [$diffLog]: $rv\n");if ($rv == 0) {$rCode = "S";} elsif ($rv == 1) {my $rv = System('--Shell','diff', '-rq', '--exclude=build.pl', $oldView, $newView, "1>$buildDiffLogPath");print("TipBuildDiff [$buildDiffLog]: $rv\n");if ($rv == 0) {$rCode = 'd';} else {$rCode = 'D';}}RmDirTree($oldView);RmDirTree($newView);$testPackageTip{$key}{$pver} = $rCode;saveLocalData();return $rCode;}#-------------------------------------------------------------------------------# Function : testPackage## Description : Test a package to see how different it is between the two# repositories## Inputs : $key (pname + proj)# $pver - version to test## Returns :#sub testPackage{my ($key, $pver) = @_;if (-f 'stopfile') {Error('StopFile detected');}my ($newPvid, $newVcs, $newPname, $newProj) = split($;, $new{$key}{$pver} );my ($oldPvid, $oldVcs, $oldPname, $oldProj) = split($;, $old{$key}{$pver} );testPackagesCore($key,$pver,$oldVcs, $newVcs);}#-------------------------------------------------------------------------------# Function : testPackagesCore## Description : Core of the package testing rmMerge_process## Inputs : $pname# $pver# $oldvcs# $newvcs## Returns :#sub testPackagesCore{my ($pname, $version, $oldvcs, $newvcs ) = @_;if (isSame($pname, $version) || isDiff($pname, $version) || isBuildDiff($pname, $version) || isSkip($pname, $version) || isBroken($pname, $version)){Verbose ("Skipping: $pname, $version : " . getState($pname,$version));return;}if (-f 'stopfile') {Error('StopFile detected');}print("Extract $pname $version, $oldvcs, $newvcs\n");my $oldName = join('_', $pname, $version, 'old');my $newName = join('_', $pname, $version, 'new');my $oldView = catdir($dirWork,$oldName );my $newView = catdir($dirWork,$newName );JatsCmd('-logfile', catfile($dirLog, $oldName.'.log'),'jats_vcsrelease.pl', '-extractfiles', '-noprefix', '-root',$dirWork, '-view', $oldName ,'-label', $oldvcs );JatsCmd('-logfile', catfile($dirLog, $newName.'.log'),'jats_vcsrelease.pl', '-extractfiles', '-noprefix', '-root',$dirWork, '-view', $newName ,'-label', $newvcs );my $rv = System('diff', '-rq', $oldView, $newView);print("Diff: $rv\n");if ($rv == 0) {markSame($pname, $version);} elsif ($rv == 1) {my $rv = System('diff', '-rq', '--exclude=build.pl', $oldView, $newView);print("BuildDiff: $rv\n");if ($rv == 0) {markBuildDiff($pname, $version, $oldView, $newView);} else {markDiff($pname, $version, $oldView, $newView);}} else {markBroken($pname, $version);}RmDirTree($oldView);RmDirTree($newView);}#-------------------------------------------------------------------------------# Function : isSame## Description : known to be good## Inputs :## Returns :#sub isSame{my ($pname, $pver) = @_;my $file = catdir($dirSame, join('__', $pname, $pver));mkdir $dirSame || Error ("Cannot create $dirSame");return (-f $file);}sub isDiff{my ($pname, $pver) = @_;my $file = catdir($dirDiff, join('__', $pname, $pver));mkdir $dirDiff || Error ("Cannot create $dirSame");return (-f $file);}sub isSkip{my ($pname, $pver) = @_;my $file = catdir($dirSkip, join('__', $pname, $pver));mkdir $dirSkip || Error ("Cannot create $dirSame");return (-f $file);}sub isBroken{my ($pname, $pver) = @_;my $file = catdir($dirBroken, join('__', $pname, $pver));mkdir $dirBroken || Error ("Cannot create $dirSame");return (-f $file);}sub isBuildDiff{my ($pname, $pver) = @_;my $file = catdir($dirBuildDiff, join('__', $pname, $pver));mkdir $dirBuildDiff || Error ("Cannot create $dirSame");return (-f $file);}sub getState{my ($pname, $pver) = @_;return 'G' if isSame($pname,$pver);return 'K' if isSkip($pname,$pver);return 'd' if isBuildDiff($pname,$pver);return 'D' if isDiff($pname,$pver);return 'B' if isBroken($pname,$pver);return '?';}#-------------------------------------------------------------------------------# Function : markSame## Description : Mark known to be the same## Inputs :## Returns :#sub markSame{my ($pname, $pver) = @_;my $file = catdir($dirSame, join('__', $pname, $pver));mkdir $dirSame || Error ("Cannot create $dirSame");TouchFile($file);}sub markBroken{my ($pname, $pver) = @_;my $file = catdir($dirBroken, join('__', $pname, $pver));mkdir $dirBroken || Error ("Cannot create $dirSame");TouchFile($file);}#-------------------------------------------------------------------------------# Function : markDiff## Description : Mark known to be the same## Inputs :## Returns :#sub markDiff{my ($pname, $pver, $dold, $dnew) = @_;my $file = catdir($dirDiff, join('__', $pname, $pver));mkdir $dirDiff || Error ("Cannot create $dirDiff");TouchFile($file);my $told = catdir($dirDiff,StripDir($dold));my $tnew = catdir($dirDiff,StripDir($dnew));RmDirTree($told);RmDirTree($tnew);move($dold, $told ) || Warning("Cannot move $dold, $dirSame");move($dnew, $tnew) || Warning("Cannot move $dnew, $dirSame");}sub markBuildDiff{my ($pname, $pver, $dold, $dnew) = @_;my $file = catdir($dirBuildDiff, join('__', $pname, $pver));mkdir $dirBuildDiff || Error ("Cannot create $dirDiff");TouchFile($file);my $told = catdir($dirBuildDiff,StripDir($dold));my $tnew = catdir($dirBuildDiff,StripDir($dnew));RmDirTree($told);RmDirTree($tnew);move($dold, $told ) || Warning("Cannot move $dold, $dirSame");move($dnew, $tnew) || Warning("Cannot move $dnew, $dirSame");}#-------------------------------------------------------------------------------# Function : GetDataFromRM## Description : Get Data from RM## Inputs : $oref - Ref to output hash# $credentials - to use to access RM## Returns :#sub GetDataFromRM{my ($oref, $startPvid, $id, $url, $name, $passwd) = @_;my (@row);my $fh;Message ("Extract data for: $oref");open ($fh, '>' , $oref) || Error ("Cant write to $oref");$ENV{GBE_RM_LOCATION} = $url;$ENV{GBE_RM_USERNAME} = $name;$ENV{GBE_RM_PASSWORD} = $passwd;connectRM(\$RM_DB) unless ( $RM_DB );# First get details from pv_idmy $m_sqlstr = <<"END_SQL";SELECT pv.pv_id, p.pkg_name, pv.pkg_version,release_manager.PK_RMAPI.return_vcs_tag(PV_ID), NVL(pv.PKG_IDEXT,'-')FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pWHERE pv.PKG_ID = p.PKG_ID AND pv.PV_ID > $startPvid ORDER by UPPER(p.pkg_name) DESCEND_SQLmy $sth = $RM_DB->prepare($m_sqlstr);if ( defined($sth) ){if ( $sth->execute( ) ){if ( $sth->rows ){while ( @row = $sth->fetchrow_array ){print $fh join(' ', @row), "\n";}}$sth->finish();}else{Error("Execute failure: $m_sqlstr", $sth->errstr() );}}else{Error("Prepare failure" );}disconnectRM(\$RM_DB);close($fh);}#-------------------------------------------------------------------------------# Function : GetEssentialVersions## Description : Get Data from RM## Inputs : $oref - Ref to output hash# $credentials - to use to access RM## Returns :#sub GetEssentialVersions{my ($oref, $id, $url, $name, $passwd) = @_;my (@row);my $fh;my %pvid;Message ("Extract Essential versions for: $oref");open ($fh, '>' , $oref) || Error ("Cant write to $oref");$ENV{GBE_RM_LOCATION} = $url;$ENV{GBE_RM_USERNAME} = $name;$ENV{GBE_RM_PASSWORD} = $passwd;connectRM(\$RM_DB) unless ( $RM_DB );# First get details from pv_idmy $m_sqlstr = "select unique pv_id from release_content rc where rc.rtag_id in ( " . join(',', @essentialRtags) . " ) order by pv_id desc";#Debug0("$m_sqlstr");my $sth = $RM_DB->prepare($m_sqlstr);if ( defined($sth) ){if ( $sth->execute( ) ){if ( $sth->rows ){while ( @row = $sth->fetchrow_array ){$pvid{$row[0]} = 1;print $fh $row[0], "\n";}}$sth->finish();}else{Error("Execute failure: $m_sqlstr", $sth->errstr() );}}else{Error("Prepare failure" );}## Get all the dependencies - even if they are pegged#while (1){my @pvidList;my $more = 0;foreach my $key ( keys %pvid) {if ($pvid{$key} == 1) {push @pvidList, $key;$pvid{$key} = 2;$more++;last if $more > 700;}}last unless $more;$m_sqlstr = "select unique dpv_id from package_dependencies where pv_id in ( " . join(',', @pvidList) . " )";#Debug0("$m_sqlstr");my $sth = $RM_DB->prepare($m_sqlstr);if ( defined($sth) ){if ( $sth->execute( ) ){if ( $sth->rows ){while ( @row = $sth->fetchrow_array ) {unless (exists $pvid{$row[0]}) {$pvid{$row[0]} = 1;}}}$sth->finish();}else{Error("Execute failure: $m_sqlstr", $sth->errstr() );}}else{Error("Prepare failure" );}}## Get all package dependencies#my @allPvIds = keys %pvid;while (1){my @pvidList;@pvidList = splice (@allPvIds, 0, 700);last unless @pvidList;$m_sqlstr = "select pv_id, dpv_id from package_dependencies where pv_id in ( " . join(',', @pvidList) . " )";#Debug0("$m_sqlstr");my $sth = $RM_DB->prepare($m_sqlstr);if ( defined($sth) ){if ( $sth->execute( ) ){if ( $sth->rows ){while ( @row = $sth->fetchrow_array ) {print $fh join(' ', @row), "\n";}}$sth->finish();}else{Error("Execute failure: $m_sqlstr", $sth->errstr() );}}else{Error("Prepare failure" );}}disconnectRM(\$RM_DB);close($fh);}#-------------------------------------------------------------------------------# Function : GetRtagData## Description : Get Data from RM## Inputs : $oref - Ref to output hash# $credentials - to use to access RM## Returns :#sub GetRtagData{my ($oref, $id, $url, $name, $passwd) = @_;my (@row);my $fh;Message ("Extract Essential versions for: $oref");open ($fh, '>' , $oref) || Error ("Cant write to $oref");$ENV{GBE_RM_LOCATION} = $url;$ENV{GBE_RM_USERNAME} = $name;$ENV{GBE_RM_PASSWORD} = $passwd;connectRM(\$RM_DB) unless ( $RM_DB );# First get details from pv_idmy $m_sqlstr = "select rtag_id, rtag_name from release_manager.release_tags where rtag_id in ( " . join(',', @essentialRtags) . " ) order by UPPER(rtag_name) desc";#Debug0("$m_sqlstr");my $sth = $RM_DB->prepare($m_sqlstr);if ( defined($sth) ){if ( $sth->execute( ) ){if ( $sth->rows ){while ( @row = $sth->fetchrow_array ){print $fh join(' ', @row), "\n";}}$sth->finish();}else{Error("Execute failure: $m_sqlstr", $sth->errstr() );}}else{Error("Prepare failure" );}disconnectRM(\$RM_DB);close($fh);}#-------------------------------------------------------------------------------# Function : GetReleaseContents## Description : Get Data from RM## Inputs : $oref - Ref to output hash# $credentials - to use to access RM## Returns :#sub GetReleaseContents{my ($oref, $id, $url, $name, $passwd) = @_;my (@row);my $fh;Message ("Get Release Contents for: $oref");open ($fh, '>' , $oref) || Error ("Cant write to $oref");$ENV{GBE_RM_LOCATION} = $url;$ENV{GBE_RM_USERNAME} = $name;$ENV{GBE_RM_PASSWORD} = $passwd;connectRM(\$RM_DB) unless ( $RM_DB );## Process the required releases on at a time as we need to drill down and determine# all the dependencies - only get the non-pegged dependencies## $pv_id {pvid} => 2: Not Pegged. 1: Pegged#foreach my $rtagId ( @essentialRtags ){my %pvid;my $m_sqlstr = "SELECT UNIQUE rc.pv_id, NVL2(pg.pv_id, 2, 1) FROM release_manager.release_content rc, release_manager.pegged_versions pg WHERE rc.rtag_id = $rtagId AND rc.rtag_id = pg.rtag_id(+) AND rc.pv_id = pg.pv_id(+)";#Debug0("$m_sqlstr");my $sth = $RM_DB->prepare($m_sqlstr);if ( defined($sth) ) {if ( $sth->execute( ) ) {if ( $sth->rows ) {while ( @row = $sth->fetchrow_array ) {#Debug0("Data: @row");$pvid{$row[0]} = 1;$pvid{$row[0]} |= 0x1000 if ($row[1] ne 1);}}$sth->finish();}else{Error("Execute failure: $m_sqlstr", $sth->errstr() );}}else{Error("Prepare failure" );}#DebugDumpData("pvid",\%pvid);## Get all the dependencies and attribute them to this release#while ($opt_dependents){my @pvidList;my $more = 0;foreach my $key ( keys %pvid) {unless ($pvid{$key} & 0x1000 ) {push @pvidList, $key;$pvid{$key} |= 0x1000;$more++;last if $more > 700;}}last unless $more;$m_sqlstr = "select unique dpv_id from package_dependencies where pv_id in ( " . join(',', @pvidList) . " )";#Debug0("$m_sqlstr");my $sth = $RM_DB->prepare($m_sqlstr);if ( defined($sth) ){if ( $sth->execute( ) ){if ( $sth->rows ){while ( @row = $sth->fetchrow_array ) {#Debug0("Data: @row");unless (exists $pvid{$row[0]}) {$pvid{$row[0]} = 2;}}}$sth->finish();}else{Error("Execute failure: $m_sqlstr", $sth->errstr() );}}else{Error("Prepare failure" );}}## Output the data#foreach my $pvid ( sort keys %pvid ){print $fh join(' ',$pvid,$rtagId, $pvid{$pvid} & 3 ), "\n";}}disconnectRM(\$RM_DB);close($fh);}#-------------------------------------------------------------------------------# Function : isVersionGreater## Description : Test two versions## Inputs : $v1, $v2## Returns : Tupple# 2 : Cannot parse# 1 : v1 >= v2# 0 : v1 < v2 or change in project# 3 : ripple change## Code Letter# M - Major# m - Minor# p - Patch# r - Ripple# s - Same# E - Error# X - Project Change#sub isVersionGreater{my ($v1, $v2) = @_;my ($rv,$rc) = isVersionGreaterWrapper(@_);#Debug0("isVersionGreater: $v1, $v2 :: $rv, $rc");return $rv, $rc;}sub isVersionGreaterWrapper{my ($v1, $v2) = @_;return (1,'s') if $v1 eq $v2;my ($v11, $v12, $v13, $v14, $v15 ) = SplitVersion( $v1);my ($v21, $v22, $v23, $v24, $v25 ) = SplitVersion( $v2);return (2,'E') if (! defined($v11) || !defined($v21));return (0,'X') unless $v15 eq $v25;if ($v11 > $v21) {return (1,'M');} elsif ($v11 == $v21) {if ($v12 > $v22) {return (1,'m');} elsif ($v12 == $v22) {if ($v13 > $v23) {return (1,'p');} elsif ($v13 == $v23) {if ($v14 == $v24) {return (1,'s');} else {return (3,'r');}}}}return 0,'E';}#-------------------------------------------------------------------------------# Function : SplitVersion## Description : Spit a 'nice' version number into bits## Inputs : $vn - version number## Returns : An array of bits or UNDEF#sub SplitVersion{my ($vn) = @_;if ($vn =~ m~^(\d+)\.(\d+)\.(\d+)(\d{3})\.(\w+)$~) {return $1,$2,$3,$4,$5;} else {return undef;}}#-------------------------------------------------------------------------------# Function : saveLocalData## Description : Saves a hash of data to disk## Inputs :## Returns :#sub saveLocalData{## Dump out the configuration information#my $fh = ConfigurationFile::New( $localDataStore);$fh->DumpData( "\n# testPackageTip\n#\n", "testPackageTip", \%testPackageTip );$fh->DumpData( "\n# basePackageVersions\n#\n", "basePackageVersions", \%basePackageVersions );$fh->DumpData( "\n# usedBy\n#\n", "usedBy", \%usedBy );$fh->Close();}#-------------------------------------------------------------------------------# Function : restoreLocalData## Description : Read in the locally preserved data## Inputs :## Returns :#sub restoreLocalData{if (-f $localDataStore) {require ( $localDataStore );}}#-------------------------------------------------------------------------------# Function : GetUsedProjects## Description : Determine the projects used by a specific PV_ID## Inputs : $pvid# @credentials## Returns :#sub GetUsedProjects{my ($pvid, $id, $url, $name, $passwd) = @_;my (@row);Debug ("GetUsedProjects: $pvid");unless (exists $usedBy{GetUsedProjects}{$pvid}) {$ENV{GBE_RM_LOCATION} = $url;$ENV{GBE_RM_USERNAME} = $name;$ENV{GBE_RM_PASSWORD} = $passwd;connectRM(\$RM_DB);my @data;my $m_sqlstr = <<"END_SQL";SELECT proj.PROJ_ID,proj.PROJ_NAME,ev.RTAG_ID,rt.rtag_nameFROM ENVIRONMENT_VIEW ev,PACKAGE_VERSIONS pv,RELEASE_TAGS rt,PROJECTS projWHERE ev.PV_ID = pv.PV_IDAND ev.RTAG_ID = rt.RTAG_IDAND rt.PROJ_ID = proj.PROJ_IDAND ev.PV_ID = $pvidORDER BY UPPER(proj.PROJ_NAME), UPPER(RTAG_NAME)END_SQL#Debug0("$m_sqlstr");my $sth = $RM_DB->prepare($m_sqlstr);if ( defined($sth) ) {if ( $sth->execute( ) ) {if ( $sth->rows ) {while ( @row = $sth->fetchrow_array ) {my @dataCopy = @row;push @data,\@dataCopy;}}$sth->finish();} else {Error("Execute failure: $m_sqlstr", $sth->errstr() );}} else {Error("Prepare failure" );}disconnectRM(\$RM_DB);$usedBy{GetUsedProjects}{$pvid} = \@data;}return $usedBy{GetUsedProjects}{$pvid};}#-------------------------------------------------------------------------------# Function : GetUsedSdks## Description : Determine the SDKs used by a specific PV_ID## Inputs : $pvid# @credentials## Returns :#sub GetUsedSdks{my ($pvid, $id, $url, $name, $passwd) = @_;my (@row);Debug ("GetUsedProjects: $pvid");unless (exists $usedBy{GetUsedSdks}{$pvid}) {$ENV{GBE_RM_LOCATION} = $url;$ENV{GBE_RM_USERNAME} = $name;$ENV{GBE_RM_PASSWORD} = $passwd;connectRM(\$RM_DB);my @data;my $m_sqlstr = <<"END_SQL";SELECT DISTINCT st.SDK_ID, SDK_NAME, st.sdktag_id, st.sdktag_nameFROM release_manager.SDK_CONTENT sc,release_manager.SDK_TAGS st,release_manager.SDK_NAMES sn,release_manager.PACKAGE_VERSIONS pvWHERE sc.SDKTAG_ID = st.SDKTAG_IDAND (sc.PV_ID = :PV_ID )AND st.SDK_ID = sn.SDK_IDAND sc.PV_ID = pv.PV_IDORDER BY UPPER(SDK_NAME)END_SQL#Debug0("$m_sqlstr");$m_sqlstr =~ s~:PV_ID~$pvid~g;my $sth = $RM_DB->prepare($m_sqlstr);if ( defined($sth) ) {if ( $sth->execute( ) ) {if ( $sth->rows ) {while ( @row = $sth->fetchrow_array ) {my @dataCopy = @row;push @data,\@dataCopy;}}$sth->finish();} else {Error("Execute failure: $m_sqlstr", $sth->errstr() );}} else {Error("Prepare failure" );}disconnectRM(\$RM_DB);$usedBy{GetUsedSdks}{$pvid} = \@data;}return $usedBy{GetUsedSdks}{$pvid};}#-------------------------------------------------------------------------------# Function : GetUsedSboms## Description : Determine the SBOMs used by a specific PV_ID## Inputs : $pvid# @credentials## Returns :#sub GetUsedSboms{my ($pvid, $id, $url, $name, $passwd) = @_;my (@row);Debug ("GetUsedProjects: $pvid");unless (exists $usedBy{GetUsedSboms}{$pvid}) {$ENV{GBE_RM_LOCATION} = $url;$ENV{GBE_RM_USERNAME} = $name;$ENV{GBE_RM_PASSWORD} = $passwd;connectRM(\$RM_DB);my @data;my $m_sqlstr = <<"END_SQL";SELECT DISTINCT b.branch_id, proj.proj_name ||' - '|| br.branch_name as name, b.bom_id, b.bom_versionFROM package_versions pv,packages pkg,DEPLOYMENT_MANAGER.os_contents osc,DEPLOYMENT_MANAGER.operating_systems os,DEPLOYMENT_MANAGER.network_nodes nn,DEPLOYMENT_MANAGER.bom_contents bc,DEPLOYMENT_MANAGER.boms b,DEPLOYMENT_MANAGER.bom_names bn,DEPLOYMENT_MANAGER.branches br,DEPLOYMENT_MANAGER.dm_projects projWHERE pv.pkg_id = pkg.pkg_idAND osc.prod_id = pv.pv_idAND os.os_id = osc.os_idAND nn.node_id = os.node_idAND bc.node_id = nn.node_idAND b.bom_id = bc.bom_idAND bn.bom_name_id = b.bom_name_idAND br.branch_id = b.branch_idAND proj.proj_id = br.proj_idAND br.is_hidden IS NULLAND (osc.prod_id = :PV_ID )ORDER BY UPPER(name)END_SQL#Debug0("$m_sqlstr");$m_sqlstr =~ s~:PV_ID~$pvid~g;my $sth = $RM_DB->prepare($m_sqlstr);if ( defined($sth) ) {if ( $sth->execute( ) ) {if ( $sth->rows ) {while ( @row = $sth->fetchrow_array ) {my @dataCopy = @row;push @data,\@dataCopy;}}$sth->finish();} else {Error("Execute failure: $m_sqlstr", $sth->errstr() );}} else {Error("Prepare failure" );}disconnectRM(\$RM_DB);$usedBy{GetUsedSboms}{$pvid} = \@data;}return $usedBy{GetUsedSboms}{$pvid};}#-------------------------------------------------------------------------------# Documentation#=pod=for htmltoc GENERAL::ClearCase::=head1 NAMErmMerge_process - Process data for Release Manager Merge=head1 SYNOPSISjats rmMerge_spit [options] PackageName PackageVersionOptions:-help - brief help message-help -help - Detailed help message-man - Full documentation-[no]reuse - Reuse exsiting rmData (default)-refresh - Refresh data - don't get new package versions-order=n - Only displlay packes with rmMerge_processing order <= n-type=nnn - Only display type nnn-command - Display commands to transfer packages-[no]dependents - Include indirect dependents=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.=back=head2 OPTIONS=over=item -[no]reuseThe default option is 'reuse'. The 'noreuse' option will cause the program to extract a lot ofdata from the two Release Manager databases. This is time consuming.=item -order=nThe option will cause the final display to be filtered such that only packages with an insertionorder of less than or equal to that specified will be displayed.=back=head1 EXAMPLEjats eprog rmMerge_process=cut