Subversion Repositories DevTools

Rev

Rev 395 | Rev 1453 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 395 Rev 1197
Line 34... Line 34...
34 
my $opt_help = 0;
 34 
my $opt_help = 0;
35 
my $opt_manual;
 35 
my $opt_manual;
36 
my $opt_test;
 36 
my $opt_test;
37 
my $opt_limit;
 37 
my $opt_limit;
38 
my $opt_quick;
 38 
my $opt_quick;
- 
 
 39 
my $opt_mode = '';
39 
my $RM_DB;
 40 
my $RM_DB;
40 
my $now = time();
 41 
my $now = time();
41 
 
 42 
 
42 
#
 43 
#
43 
#   Package information
 44 
#   Package information
Line 68... Line 69...
68 
                        142,            # SYDNEY (SYD)
 69 
                        142,            # SYDNEY (SYD)
69 
                        182 ,           # ROME (ROM)
 70 
                        182 ,           # ROME (ROM)
70 
                        6 ,             # GMPTE/PCL (GMP)
 71 
                        6 ,             # GMPTE/PCL (GMP)
71 
                        521,            # NSW CLUB CARD
 72 
                        521,            # NSW CLUB CARD
72 
                        221,            # NZ STAGE COACH (NZS)
 73 
                        221,            # NZ STAGE COACH (NZS)
73 
                        82              # LVS
 74 
                        82,             # LVS
- 
 
 75 
                        42,             # SFO
- 
 
 76 
                        641,            # BCC Releaeses
- 
 
 77 
                        62,             # OSLO
- 
 
 78 
                        4,              # Singapore
- 
 
 79 
                        441,            # Tas
- 
 
 80 
                        102,            # Ventura
74 
                        );
 81 
                        );
75 
my @excludeReleases = ( 20424,          # MASS_REF (MAS) > test
 82 
my @excludeReleases = ( 20424,          # MASS_REF (MAS) > test
76 
                        9043,           # TECHNOLOGY GROUP > Development Environment - For Test Setup
 83 
                        # RJACK 9043,           # TECHNOLOGY GROUP > Development Environment - For Test Setup
- 
 
 84 
                        # RJACK 14383,          # TECHNOLOGY GROUP > eBrio TDS
- 
 
 85 
                        # RJACK 20463,          # TECHNOLOGY GROUP > TPIT - BackOffice Linux build
- 
 
 86 
                        # RJACK 14603,          # TECHNOLOGY GROUP > TPIT - BackOffice 64 bit [CCB Mode!]
77 
                        #9263,           # TECHNOLOGY GROUP > Buildtool DEVI&TEST
 87 
                        #9263,           # TECHNOLOGY GROUP > Buildtool DEVI&TEST
78 
                        14383,          # TECHNOLOGY GROUP > eBrio TDS
 - 
 
79 
                        20463,          # TECHNOLOGY GROUP > TPIT - BackOffice Linux build
 - 
 
80 
                        14603,          # TECHNOLOGY GROUP > TPIT - BackOffice 64 bit [CCB Mode!]
 - 
 
81 
                        22163,          # GLOBAL PRODUCT MGMT > Rio Tinto - Remote Draught Survey
 88 
                        22163,          # GLOBAL PRODUCT MGMT > Rio Tinto - Remote Draught Survey
82 
                        19483,          # SEATTLE (SEA) > Phase 2 - I18 [backup] [Restrictive Mode]
 89 
                        19483,          # SEATTLE (SEA) > Phase 2 - I18 [backup] [Restrictive Mode]
83 
                        20403,          # SEATTLE (SEA) > Phase 2 - I19 [backup]
 90 
                        20403,          # SEATTLE (SEA) > Phase 2 - I19 [backup]
84 
                        20983,          # ??? May have been deleted
 91 
                        20983,          # ??? May have been deleted
85 
                        13083,          # TECHNOLOGY GROUP > TRACS
 92 
                        13083,          # TECHNOLOGY GROUP > TRACS
86 
                        15224,          # 64Bit Solaris Test
 93 
                        15224,          # 64Bit Solaris Test
- 
 
 94
87 
                        );
 95 
                        );
88 
 
 96 
 
89 
my %sillyVersions =
 97 
my %sillyVersions =
90 
(
 98 
(
91 
    '2b6'           => '2.6.0.cots',
 99 
    '2b6'           => '2.6.0.cots',
92 
    '1.0b2'         => '1.0.2.cots',
 100 
    '1.0b2'         => '1.0.2.cots',
93 
    '1.6.x'         => '1.6.0.cots',
 101 
    '1.6.x'         => '1.6.0.cots',
94 
    '3.5beta12.5'   => '3.5.12.5.cots',
 102 
    '3.5beta12.5'   => '3.5.12.5.cots',
- 
 
 103 
    '1.0b1.1.mas'   => '1.1.1.mas',
- 
 
 104 
);
- 
 
 105 
 
- 
 
 106 
my %suffixFixup = (
- 
 
 107 
    '.sf'           => '.sfo',
- 
 
 108 
    '.vt'           => '.vtk',
- 
 
 109 
    '.lv'           => '.lvs',
- 
 
 110 
    '.was'          => '.wdc',
- 
 
 111 
    '.uk.1'         => '.uk',
- 
 
 112 
    '.ssts.demo'    => '.ssts',
- 
 
 113 
    '.u244.syd'     => '.syd',
- 
 
 114 
    '.pxxx.sea'     => '.sea',
- 
 
 115 
    '.pxxx.syd'     => '.syd',
- 
 
 116 
    '.pxxx.sydddd'  => '.syd',
- 
 
 117 
    '.oslo'         => '.oso',
95 
);
 118 
);
96
119
97 
#-------------------------------------------------------------------------------
 120 
#-------------------------------------------------------------------------------
98 
# Function        : Main Entry
 121 
# Function        : Main Entry
99 
#
 122 
#
Line 108... Line 131...
108 
                "manual"        => \$opt_manual,        # flag
 131 
                "manual"        => \$opt_manual,        # flag
109 
                "verbose+"      => \$opt_verbose,       # flag
 132 
                "verbose+"      => \$opt_verbose,       # flag
110 
                "test:s"        => \$opt_test,          # Test a version string
 133 
                "test:s"        => \$opt_test,          # Test a version string
111 
                "limit:n"       => \$opt_limit,         #
 134 
                "limit:n"       => \$opt_limit,         #
112 
                "quick"         => \$opt_quick,         # Don't look for indirects
 135 
                "quick"         => \$opt_quick,         # Don't look for indirects
- 
 
 136 
                'mode:s'        => \$opt_mode,          # Mode of operation
113 
                );
 137 
                );
114 
 
 138 
 
115 
#
 139 
#
116 
#   Process help and manual options
 140 
#   Process help and manual options
117 
#
 141 
#
118 
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
 142 
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
119 
pod2usage(-verbose => 1)  if ($opt_help == 2 );
 143 
pod2usage(-verbose => 1)  if ($opt_help == 2 );
120 
pod2usage(-verbose => 2)  if ($opt_manual || ($opt_help > 2));
 144 
pod2usage(-verbose => 2)  if ($opt_manual || ($opt_help > 2));
- 
 
 145 
ErrorConfig( 'name'    =>'CC2SVN_GENDATA' );
121 
 
 146 
 
122 
if ( $opt_test )
 147 
if ( $opt_test )
123 
{
 148 
{
124 
    my @results = massageVersion( $opt_test, 'DummyName' );
 149 
    my @results = massageVersion( $opt_test, 'DummyName' );
125 
    Message ("Version", $opt_test, @results);
 150 
    Message ("Version", $opt_test, @results);
126 
    exit 1;
 151 
    exit 1;
127 
}
 152 
}
128 
 
 153 
 
- 
 
 154 
#
- 
 
 155 
#   Set up the mode
- 
 
 156 
#   Must be specified
- 
 
 157 
#
- 
 
 158 
if ( $opt_mode eq 'all' ) {
- 
 
 159 
    $doAllReleases = 1;
- 
 
 160 
    $doIncludeOnly = 0;
- 
 
 161
- 
 
 162 
} elsif ( $opt_mode eq 'hops' ) {
- 
 
 163 
    $doAllReleases = 0;
- 
 
 164 
    $doIncludeOnly = 1;
- 
 
 165 
 
- 
 
 166 
} elsif ( $opt_mode eq 'standard' ) {
- 
 
 167 
    $doAllReleases = 0;
- 
 
 168 
    $doIncludeOnly = 0;
- 
 
 169 
 
- 
 
 170 
} else {
- 
 
 171 
    Error ("Mode not specified: all, hops, standard");
- 
 
 172 
}
129 
 
 173 
 
130 
ErrorConfig( 'name'    =>'CC2SVN_GENDATA' );
 - 
 
131 
GetAllPackageNames();
 174 
GetAllPackageNames();
132 
getReleaseDetails();
 175 
getReleaseDetails();
133 
getPkgDetailsByRTAG_ID();
 176 
getPkgDetailsByRTAG_ID();
134 
my $count;
 - 
 
135 
$count = keys %Packages;
 177 
my ($pcount, $vcount) = countPackages();
136 
print "Directly referenced Packages: $count\n";
 178 
print "Directly referenced Packages: $pcount Versions: $vcount\n";
137 
LocateStrays() unless ($opt_quick);
 179 
LocateStrays() unless ($opt_quick);
138 
$count = keys %Packages;
 180 
($pcount, $vcount) = countPackages();
139 
print "Indirectly referenced Packages: $count\n";
 181 
print "Indirectly referenced Packages: $pcount Versions: $vcount\n";
- 
 
 182 
processData();
140 
outputData();
 183 
outputData();
141 
 
 184 
 
142 
if ( $opt_verbose > 1 )
 185 
if ( $opt_verbose > 1 )
143 
{
 186 
{
144 
    print "=========================================================================\n";
 187 
    print "=========================================================================\n";
Line 147... Line 190...
147 
    DebugDumpData("Packages", \%Packages );
 190 
    DebugDumpData("Packages", \%Packages );
148 
    print "=========================================================================\n";
 191 
    print "=========================================================================\n";
149 
    DebugDumpData("Suffixes", \%Suffixes );
 192 
    DebugDumpData("Suffixes", \%Suffixes );
150 
}
 193 
}
151 
 
 194 
 
152 
$count = keys %Packages;
 195 
($pcount, $vcount) = countPackages();
153 
print "Total References Packages: $count\n";
 196 
print "Total References Packages: $pcount Versions: $vcount\n";
154 
 
 - 
 
155 
exit;
 197 
exit;
156 
 
 198 
 
157 
#-------------------------------------------------------------------------------
 199 
#-------------------------------------------------------------------------------
158 
# Function        : getReleaseDetails
 200 
# Function        : getReleaseDetails
159 
#
 201 
#
Line 175... Line 217...
175 
    # From non-archived releases
 217 
    # From non-archived releases
176 
 
 218 
 
177 
    my $m_sqlstr = "SELECT prj.PROJ_NAME, rt.RTAG_NAME, rt.PROJ_ID, rt.RTAG_ID, rt.official" .
 219 
    my $m_sqlstr = "SELECT prj.PROJ_NAME, rt.RTAG_NAME, rt.PROJ_ID, rt.RTAG_ID, rt.official" .
178 
                   " FROM release_manager.release_tags rt, release_manager.projects prj" .
 220 
                   " FROM release_manager.release_tags rt, release_manager.projects prj" .
179 
                   " WHERE prj.PROJ_ID = rt.PROJ_ID " .
 221 
                   " WHERE prj.PROJ_ID = rt.PROJ_ID " .
- 
 
 222 
#                   "   AND rt.official != 'A' ".
180 
                   "   AND rt.official != 'A' AND rt.official != 'Y'" .
 223 
#                   "   AND rt.official != 'Y'" .
181 
                   " order by prj.PROJ_NAME";
 224 
                   " order by prj.PROJ_NAME";
182 
    my $sth = $RM_DB->prepare($m_sqlstr);
 225 
    my $sth = $RM_DB->prepare($m_sqlstr);
183 
    if ( defined($sth) )
 226 
    if ( defined($sth) )
184 
    {
 227 
    {
185 
        if ( $sth->execute( ) )
 228 
        if ( $sth->execute( ) )
Line 245... Line 288...
245 
        Error("Prepare failure" );
 288 
        Error("Prepare failure" );
246 
    }
 289 
    }
247 
}
 290 
}
248 
 
 291 
 
249 
 
 292 
 
- 
 
 293 
sub getPkgDetailsByPVID
- 
 
 294 
{
- 
 
 295 
    my ($pv_id) = @_;
- 
 
 296 
    my (@row);
- 
 
 297 
 
- 
 
 298 
    #
- 
 
 299 
    #   Only do once
- 
 
 300 
    #
- 
 
 301 
    return if ( exists $Packages{$pv_id}{name} );
- 
 
 302
- 
 
 303 
    # if we are not or cannot connect then return 0 as we have not found anything
- 
 
 304 
    connectRM(\$RM_DB) unless $RM_DB;
- 
 
 305 
 
- 
 
 306 
    my $m_sqlstr = "SELECT" .
- 
 
 307 
                        " pv.PV_ID, ".                                          #[0]
- 
 
 308 
                        " pkg.PKG_NAME, ".                                      #[1]
- 
 
 309 
                        " pv.PKG_VERSION, ".                                    #[2]
- 
 
 310 
                        " pv.DLOCKED," .                                        #[3]
- 
 
 311 
                        " release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), ". #[4]
- 
 
 312 
                        " pv.PKG_ID," .                                         #[5]
- 
 
 313 
                        " pv.MODIFIED_STAMP  ".                                 #[6]
- 
 
 314 
                   " FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv,".
- 
 
 315 
                   "      RELEASE_MANAGER.PACKAGES pkg ".
- 
 
 316 
                   " WHERE pv.PV_ID = \'$pv_id\' ".
- 
 
 317 
                   "   AND pv.PKG_ID = pkg.PKG_ID" ;
- 
 
 318 
    my $sth = $RM_DB->prepare($m_sqlstr);
- 
 
 319 
    if ( defined($sth) )
- 
 
 320 
    {
- 
 
 321 
        if ( $sth->execute( ) )
- 
 
 322 
        {
- 
 
 323 
#            print "--- Execute\n";
- 
 
 324 
            if ( $sth->rows )
- 
 
 325 
            {
- 
 
 326 
#                print "--- Execute ROWS\n";
- 
 
 327 
                while ( @row = $sth->fetchrow_array )
- 
 
 328 
                {
- 
 
 329 
                    print join (',',@row), "\n" if ($opt_verbose);
- 
 
 330 
 
- 
 
 331 
                    my $pvid = $row[0];
- 
 
 332 
                    $Packages{$pvid}{name} = $row[1];
- 
 
 333 
                    $Packages{$pvid}{version} = $row[2];
- 
 
 334 
                    $Packages{$pvid}{locked} = $row[3];
- 
 
 335 
                    $row[4] =~ tr~\\/~/~;
- 
 
 336 
                    $Packages{$pvid}{vcstag} = $row[4];
- 
 
 337 
                    $Packages{$pvid}{pkgid} = $row[5];
- 
 
 338 
#                    $Packages{$pvid}{tlp} = 1;
- 
 
 339 
                    ($Packages{$pvid}{suffix}, $Packages{$pvid}{fullVersion},$Packages{$pvid}{isaRipple} ) = massageVersion( $Packages{$pvid}{version}, $Packages{$pvid}{name} );
- 
 
 340 
                    $Suffixes{$Packages{$pvid}{suffix}}++;
- 
 
 341 
                    $Packages{$pvid}{Age} = ($now - str2time( $row[6] )) / (60 * 60 * 24);
- 
 
 342 
                }
- 
 
 343 
            }
- 
 
 344 
#            print "--- Finish\n";
- 
 
 345 
            $sth->finish();
- 
 
 346 
        }
- 
 
 347 
        else
- 
 
 348 
        {
- 
 
 349 
            Error("getPkgDetailsByPVID:Execute failure: $m_sqlstr", $sth->errstr() );
- 
 
 350 
        }
- 
 
 351 
    }
- 
 
 352 
    else
- 
 
 353 
    {
- 
 
 354 
        Error("getPkgDetailsByPVID:Prepare failure" );
- 
 
 355 
    }
- 
 
 356 
}
- 
 
 357 
 
- 
 
 358 
 
250 
sub getPkgDetailsByRTAG_ID
 359 
sub getPkgDetailsByRTAG_ID
251 
{
 360 
{
252 
    my (@row);
 361 
    my (@row);
253 
    my $excludes = '';
 362 
    my $excludes = '';
254 
    my $count = 0;
 363 
    my $count = 0;
Line 281... Line 390...
281 
                   "      RELEASE_MANAGER.PACKAGES pkg, release_manager.release_tags rt, release_manager.projects prj" .
 390 
                   "      RELEASE_MANAGER.PACKAGES pkg, release_manager.release_tags rt, release_manager.projects prj" .
282 
                   "    , release_manager.views rmv" .
 391 
                   "    , release_manager.views rmv" .
283 
                   " WHERE rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID" .
 392 
                   " WHERE rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID" .
284 
                   "   AND rmv.VIEW_ID = rc.BASE_VIEW_ID" .
 393 
                   "   AND rmv.VIEW_ID = rc.BASE_VIEW_ID" .
285 
                   "   AND prj.PROJ_ID = rt.PROJ_ID and rt.RTAG_ID = rc.RTAG_ID" .
 394 
                   "   AND prj.PROJ_ID = rt.PROJ_ID and rt.RTAG_ID = rc.RTAG_ID" .
- 
 
 395 
#                   "   AND rt.official != 'A'" .
286 
                   "   AND rt.official != 'A' AND rt.official != 'Y'" .
 396 
#                   "   AND rt.official != 'Y' " .
287 
                   $excludes .
 397 
                   $excludes .
288 
                   " order by pkg.PKG_NAME";
 398 
                   " order by pkg.PKG_NAME";
289 
    my $sth = $RM_DB->prepare($m_sqlstr);
 399 
    my $sth = $RM_DB->prepare($m_sqlstr);
290 
    if ( defined($sth) )
 400 
    if ( defined($sth) )
291 
    {
 401 
    {
Line 319... Line 429...
319 
                    $Packages{$pvid}{view}{$row[7]}++ if ( $row[7] );
 429 
                    $Packages{$pvid}{view}{$row[7]}++ if ( $row[7] );
320 
 
 430 
 
321 
                    $Packages{$pvid}{Age} = ($now - str2time( $row[8] )) / (60 * 60 * 24);
 431 
                    $Packages{$pvid}{Age} = ($now - str2time( $row[8] )) / (60 * 60 * 24);
322 
 
 432 
 
323 
                    my $proj_id = $row[9];
 433 
                    my $proj_id = $row[9];
324 
                    push @{$Packages{$pvid}{projects}}, $proj_id;
 434 
                    push @{$Packages{$pvid}{projects}}, $proj_id
- 
 
 435 
                        unless (grep {$_ eq $proj_id} @{$Packages{$pvid}{projects}});
325 
 
 436 
 
326 
                    if ( $doIncludeOnly )
 437 
                    if ( $doIncludeOnly )
327 
                    {
 438 
                    {
328 
                        if (grep {$_ eq $proj_id} @includedProjects)
 439 
                        if (grep {$_ eq $proj_id} @includedProjects)
329 
                        {
 440 
                        {
330 
                            $Packages{$pvid}{NamedProject} = 1;
 441 
                            $Packages{$pvid}{NamedProject} = 1;
331 
                        }
 442 
                        }
332 
                        if (grep {$_ eq $rtag_id} @includedReleases)
 443 
                        if (grep {$_ eq $rtag_id} @includedReleases)
333 
                        {
 444 
                        {
334 
                            $Packages{$pvid}{NamedProject} = 1;
 445 
                            $Packages{$pvid}{NamedProject} = 2;
335 
                        }
 446 
                        }
336 
                    }
 447 
                    }
337 
                    else
 448 
                    else
338 
                    {
 449 
                    {
339 
                        $Packages{$pvid}{NamedProject} = 1;
 450 
                        $Packages{$pvid}{NamedProject} = 3;
340 
                    }
 451 
                    }
341 
 
 452 
 
342 
 
 453 
 
343 
                    if ( $opt_limit )
 454 
                    if ( $opt_limit )
344 
                    {
 455 
                    {
Line 372... Line 483...
372 
sub GetDepends
 483 
sub GetDepends
373 
{
 484 
{
374 
    my ($pv_id ) = @_;
 485 
    my ($pv_id ) = @_;
375 
 
 486 
 
376 
    #
 487 
    #
- 
 
 488 
    #   Ensure we have package information
- 
 
 489 
    #
- 
 
 490 
    getPkgDetailsByPVID( $pv_id );
- 
 
 491 
    return if ( $Packages{$pv_id}{depend} );
- 
 
 492 
    $Packages{$pv_id}{depend} = 1;
- 
 
 493 
 
- 
 
 494 
    #
377 
    #   Now extract the package dependacies
 495 
    #   Now extract the package dependacies
- 
 
 496 
    #   There may not be any
378 
    #
 497 
    #
379 
    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION, pv.DLOCKED, release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), pv.PKG_ID, pv.MODIFIED_STAMP" .
 498 
    my $m_sqlstr = "SELECT ".
380 
                  " FROM RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .
 499 
                    " pd.PV_ID, ".
- 
 
 500 
                    " pd.DPV_ID " .
381 
                  " WHERE pd.PV_ID = \'$pv_id\' AND pd.DPV_ID = pv.PV_ID" .
 501 
                  " FROM    RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd ".
382 
                  "       AND pv.PKG_ID = pkg.PKG_ID";
 502 
                  " WHERE pd.PV_ID = \'$pv_id\'";
383 
    my $sth = $RM_DB->prepare($m_sqlstr);
 503 
    my $sth = $RM_DB->prepare($m_sqlstr);
384 
    if ( defined($sth) )
 504 
    if ( defined($sth) )
385 
    {
 505 
    {
386 
        if ( $sth->execute( ) )
 506 
        if ( $sth->execute( ) )
387 
        {
 507 
        {
388 
            if ( $sth->rows )
 508 
            if ( $sth->rows )
389 
            {
 509 
            {
390 
                while ( my @row = $sth->fetchrow_array )
 510 
                while ( my @row = $sth->fetchrow_array )
391 
                {
 511 
                {
392 
                    my $pvid = $row[0];
 512 
                    my $pvid = $row[0];
393 
                    unless ( exists $Packages{$pvid}{name} )
 - 
 
394 
                    {
 - 
 
395 
                        print join (',',@row), "\n" if ($opt_verbose) ;
 - 
 
396 
                        $Packages{$pvid}{name} = $row[1];
 513 
                    my $dpvid = $row[1];
397 
                        $Packages{$pvid}{version} = $row[2];
 - 
 
398 
                        $Packages{$pvid}{locked} = $row[3];
 - 
 
399 
                        $row[4] =~ tr~\\/~/~;
 - 
 
400 
                        $Packages{$pvid}{vcstag} = $row[4];
 - 
 
401 
                        $Packages{$pvid}{pkgid} = $row[5];
 - 
 
402 
                        $Packages{$pvid}{Age} = ($now - str2time( $row[6] )) / (60 * 60 * 24);
 - 
 
403
- 
 
404 
                        $Packages{$pvid}{depend} = 1;
 - 
 
405 
                        ($Packages{$pvid}{suffix}, $Packages{$pvid}{fullVersion},$Packages{$pvid}{isaRipple} ) = massageVersion( $Packages{$pvid}{version},$Packages{$pvid}{name} );
 - 
 
406 
                        $Suffixes{$Packages{$pvid}{suffix}}++;
 - 
 
407 
 
 - 
 
408 
                        push @StrayPackages, $pvid;
 514 
                    push @StrayPackages, $dpvid;
409 
                    }
 - 
 
410 
 
 - 
 
411 
                    push @{$Packages{$pvid}{usedBy}}, $pv_id;
 515 
                    push @{$Packages{$dpvid}{usedBy}}, $pvid;
412 
                }
 516 
                }
413 
            }
 517 
            }
414 
            $sth->finish();
 518 
            $sth->finish();
415 
        }
 519 
        }
416 
        else
 520 
        else
417 
        {
 521 
        {
418 
        Error("GetDepends:Execute failure" );
 522 
            Error("GetDepends:Execute failure: $m_sqlstr", $sth->errstr() );
419 
        }
 523 
        }
420 
    }
 524 
    }
421 
    else
 525 
    else
422 
    {
 526 
    {
423 
        Error("GetDepends:Prepare failure" );
 527 
        Error("GetDepends:Prepare failure" );
Line 487... Line 591...
487 
sub massageVersion
 591 
sub massageVersion
488 
{
 592 
{
489 
    my ($version, $name) = @_;
 593 
    my ($version, $name) = @_;
490 
    my ($major, $minor, $patch, $build, $suffix);
 594 
    my ($major, $minor, $patch, $build, $suffix);
491 
    my $result;
 595 
    my $result;
- 
 
 596 
    my $buildVersion;
492 
    my $isaRipple;
 597 
    my $isaRipple;
493 
    my $isaWIP;
 598 
    my $isaWIP;
494 
    $build = 0;
 599 
    $build = 0;
495 
 
 600 
 
- 
 
 601 
#print "--- $name, $version\n";
- 
 
 602 
    $version =~ s~^_~~;
- 
 
 603 
    $version =~ s~^\Q${name}\E_~~;
- 
 
 604 
 
496 
    #
 605 
    #
497 
    #   Pre-massage some silly ones
 606 
    #   Pre-massage some silly ones
498 
    #
 607 
    #
499 
    if ( exists $sillyVersions{$version} ) {
 608 
    if ( exists $sillyVersions{$version} ) {
500 
        $version = $sillyVersions{$version};
 609 
        $version = $sillyVersions{$version};
501 
    }
 610 
    }
502 
 
 611 
 
- 
 
 612 
    if ( $name eq 'ReleaseName' ) {
- 
 
 613 
        $version =~ s~[a-z]~.~g;
- 
 
 614 
        $version =~ s~\.+~.~g;
- 
 
 615 
        $version =~ s~\.$~~g
- 
 
 616 
    }
503 
 
 617 
 
- 
 
 618 
    #
- 
 
 619 
    #   xxxxxxxxx.nnnn.cots
- 
 
 620 
    #
504 
    if ( $version =~ m~(.*)\.cots$~ ) {
 621 
    if ( $version =~ m~(.*)\.cots$~ ) {
505 
        my $cots_base = $1;
 622 
        my $cots_base = $1;
506 
        $suffix = '.cots';
 623 
        $suffix = '.cots';
507 
        if ( $version =~ m~(.*?)\.([0-9]{4})\.cots$~ )
 624 
        if ( $version =~ m~(.*?)\.([0-9]{4})\.cots$~ )
508 
        {
 625 
        {
Line 518... Line 635...
518 
    #       nnn.nnn.nnn.[p]nnn.xxx
 635 
    #       nnn.nnn.nnn.[p]nnn.xxx
519 
    #       nnn.nnn.nnn.[p]nnn-xxx
 636 
    #       nnn.nnn.nnn.[p]nnn-xxx
520 
    #       nnn.nnn.nnn-[p]nnn.xxx
 637 
    #       nnn.nnn.nnn-[p]nnn.xxx
521 
    #       nnn.nnn.nnn-[p]nnn-xxx
 638 
    #       nnn.nnn.nnn-[p]nnn-xxx
522 
    #       nnn.nnn.nnn[p]nnn-xxx
 639 
    #       nnn.nnn.nnn[p]nnn-xxx
- 
 
 640 
    #   Don't flag as ripples - they are patches
523 
    #
 641 
    #
524 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-.p][p]?(\d+)([-.](.*))?$~ ) {
 642 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-.p][p]?(\d+)([-.](.*))?$~ ) {
525 
        $major = $1;
 643 
        $major = $1;
526 
        $minor = $2;
 644 
        $minor = $2;
527 
        $patch = $3;
 645 
        $patch = $3;
528 
        $build = $4;
 646 
        $build = $4;
529 
        $suffix = defined $6 ? ".$6" : '';
 647 
        $suffix = defined $6 ? ".$6" : '';
- 
 
 648 
        $isaRipple = 0;
530 
    }
 649 
    }
531 
    #
 650 
    #
532 
    #       nn.nnn.nnnnn.xxx
 651 
    #       nn.nnn.nnnnn.xxx
533 
    #       nn.nnn.nnnnn-xxx
 652 
    #       nn.nnn.nnnnn-xxx
- 
 
 653 
    #       nnn.nnn.nnnx.xxx
- 
 
 654 
    #   Don't flag as ripples - they are patches
534 
    #
 655 
    #
535 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)([-.](.*))?$~ ) {
 656 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)\w?([-.](.*))?$~ ) {
536 
        $major = $1;
 657 
        $major = $1;
537 
        $minor = $2;
 658 
        $minor = $2;
538 
        $patch = $3;
 659 
        $patch = $3;
539 
        if ( length( $patch) >= 4 )
 660 
        if ( length( $patch) >= 4 )
540 
        {
 661 
        {
541 
            $build = substr( $patch, -3 ,3);
 662 
            $build = substr( $patch, -3 ,3);
542 
            $patch = substr( $patch,  0 ,length($patch)-3);
 663 
            $patch = substr( $patch,  0 ,length($patch)-3);
543 
        }
 664 
        }
544 
        $suffix = defined $5 ? ".$5" : '';
 665 
        $suffix = defined $5 ? ".$5" : '';
545 
    }
 666 
    }
- 
 
 667 
 
546 
    #
 668 
    #
- 
 
 669 
    #       nnn.nnn.nnn
- 
 
 670 
    #       nnn.nnn-nnn
547 
    #       nn.nnn.nnn_nnn
 671 
    #       nnn.nnn_nnn
548 
    #
 672 
    #
549 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-_.](\d+)$~ ) {
 673 
    elsif ( $version =~ m~^(\d+)\.(\d+)[-._](\d+)$~ ) {
550 
        $major = $1;
 674 
        $major = $1;
551 
        $minor = $2;
 675 
        $minor = $2;
552 
        $patch = $3;
 676 
        $patch = $3;
553 
        $build = $4;
 - 
 
554 
        $suffix = '';
 677 
        $suffix = '';
555 
    }
 678 
    }
556
679 
 
557 
    #
 680 
    #
558 
    #       nnn.nnn.nnn
 681 
    #       nnn.nnn.nnn.nnn
559 
    #       nnn.nnn-nnn
 682 
    #       nnn.nnn.nnn-nnn
- 
 
 683 
    #       nnn.nnn.nnn_nnn
560 
    #
 684 
    #
561 
    elsif ( $version =~ m~^(\d+)\.(\d+)[-.](\d+)$~ ) {
 685 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-._](\d+)$~ ) {
562 
        $major = $1;
 686 
        $major = $1;
563 
        $minor = $2;
 687 
        $minor = $2;
564 
        $patch = $3;
 688 
        $patch = $3;
- 
 
 689 
        $build = $4;
565 
        $suffix = '';
 690 
        $suffix = '';
- 
 
 691 
        $isaRipple = 0;
566 
    }
 692 
    }
- 
 
 693
567 
 
 694 
 
568 
    #
 695 
    #
569 
    #       nnn.nnn
 696 
    #       nnn.nnn
570 
    #
 697 
    #
571 
    elsif ( $version =~ m~^(\d+)\.(\d+)$~ ) {
 698 
    elsif ( $version =~ m~^(\d+)\.(\d+)$~ ) {
Line 573... Line 700...
573 
        $minor = $2;
 700 
        $minor = $2;
574 
        $patch = 0;
 701 
        $patch = 0;
575 
        $suffix = '';
 702 
        $suffix = '';
576 
    }
 703 
    }
577 
    #
 704 
    #
- 
 
 705 
    #       nnn.nnn.xxx
- 
 
 706 
    #
- 
 
 707 
    elsif ( $version =~ m~^(\d+)\.(\d+)(\.\w+)$~ ) {
- 
 
 708 
        $major = $1;
- 
 
 709 
        $minor = $2;
- 
 
 710 
        $patch = 0;
- 
 
 711 
        $suffix = $3;
- 
 
 712 
    }
- 
 
 713
- 
 
 714 
    #
578 
    #       nnn.nnn.nnnz
 715 
    #       nnn.nnn.nnnz
579 
    #
 716 
    #
580 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)([a-z])$~ ) {
 717 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)([a-z])$~ ) {
581 
        $major = $1;
 718 
        $major = $1;
582 
        $minor = $2;
 719 
        $minor = $2;
583 
        $patch = $3;
 720 
        $patch = $3;
584 
        $build = ord($4) - ord('a');
 721 
        $build = ord($4) - ord('a');
585 
        $suffix = '.cots';
 722 
        $suffix = '.cots';
- 
 
 723 
        $isaRipple = 0;
586 
    }
 724 
    }
587 
    #
 725 
    #
588 
    #       ???REV=???
 726 
    #       ???REV=???
589 
    #
 727 
    #
590 
    elsif ( $version =~ m~REV=~ ) {
 728 
    elsif ( $version =~ m~REV=~ ) {
Line 592... Line 730...
592 
        $result = $version . '.0000.cots';
 730 
        $result = $version . '.0000.cots';
593 
    }
 731 
    }
594 
 
 732 
 
595 
    #
 733 
    #
596 
    #   Wip Packages
 734 
    #   Wip Packages
- 
 
 735 
    #   (nnnnnn).xxx
597 
    #   Should be essential, but want to sort very low
 736 
    #   Should be essential, but want to sort very low
598 
    #
 737 
    #
599 
    elsif ($version =~ m~\((.*)\)(\.*)~) {
 738 
    elsif ($version =~ m~\((.*)\)(\..*)?~) {
600 
        $suffix = $2;
 739 
        $suffix = $2 || '';
601 
        $result = "000.000.000.000.$suffix";
 740 
        $result = "000.000.000.000$suffix";
602 
        $isaWIP = 1;
 741 
        $isaWIP = 1;
603 
    }
 742 
    }
- 
 
 743 
 
604 
    #
 744 
    #
- 
 
 745 
    #   !current
- 
 
 746 
    #
- 
 
 747 
    elsif ($version eq '!current' || $version eq 'current_$USER' || $version eq 'current' || $version eq 'beta' || $version eq 'latest' || $version eq 'beta.cr' || $version eq 'CREATE') {
- 
 
 748 
        $suffix = '';
- 
 
 749 
        $result = "000.000.000.000$suffix";
- 
 
 750 
        $isaWIP = 1;
- 
 
 751 
    }
- 
 
 752
- 
 
 753 
    #
- 
 
 754 
    #   Also WIP: FINRUN.103649.BEI.WIP
- 
 
 755 
    elsif ($version =~ m~(\.[a-zA-Z]+)\.WIP$~) {
- 
 
 756 
        $suffix = lc($1);
- 
 
 757 
        $result = "000.000.000.000$suffix";
- 
 
 758 
        $isaWIP = 1;
- 
 
 759 
    }
- 
 
 760 
 
- 
 
 761 
    #
- 
 
 762 
    #   Also ERGOFSSLS190100_015
605 
    #   zzzzzzzzzzzzzzz.cots
 763 
    #   Don't flag as a ripple
- 
 
 764 
    elsif ($version =~ m~^ERG[A-Z]+(\d\d)(\d\d)(\d\d)[-_](\d+)(\.\w+)?$~) {
- 
 
 765 
        $major = $1;
- 
 
 766 
        $minor = $2;
- 
 
 767 
        $patch = $3;
- 
 
 768 
        $build = $4;
606 
    #   zzzzzzzzzz.nnnn.cots
 769 
        $suffix = $5 || '.sls';
- 
 
 770 
        $isaRipple = 0;
- 
 
 771 
    }
- 
 
 772
- 
 
 773 
    #
- 
 
 774 
    #   Stuff we don't yet handle
607 
    #
 775 
    #
608 
    else  {
 776 
    else  {
609 
        Warning ("Unknown version number: '$name','$version'");
 777 
        Warning ("Unknown version number: $name,$version");
610 
        $version =~ m~(\.\w+)$~;
 778 
        $version =~ m~(\.\w+)$~;
611 
        $suffix = $1 || '';
 779 
        $suffix = $1 || '';
612 
        $result = $version;
 780 
        $result = $version;
613 
    }
 781 
    }
614 
 
 782 
 
615 
    $isaRipple = ($build > 0);
 783 
    $isaRipple = ($build > 0) unless defined $isaRipple;
616 
    unless ( $result )
 784 
    unless ( $result )
617 
    {
 785 
    {
- 
 
 786 
        # Major and minor of 99.99 are normally funny versions
- 
 
 787 
        # Don't make important decisions on them
- 
 
 788 
        #
- 
 
 789 
        if (defined $major && defined $minor && $major == 99 && $minor == 99 )
- 
 
 790 
        {
- 
 
 791 
            $major = 0;
- 
 
 792 
            $minor = 0;
- 
 
 793 
            $patch = 0;
- 
 
 794 
        }
- 
 
 795
618 
        $result = sprintf("%3.3d.%3.3d.%3.3d.%3.3d%s", $major,$minor,$patch,$build,$suffix || '.0000');
 796 
        $result = sprintf("%3.3d.%3.3d.%3.3d.%3.3d%s", $major,$minor,$patch,$build,$suffix || '.0000');
- 
 
 797 
        $buildVersion = [ $major, $minor, $patch, $build ];
619 
    }
 798 
    }
620 
 
 799 
 
- 
 
 800 
    $suffix = lc( $suffix );
621 
#    $suffix = $suffixFixup{$suffix} if ( exists $suffixFixup{$suffix} );
 801 
    if ( exists $suffixFixup{$suffix} )
- 
 
 802 
    {
- 
 
 803 
        $suffix = $suffixFixup{$suffix} ;
- 
 
 804 
    }
622 
 
 805 
 
623 
    return ($suffix, $result, $isaRipple, $isaWIP );
 806 
    return ($suffix, $result, $isaRipple, $isaWIP, $buildVersion );
624 
}
 807 
}
625 
 
 808 
 
626 
 
 809 
 
627 
#-------------------------------------------------------------------------------
 810 
#-------------------------------------------------------------------------------
628 
# Function        : LocateStrays
 811 
# Function        : LocateStrays
Line 646... Line 829...
646 
        $Packages{$pv_id}{done} = 1;
 829 
        $Packages{$pv_id}{done} = 1;
647 
    }
 830 
    }
648 
}
 831 
}
649 
 
 832 
 
650 
#-------------------------------------------------------------------------------
 833 
#-------------------------------------------------------------------------------
651 
# Function        : outputData
 834 
# Function        : countPackages
652 
#
 835 
#
653 
# Description     : Write out data in a form to allow post processing
 836 
# Description     :
654 
#
 837 
#
655 
# Inputs          :
838 
# Inputs          :
656 
#
 839 
#
657 
# Returns         :
840 
# Returns         : Number of packages and number oof versions
658 
#
 841 
#
659 
sub outputData
 842 
sub countPackages
660 
{
 843 
{
661 
    my $file = "cc2svn.raw.txt";
 844 
    my $v = 0;
662 
    Message ("Create: $file");
 845 
    my $p = 0;
663 
    my $fh = ConfigurationFile::New( $file );
 846 
    my %names;
664 
 
 847 
 
665 
    $fh->DumpData(
 848 
    foreach ( keys %Packages )
- 
 
 849 
    {
- 
 
 850 
        my $name = $Packages{$_}{name};
666 
        "\n# Releases.\n#\n",
 851 
        next unless ( $name );
667 
        "ScmReleases", \%Releases );
 852 
        $names{$name} = 1;
- 
 
 853 
        $v++;
- 
 
 854 
    }
- 
 
 855 
 
- 
 
 856 
    $p = keys %names;
- 
 
 857 
 
- 
 
 858 
    return $p,$v;
668 
 
 859 
 
- 
 
 860 
}
- 
 
 861 
 
- 
 
 862 
#-------------------------------------------------------------------------------
- 
 
 863 
# Function        : processData
- 
 
 864 
#
- 
 
 865 
# Description     : Process data before its written out
- 
 
 866 
#                       Remove a few packages that we do not want to now about
- 
 
 867 
#                       Determine Reason that a version is in the list
- 
 
 868 
#                       Finish taging packages in NamedProject
- 
 
 869 
#
- 
 
 870 
# Inputs          :
- 
 
 871 
#
- 
 
 872 
# Returns         :
- 
 
 873 
#
- 
 
 874 
sub processData
- 
 
 875 
{
669 
    foreach ( keys %Packages )
 876 
    foreach ( keys %Packages )
670 
    {
 877 
    {
671 
        delete $Packages{$_}{done};
 878 
        delete $Packages{$_}{done};
672 
        next if ( $Packages{$_}{name} =~ ~m~CSWcfengine~ );
 879 
        next if ( $Packages{$_}{name} =~ ~m~CSWcfengine~ );
673 
 
 880 
 
Line 686... Line 893...
686 
        if ( $Packages{$_}{name} =~ m/^jats_/)
 893 
        if ( $Packages{$_}{name} =~ m/^jats_/)
687 
        {
 894 
        {
688 
            delete $Packages{$_};
 895 
            delete $Packages{$_};
689 
            next;
 896 
            next;
690 
        }
 897 
        }
- 
 
 898 
 
- 
 
 899 
 
- 
 
 900 
        #
- 
 
 901 
        #   Catch packages that are dependents of NamedProject's
- 
 
 902 
        #
- 
 
 903 
        if ( $doIncludeOnly )
- 
 
 904 
        {
- 
 
 905 
            if ( exists  $Packages{$_}{'sbomBase'} || exists  $Packages{$_}{'sbomOsid'} )
- 
 
 906 
            {
- 
 
 907 
                $Packages{$_}{NamedProject} = 4;
- 
 
 908 
            }
- 
 
 909 
 
- 
 
 910 
            unless ( $Packages{$_}{NamedProject}  )
- 
 
 911 
            {
- 
 
 912 
                my $named;
- 
 
 913 
                my %usedBy;
- 
 
 914 
 
- 
 
 915 
                if ( exists $Packages{$_}{'usedBy'})
- 
 
 916 
                {
- 
 
 917 
                    my @examineThese = @{$Packages{$_}{'usedBy'}};
- 
 
 918 
                    while ( @examineThese )
- 
 
 919 
                    {
- 
 
 920 
                        my $pvid = pop @examineThese;
- 
 
 921 
                        next if ( $usedBy{$pvid} );
- 
 
 922 
 
- 
 
 923 
                        if ( $Packages{$pvid}{NamedProject}  )
- 
 
 924 
                        {
- 
 
 925 
                            $named = 1;
- 
 
 926 
                            last;
- 
 
 927 
                        }
- 
 
 928 
 
- 
 
 929 
                        push @examineThese, @{$Packages{$pvid}{'usedBy'}}
- 
 
 930 
                            if (exists $Packages{$pvid}{'usedBy'});
- 
 
 931 
                    }
- 
 
 932 
                    $Packages{$_}{NamedProject} = 5
- 
 
 933 
                        if ( $named );
- 
 
 934 
                }
- 
 
 935 
#                else
- 
 
 936 
#                {
- 
 
 937 
#                    Warning("Not Named and not usedBy: $Packages{$_}{name} $Packages{$_}{'version'}");
- 
 
 938 
#                }
- 
 
 939 
            }
- 
 
 940 
        }
- 
 
 941 
        else
- 
 
 942 
        {
- 
 
 943 
            $Packages{$_}{NamedProject} = 6;
691
944 
        }
692 
    }
 945 
    }
- 
 
 946 
}
- 
 
 947 
 
- 
 
 948 
#-------------------------------------------------------------------------------
- 
 
 949 
# Function        : outputData
- 
 
 950 
#
- 
 
 951 
# Description     : Write out data in a form to allow post processing
- 
 
 952 
#
- 
 
 953 
# Inputs          :
- 
 
 954 
#
- 
 
 955 
# Returns         :
- 
 
 956 
#
- 
 
 957 
sub outputData
- 
 
 958 
{
- 
 
 959 
    my $file = "cc2svn.raw.txt";
- 
 
 960 
    Message ("Create: $file");
- 
 
 961 
    my $fh = ConfigurationFile::New( $file );
- 
 
 962 
 
- 
 
 963 
    $fh->DumpData(
- 
 
 964 
        "\n# Releases.\n#\n",
- 
 
 965 
        "ScmReleases", \%Releases );
693 
 
 966 
 
694 
    $fh->DumpData(
 967 
    $fh->DumpData(
695 
        "\n# Packages.\n#\n",
 968 
        "\n# Packages.\n#\n",
696 
        "ScmPackages", \%Packages );
 969 
        "ScmPackages", \%Packages );
697 
 
 970 
 
Line 747... Line 1020...
747 
    -help              - brief help message
 1020 
    -help              - brief help message
748 
    -help -help        - Detailed help message
 1021 
    -help -help        - Detailed help message
749 
    -man               - Full documentation
 1022 
    -man               - Full documentation
750 
    -test=version      - Test a version string, then exit
 1023 
    -test=version      - Test a version string, then exit
751 
    -limit=n           - Limit packages processed. Test only
 1024 
    -limit=n           - Limit packages processed. Test only
- 
 
 1025 
    -mode=xxx          - Set Mode: all, hops, standard
752 
 
 1026 
 
753 
=head1 OPTIONS
 1027 
=head1 OPTIONS
754 
 
 1028 
 
755 
=over 8
 1029 
=over 8
756 
 
 1030