Subversion Repositories DevTools

Rev

Rev 2016 | Rev 2429 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
392 dpurdie 1 
########################################################################
2 
# Copyright (C) 1998-2012 Vix Technology, All rights reserved
3 
#
4 
# Module name   : cc2svn_gendata.pl
5 
# Module type   : Makefile system
6 
# Compiler(s)   : Perl
7 
# Environment(s): jats
8 
#
9 
# Description   : Get all packages that are used in all releases
10 
#                 Create a data file that can be used offline
11 
#
12 
#                 The process will exclude some old releases
13 
#
14 
#                 Generate data on Essential Package Versions to be
15 
#                 transferred from CC to Subversion
16 
#
17 
#......................................................................#
18 
 
19 
require 5.006_001;
20 
use strict;
21 
use warnings;
22 
use JatsError;
23 
use JatsSystem;
24 
use Getopt::Long;
25 
use Pod::Usage;                             # required for help support
26 
use JatsRmApi;
27 
use ConfigurationFile;
28 
 
29 
use DBI;
30 
use HTTP::Date;
31 
 
32 
my $VERSION = "1.2.3";                      # Update this
33 
my $opt_verbose = 0;
34 
my $opt_help = 0;
35 
my $opt_manual;
36 
my $opt_test;
37 
my $opt_limit;
38 
my $opt_quick;
1197 dpurdie 39 
my $opt_mode = '';
392 dpurdie 40 
my $RM_DB;
41 
my $now = time();
42 
 
43 
#
44 
#   Package information
45 
#
46 
my %Releases;
47 
my %Packages;
48 
my %Suffixes;
49 
my @StrayPackages;
50 
my %AllPackages;
51 
 
52 
my $doAllReleases = 0;
53 
my $doIncludeOnly = 0;
54 
my @includedProjects = (
55 
#        481,    # UK BUS HOPS
56 
);
57 
 
58 
my @includedReleases = (
59 
        6222,   # HOME > UK STAGE COACH (SSW) > Mainline
60 
        14503,  # HOME > UK STAGE COACH (SSW) > ITSO_HOPS_3
61 
        21303,  # HOME > UK STAGE COACH (SSW) > SUPPORT_HOPS_REPORTS
62 
        21343,  # HOME > UK STAGE COACH (SSW) > SUPPORT_CIPP
63 
        17223,  # HOME > UK STAGE COACH (SSW) > ITSO HOPS 4
1453 dpurdie 64 
        21864,  # Hops3.6'
65 
        22303   # Hops3.7
392 dpurdie 66 
);
67 
 
68 
 
69 
my @excludeProjects = ( 162,            # WASHINGTON (WDC)
70 
                        341,            # TUTORIAL (TUT)
71 
                        142,            # SYDNEY (SYD)
72 
                        182 ,           # ROME (ROM)
73 
                        6 ,             # GMPTE/PCL (GMP)
74 
                        521,            # NSW CLUB CARD
75 
                        221,            # NZ STAGE COACH (NZS)
1197 dpurdie 76 
                        82,             # LVS
77 
                        42,             # SFO
78 
                        641,            # BCC Releaeses
79 
                        62,             # OSLO
80 
                        4,              # Singapore
81 
                        441,            # Tas
82 
                        102,            # Ventura
392 dpurdie 83 
                        );
84 
my @excludeReleases = ( 20424,          # MASS_REF (MAS) > test
1197 dpurdie 85 
                        # RJACK 9043,           # TECHNOLOGY GROUP > Development Environment - For Test Setup
86 
                        # RJACK 14383,          # TECHNOLOGY GROUP > eBrio TDS
87 
                        # RJACK 20463,          # TECHNOLOGY GROUP > TPIT - BackOffice Linux build
88 
                        # RJACK 14603,          # TECHNOLOGY GROUP > TPIT - BackOffice 64 bit [CCB Mode!]
392 dpurdie 89 
                        #9263,           # TECHNOLOGY GROUP > Buildtool DEVI&TEST
90 
                        22163,          # GLOBAL PRODUCT MGMT > Rio Tinto - Remote Draught Survey
91 
                        19483,          # SEATTLE (SEA) > Phase 2 - I18 [backup] [Restrictive Mode]
92 
                        20403,          # SEATTLE (SEA) > Phase 2 - I19 [backup]
93 
                        20983,          # ??? May have been deleted
395 dpurdie 94 
                        13083,          # TECHNOLOGY GROUP > TRACS
95 
                        15224,          # 64Bit Solaris Test
1197 dpurdie 96 
 
392 dpurdie 97 
                        );
98 
 
99 
my %sillyVersions =
100 
(
101 
    '2b6'           => '2.6.0.cots',
102 
    '1.0b2'         => '1.0.2.cots',
103 
    '1.6.x'         => '1.6.0.cots',
104 
    '3.5beta12.5'   => '3.5.12.5.cots',
1197 dpurdie 105 
    '1.0b1.1.mas'   => '1.1.1.mas',
392 dpurdie 106 
);
1197 dpurdie 107 
 
108 
my %suffixFixup = (
109 
    '.sf'           => '.sfo',
110 
    '.vt'           => '.vtk',
111 
    '.lv'           => '.lvs',
112 
    '.was'          => '.wdc',
113 
    '.uk.1'         => '.uk',
114 
    '.ssts.demo'    => '.ssts',
115 
    '.u244.syd'     => '.syd',
116 
    '.pxxx.sea'     => '.sea',
117 
    '.pxxx.syd'     => '.syd',
118 
    '.pxxx.sydddd'  => '.syd',
119 
    '.oslo'         => '.oso',
120 
);
392 dpurdie 121 
 
122 
#-------------------------------------------------------------------------------
123 
# Function        : Main Entry
124 
#
125 
# Description     :
126 
#
127 
# Inputs          :
128 
#
129 
# Returns         :
130 
#
131 
my $result = GetOptions (
132 
                "help+"         => \$opt_help,          # flag, multiple use allowed
133 
                "manual"        => \$opt_manual,        # flag
134 
                "verbose+"      => \$opt_verbose,       # flag
135 
                "test:s"        => \$opt_test,          # Test a version string
136 
                "limit:n"       => \$opt_limit,         #
137 
                "quick"         => \$opt_quick,         # Don't look for indirects
1197 dpurdie 138 
                'mode:s'        => \$opt_mode,          # Mode of operation
392 dpurdie 139 
                );
140 
 
141 
#
142 
#   Process help and manual options
143 
#
144 
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
145 
pod2usage(-verbose => 1)  if ($opt_help == 2 );
146 
pod2usage(-verbose => 2)  if ($opt_manual || ($opt_help > 2));
1197 dpurdie 147 
ErrorConfig( 'name'    =>'CC2SVN_GENDATA' );
392 dpurdie 148 
 
149 
if ( $opt_test )
150 
{
151 
    my @results = massageVersion( $opt_test, 'DummyName' );
152 
    Message ("Version", $opt_test, @results);
153 
    exit 1;
154 
}
155 
 
1197 dpurdie 156 
#
157 
#   Set up the mode
158 
#   Must be specified
159 
#
160 
if ( $opt_mode eq 'all' ) {
161 
    $doAllReleases = 1;
162 
    $doIncludeOnly = 0;
163 
 
164 
} elsif ( $opt_mode eq 'hops' ) {
165 
    $doAllReleases = 0;
166 
    $doIncludeOnly = 1;
392 dpurdie 167 
 
1197 dpurdie 168 
} elsif ( $opt_mode eq 'standard' ) {
169 
    $doAllReleases = 0;
170 
    $doIncludeOnly = 0;
171 
 
172 
} else {
173 
    Error ("Mode not specified: all, hops, standard");
174 
}
175 
 
392 dpurdie 176 
GetAllPackageNames();
177 
getReleaseDetails();
178 
getPkgDetailsByRTAG_ID();
1197 dpurdie 179 
my ($pcount, $vcount) = countPackages();
180 
print "Directly referenced Packages: $pcount Versions: $vcount\n";
392 dpurdie 181 
LocateStrays() unless ($opt_quick);
1197 dpurdie 182 
($pcount, $vcount) = countPackages();
183 
print "Indirectly referenced Packages: $pcount Versions: $vcount\n";
184 
processData();
392 dpurdie 185 
outputData();
186 
 
187 
if ( $opt_verbose > 1 )
188 
{
189 
    print "=========================================================================\n";
190 
    DebugDumpData("Releases", \%Releases);
191 
    print "=========================================================================\n";
192 
    DebugDumpData("Packages", \%Packages );
193 
    print "=========================================================================\n";
194 
    DebugDumpData("Suffixes", \%Suffixes );
195 
}
196 
 
1197 dpurdie 197 
($pcount, $vcount) = countPackages();
198 
print "Total References Packages: $pcount Versions: $vcount\n";
392 dpurdie 199 
exit;
200 
 
201 
#-------------------------------------------------------------------------------
202 
# Function        : getReleaseDetails
203 
#
204 
# Description     : Determine all candiate releases
205 
#
206 
# Inputs          :
207 
#
208 
# Returns         :
209 
#
210 
sub getReleaseDetails
211 
{
212 
    my (@row);
213 
 
214 
    # if we are not or cannot connect then return 0 as we have not found anything
215 
    connectRM(\$RM_DB) unless $RM_DB;
216 
 
217 
    # First get all packages that are referenced in a Release
218 
    # This will only get the top level packages
219 
    # From non-archived releases
220 
 
221 
    my $m_sqlstr = "SELECT prj.PROJ_NAME, rt.RTAG_NAME, rt.PROJ_ID, rt.RTAG_ID, rt.official" .
222 
                   " FROM release_manager.release_tags rt, release_manager.projects prj" .
223 
                   " WHERE prj.PROJ_ID = rt.PROJ_ID " .
1197 dpurdie 224 
#                   "   AND rt.official != 'A' ".
225 
#                   "   AND rt.official != 'Y'" .
392 dpurdie 226 
                   " order by prj.PROJ_NAME";
227 
    my $sth = $RM_DB->prepare($m_sqlstr);
228 
    if ( defined($sth) )
229 
    {
230 
        if ( $sth->execute( ) )
231 
        {
232 
#            print "--- Execute\n";
233 
            if ( $sth->rows )
234 
            {
235 
#                print "--- Execute ROWS\n";
236 
                while ( @row = $sth->fetchrow_array )
237 
                {
238 
                    my $rtag_id =$row[3];
239 
                    my $proj_id = $row[2];
240 
 
241 
                    $Releases{$rtag_id}{pName} = $row[0];
242 
                    $Releases{$rtag_id}{name} = $row[1];
243 
                    $Releases{$rtag_id}{proj_id} = $proj_id;
244 
                    $Releases{$rtag_id}{rtag_id} = $rtag_id;
245 
                    $Releases{$rtag_id}{official} = $row[4];
246 
 
247 
                    unless ( $doAllReleases )
248 
                    {
249 
                        if (grep {$_ eq $proj_id} @excludeProjects) {
250 
                            $Releases{$rtag_id}{excluded} = 'E';
251 
                        }
252 
 
253 
                        if (grep {$_ eq $rtag_id} @excludeReleases) {
254 
                            $Releases{$rtag_id}{excluded} = 'E';
255 
                        }
256 
                    }
257 
 
258 
                    if ( $doIncludeOnly )
259 
                    {
260 
 
261 
                        if (grep {$_ eq $proj_id} @includedProjects)
262 
                        {
263 
                            delete $Releases{$rtag_id}{excluded};
264 
                        }
265 
                        else
266 
                        {
267 
                            $Releases{$rtag_id}{excluded} = 'E';
268 
                        }
269 
 
270 
                        if (grep {$_ eq $rtag_id} @includedReleases)
271 
                        {
272 
                            delete $Releases{$rtag_id}{excluded};
273 
                        }
274 
                    }
275 
 
276 
                    unshift @row, $Releases{$rtag_id}{excluded} || ' ';
277 
                    print join (',',@row), "\n" if ($opt_verbose);
278 
                }
279 
            }
280 
#            print "--- Finish\n";
281 
            $sth->finish();
282 
        }
283 
        else
284 
        {
285 
            Error("Execute failure: $m_sqlstr", $sth->errstr() );
286 
        }
287 
    }
288 
    else
289 
    {
290 
        Error("Prepare failure" );
291 
    }
292 
}
293 
 
294 
 
1197 dpurdie 295 
sub getPkgDetailsByPVID
296 
{
297 
    my ($pv_id) = @_;
298 
    my (@row);
299 
 
300 
    #
301 
    #   Only do once
302 
    #
303 
    return if ( exists $Packages{$pv_id}{name} );
304 
 
305 
    # if we are not or cannot connect then return 0 as we have not found anything
306 
    connectRM(\$RM_DB) unless $RM_DB;
307 
 
308 
    my $m_sqlstr = "SELECT" .
309 
                        " pv.PV_ID, ".                                          #[0]
310 
                        " pkg.PKG_NAME, ".                                      #[1]
311 
                        " pv.PKG_VERSION, ".                                    #[2]
312 
                        " pv.DLOCKED," .                                        #[3]
313 
                        " release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), ". #[4]
314 
                        " pv.PKG_ID," .                                         #[5]
315 
                        " pv.MODIFIED_STAMP  ".                                 #[6]
316 
                   " FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv,".
317 
                   "      RELEASE_MANAGER.PACKAGES pkg ".
318 
                   " WHERE pv.PV_ID = \'$pv_id\' ".
319 
                   "   AND pv.PKG_ID = pkg.PKG_ID" ;
320 
    my $sth = $RM_DB->prepare($m_sqlstr);
321 
    if ( defined($sth) )
322 
    {
323 
        if ( $sth->execute( ) )
324 
        {
325 
#            print "--- Execute\n";
326 
            if ( $sth->rows )
327 
            {
328 
#                print "--- Execute ROWS\n";
329 
                while ( @row = $sth->fetchrow_array )
330 
                {
331 
                    print join (',',@row), "\n" if ($opt_verbose);
332 
 
333 
                    my $pvid = $row[0];
334 
                    $Packages{$pvid}{name} = $row[1];
335 
                    $Packages{$pvid}{version} = $row[2];
336 
                    $Packages{$pvid}{locked} = $row[3];
337 
                    $row[4] =~ tr~\\/~/~;
338 
                    $Packages{$pvid}{vcstag} = $row[4];
339 
                    $Packages{$pvid}{pkgid} = $row[5];
340 
#                    $Packages{$pvid}{tlp} = 1;
341 
                    ($Packages{$pvid}{suffix}, $Packages{$pvid}{fullVersion},$Packages{$pvid}{isaRipple} ) = massageVersion( $Packages{$pvid}{version}, $Packages{$pvid}{name} );
342 
                    $Suffixes{$Packages{$pvid}{suffix}}++;
343 
                    $Packages{$pvid}{Age} = ($now - str2time( $row[6] )) / (60 * 60 * 24);
344 
                }
345 
            }
346 
#            print "--- Finish\n";
347 
            $sth->finish();
348 
        }
349 
        else
350 
        {
351 
            Error("getPkgDetailsByPVID:Execute failure: $m_sqlstr", $sth->errstr() );
352 
        }
353 
    }
354 
    else
355 
    {
356 
        Error("getPkgDetailsByPVID:Prepare failure" );
357 
    }
358 
}
359 
 
360 
 
392 dpurdie 361 
sub getPkgDetailsByRTAG_ID
362 
{
363 
    my (@row);
364 
    my $excludes = '';
365 
    my $count = 0;
366 
 
367 
    # if we are not or cannot connect then return 0 as we have not found anything
368 
    connectRM(\$RM_DB) unless $RM_DB;
369 
 
370 
    Message ("Extract toplevel dependencies");
371 
 
372 
    # First get all packages that are referenced in a Release
373 
    # This will only get the top level packages
374 
    # From non-archived releases
375 
 
376 
    unless ($doAllReleases)
377 
    {
378 
        foreach  ( @excludeProjects )
379 
        {
380 
            $excludes .= " AND prj.PROJ_ID != $_ ";
381 
        }
382 
        foreach  ( @excludeReleases )
383 
        {
384 
            $excludes .= " AND rt.RTAG_ID != $_ ";
385 
        }
386 
    }
387 
 
1454 dpurdie 388 
    my $m_sqlstr = "SELECT DISTINCT " .
389 
                        "pv.PV_ID, " .                                          #[0]
390 
                        "pkg.PKG_NAME, " .                                      #[1]
391 
                        "pv.PKG_VERSION, " .                                    #[2]
392 
                        "pv.DLOCKED, " .                                        #[3]
393 
                        "release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), " . #[4]
2016 dpurdie 394 
                        "pv.PKG_ID," .                                          #[5]
1454 dpurdie 395 
                        "rt.RTAG_ID, " .                                        #[6]
396 
                        "rmv.VIEW_NAME, " .                                     #[7]
397 
                        "pv.MODIFIED_STAMP, " .                                 #[8]
398 
                        "prj.PROJ_ID " .                                        #[9]
392 dpurdie 399 
                   " FROM RELEASE_MANAGER.RELEASE_CONTENT rc, RELEASE_MANAGER.PACKAGE_VERSIONS pv,".
400 
                   "      RELEASE_MANAGER.PACKAGES pkg, release_manager.release_tags rt, release_manager.projects prj" .
401 
                   "    , release_manager.views rmv" .
402 
                   " WHERE rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID" .
403 
                   "   AND rmv.VIEW_ID = rc.BASE_VIEW_ID" .
404 
                   "   AND prj.PROJ_ID = rt.PROJ_ID and rt.RTAG_ID = rc.RTAG_ID" .
1197 dpurdie 405 
#                   "   AND rt.official != 'A'" .
406 
#                   "   AND rt.official != 'Y' " .
392 dpurdie 407 
                   $excludes .
408 
                   " order by pkg.PKG_NAME";
409 
    my $sth = $RM_DB->prepare($m_sqlstr);
410 
    if ( defined($sth) )
411 
    {
412 
        if ( $sth->execute( ) )
413 
        {
414 
#            print "--- Execute\n";
415 
            if ( $sth->rows )
416 
            {
417 
#                print "--- Execute ROWS\n";
418 
                while ( @row = $sth->fetchrow_array )
419 
                {
420 
                    print join (',',@row), "\n" if ($opt_verbose);
421 
                    my $pvid = $row[0];
422 
                    unless ( exists $Packages{$pvid}{name} )
423 
                    {
424 
                        $Packages{$pvid}{name} = $row[1];
425 
                        $Packages{$pvid}{version} = $row[2];
426 
                        $Packages{$pvid}{locked} = $row[3];
427 
                        $row[4] =~ tr~\\/~/~;
428 
                        $Packages{$pvid}{vcstag} = $row[4];
429 
                        $Packages{$pvid}{pkgid} = $row[5];
430 
                        $Packages{$pvid}{tlp} = 1;
431 
                        ($Packages{$pvid}{suffix}, $Packages{$pvid}{fullVersion},$Packages{$pvid}{isaRipple} ) = massageVersion( $Packages{$pvid}{version}, $Packages{$pvid}{name} );
432 
                        $Suffixes{$Packages{$pvid}{suffix}}++;
433 
 
434 
                        push @StrayPackages, $pvid;
435 
                    }
436 
 
437 
                    my $rtag_id = $row[6];
438 
                    push @{$Packages{$pvid}{release}}, $rtag_id;
439 
                    $Packages{$pvid}{view}{$row[7]}++ if ( $row[7] );
440 
 
441 
                    $Packages{$pvid}{Age} = ($now - str2time( $row[8] )) / (60 * 60 * 24);
442 
 
443 
                    my $proj_id = $row[9];
1197 dpurdie 444 
                    push @{$Packages{$pvid}{projects}}, $proj_id
445 
                        unless (grep {$_ eq $proj_id} @{$Packages{$pvid}{projects}});
392 dpurdie 446 
 
447 
                    if ( $doIncludeOnly )
448 
                    {
449 
                        if (grep {$_ eq $proj_id} @includedProjects)
450 
                        {
451 
                            $Packages{$pvid}{NamedProject} = 1;
452 
                        }
453 
                        if (grep {$_ eq $rtag_id} @includedReleases)
454 
                        {
1197 dpurdie 455 
                            $Packages{$pvid}{NamedProject} = 2;
392 dpurdie 456 
                        }
457 
                    }
458 
                    else
459 
                    {
1197 dpurdie 460 
                        $Packages{$pvid}{NamedProject} = 3;
392 dpurdie 461 
                    }
462 
 
463 
 
464 
                    if ( $opt_limit )
465 
                    {
466 
                        last if ( $count++ > $opt_limit );
467 
                    }
468 
                }
469 
            }
470 
#            print "--- Finish\n";
471 
            $sth->finish();
472 
        }
473 
        else
474 
        {
475 
            Error("Execute failure: $m_sqlstr", $sth->errstr() );
476 
        }
477 
    }
478 
    else
479 
    {
480 
        Error("Prepare failure" );
481 
    }
482 
}
483 
 
484 
#-------------------------------------------------------------------------------
485 
# Function        : GetDepends
486 
#
487 
# Description     :
488 
#
489 
# Inputs          : $pvid
490 
#
491 
# Returns         :
492 
#
493 
sub GetDepends
494 
{
495 
    my ($pv_id ) = @_;
496 
 
497 
    #
1197 dpurdie 498 
    #   Ensure we have package information
499 
    #
500 
    getPkgDetailsByPVID( $pv_id );
501 
    return if ( $Packages{$pv_id}{depend} );
502 
    $Packages{$pv_id}{depend} = 1;
503 
 
504 
    #
392 dpurdie 505 
    #   Now extract the package dependacies
1197 dpurdie 506 
    #   There may not be any
392 dpurdie 507 
    #
1197 dpurdie 508 
    my $m_sqlstr = "SELECT ".
509 
                    " pd.PV_ID, ".
510 
                    " pd.DPV_ID " .
511 
                  " FROM    RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd ".
512 
                  " WHERE pd.PV_ID = \'$pv_id\'";
392 dpurdie 513 
    my $sth = $RM_DB->prepare($m_sqlstr);
514 
    if ( defined($sth) )
515 
    {
516 
        if ( $sth->execute( ) )
517 
        {
518 
            if ( $sth->rows )
519 
            {
520 
                while ( my @row = $sth->fetchrow_array )
521 
                {
522 
                    my $pvid = $row[0];
1197 dpurdie 523 
                    my $dpvid = $row[1];
524 
                    push @StrayPackages, $dpvid;
525 
                    push @{$Packages{$dpvid}{usedBy}}, $pvid;
392 dpurdie 526 
                }
527 
            }
528 
            $sth->finish();
529 
        }
530 
        else
531 
        {
1197 dpurdie 532 
            Error("GetDepends:Execute failure: $m_sqlstr", $sth->errstr() );
392 dpurdie 533 
        }
534 
    }
535 
    else
536 
    {
537 
        Error("GetDepends:Prepare failure" );
538 
    }
539 
}
540 
 
541 
#-------------------------------------------------------------------------------
542 
# Function        : GetAllPackageNames
543 
#
544 
# Description     :
545 
#
546 
# Inputs          : None
547 
#
548 
# Returns         :
549 
#
550 
sub GetAllPackageNames
551 
{
552 
    # if we are not or cannot connect then return 0 as we have not found anything
553 
    connectRM(\$RM_DB) unless $RM_DB;
554 
 
555 
    #
556 
    #   Now extract all the package names
557 
    #
558 
    my $m_sqlstr = "SELECT pkg.PKG_ID, pkg.PKG_NAME" .
559 
                  " FROM RELEASE_MANAGER.PACKAGES pkg";
560 
    my $sth = $RM_DB->prepare($m_sqlstr);
561 
    if ( defined($sth) )
562 
    {
563 
        if ( $sth->execute( ) )
564 
        {
565 
            if ( $sth->rows )
566 
            {
567 
                while ( my @row = $sth->fetchrow_array )
568 
                {
569 
                    my $id = $row[0];
570 
                    my $name = $row[1];
571 
                    next unless ( $id );
572 
                    $AllPackages{$id} = $name;
573 
                }
574 
            }
575 
            $sth->finish();
576 
        }
577 
        else
578 
        {
579 
        Error("GetAllPackageNames:Execute failure" );
580 
        }
581 
    }
582 
    else
583 
    {
584 
        Error("GetAllPackageNames:Prepare failure" );
585 
    }
586 
}
587 
 
588 
 
589 
#-------------------------------------------------------------------------------
590 
# Function        : massageVersion
591 
#
592 
# Description     : Process a version number and return usful bits
593 
#
594 
# Inputs          : Version Number
595 
#                   Package Name - debug only
596 
#
597 
# Returns         : An array
598 
#                       suffix
599 
#                       multipart version string useful for text comparisons
600 
#
601 
sub massageVersion
602 
{
603 
    my ($version, $name) = @_;
604 
    my ($major, $minor, $patch, $build, $suffix);
605 
    my $result;
1197 dpurdie 606 
    my $buildVersion;
392 dpurdie 607 
    my $isaRipple;
608 
    my $isaWIP;
609 
    $build = 0;
610 
 
1197 dpurdie 611 
#print "--- $name, $version\n";
612 
    $version =~ s~^_~~;
613 
    $version =~ s~^\Q${name}\E_~~;
614 
 
392 dpurdie 615 
    #
616 
    #   Pre-massage some silly ones
617 
    #
618 
    if ( exists $sillyVersions{$version} ) {
619 
        $version = $sillyVersions{$version};
620 
    }
621 
 
1197 dpurdie 622 
    if ( $name eq 'ReleaseName' ) {
623 
        $version =~ s~[a-z]~.~g;
624 
        $version =~ s~\.+~.~g;
625 
        $version =~ s~\.$~~g
626 
    }
392 dpurdie 627 
 
1197 dpurdie 628 
    #
629 
    #   xxxxxxxxx.nnnn.cots
630 
    #
392 dpurdie 631 
    if ( $version =~ m~(.*)\.cots$~ ) {
632 
        my $cots_base = $1;
633 
        $suffix = '.cots';
634 
        if ( $version =~ m~(.*?)\.([0-9]{4})\.cots$~ )
635 
        {
636 
            $result = $1 . sprintf (".%4.4d", $2) . $suffix;
637 
        }
638 
        else
639 
        {
640 
            $result = $cots_base . '.0000.cots';
641 
        }
642 
    }
643 
    #
644 
    #   Convert version into full form for comparisions
645 
    #       nnn.nnn.nnn.[p]nnn.xxx
646 
    #       nnn.nnn.nnn.[p]nnn-xxx
647 
    #       nnn.nnn.nnn-[p]nnn.xxx
648 
    #       nnn.nnn.nnn-[p]nnn-xxx
649 
    #       nnn.nnn.nnn[p]nnn-xxx
1197 dpurdie 650 
    #   Don't flag as ripples - they are patches
392 dpurdie 651 
    #
652 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-.p][p]?(\d+)([-.](.*))?$~ ) {
653 
        $major = $1;
654 
        $minor = $2;
655 
        $patch = $3;
656 
        $build = $4;
657 
        $suffix = defined $6 ? ".$6" : '';
1197 dpurdie 658 
        $isaRipple = 0;
392 dpurdie 659 
    }
660 
    #
661 
    #       nn.nnn.nnnnn.xxx
662 
    #       nn.nnn.nnnnn-xxx
1197 dpurdie 663 
    #       nnn.nnn.nnnx.xxx
664 
    #   Don't flag as ripples - they are patches
392 dpurdie 665 
    #
1197 dpurdie 666 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)\w?([-.](.*))?$~ ) {
392 dpurdie 667 
        $major = $1;
668 
        $minor = $2;
669 
        $patch = $3;
670 
        if ( length( $patch) >= 4 )
671 
        {
672 
            $build = substr( $patch, -3 ,3);
673 
            $patch = substr( $patch,  0 ,length($patch)-3);
674 
        }
675 
        $suffix = defined $5 ? ".$5" : '';
676 
    }
1197 dpurdie 677 
 
392 dpurdie 678 
    #
1197 dpurdie 679 
    #       nnn.nnn.nnn
680 
    #       nnn.nnn-nnn
681 
    #       nnn.nnn_nnn
392 dpurdie 682 
    #
1197 dpurdie 683 
    elsif ( $version =~ m~^(\d+)\.(\d+)[-._](\d+)$~ ) {
392 dpurdie 684 
        $major = $1;
685 
        $minor = $2;
686 
        $patch = $3;
687 
        $suffix = '';
688 
    }
1197 dpurdie 689 
 
392 dpurdie 690 
    #
1197 dpurdie 691 
    #       nnn.nnn.nnn.nnn
692 
    #       nnn.nnn.nnn-nnn
693 
    #       nnn.nnn.nnn_nnn
392 dpurdie 694 
    #
1197 dpurdie 695 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-._](\d+)$~ ) {
392 dpurdie 696 
        $major = $1;
697 
        $minor = $2;
698 
        $patch = $3;
1197 dpurdie 699 
        $build = $4;
392 dpurdie 700 
        $suffix = '';
1197 dpurdie 701 
        $isaRipple = 0;
392 dpurdie 702 
    }
1197 dpurdie 703 
 
392 dpurdie 704 
 
705 
    #
706 
    #       nnn.nnn
707 
    #
708 
    elsif ( $version =~ m~^(\d+)\.(\d+)$~ ) {
709 
        $major = $1;
710 
        $minor = $2;
711 
        $patch = 0;
712 
        $suffix = '';
713 
    }
714 
    #
1197 dpurdie 715 
    #       nnn.nnn.xxx
716 
    #
717 
    elsif ( $version =~ m~^(\d+)\.(\d+)(\.\w+)$~ ) {
718 
        $major = $1;
719 
        $minor = $2;
720 
        $patch = 0;
721 
        $suffix = $3;
722 
    }
723 
 
724 
    #
392 dpurdie 725 
    #       nnn.nnn.nnnz
726 
    #
727 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)([a-z])$~ ) {
728 
        $major = $1;
729 
        $minor = $2;
730 
        $patch = $3;
731 
        $build = ord($4) - ord('a');
732 
        $suffix = '.cots';
1197 dpurdie 733 
        $isaRipple = 0;
392 dpurdie 734 
    }
735 
    #
736 
    #       ???REV=???
737 
    #
738 
    elsif ( $version =~ m~REV=~ ) {
739 
        $suffix = '.cots';
740 
        $result = $version . '.0000.cots';
741 
    }
742 
 
743 
    #
744 
    #   Wip Packages
1197 dpurdie 745 
    #   (nnnnnn).xxx
392 dpurdie 746 
    #   Should be essential, but want to sort very low
747 
    #
1197 dpurdie 748 
    elsif ($version =~ m~\((.*)\)(\..*)?~) {
749 
        $suffix = $2 || '';
750 
        $result = "000.000.000.000$suffix";
392 dpurdie 751 
        $isaWIP = 1;
752 
    }
1197 dpurdie 753 
 
392 dpurdie 754 
    #
1197 dpurdie 755 
    #   !current
392 dpurdie 756 
    #
1197 dpurdie 757 
    elsif ($version eq '!current' || $version eq 'current_$USER' || $version eq 'current' || $version eq 'beta' || $version eq 'latest' || $version eq 'beta.cr' || $version eq 'CREATE') {
758 
        $suffix = '';
759 
        $result = "000.000.000.000$suffix";
760 
        $isaWIP = 1;
761 
    }
762 
 
763 
    #
764 
    #   Also WIP: FINRUN.103649.BEI.WIP
765 
    elsif ($version =~ m~(\.[a-zA-Z]+)\.WIP$~) {
766 
        $suffix = lc($1);
767 
        $result = "000.000.000.000$suffix";
768 
        $isaWIP = 1;
769 
    }
770 
 
771 
    #
772 
    #   Also ERGOFSSLS190100_015
773 
    #   Don't flag as a ripple
774 
    elsif ($version =~ m~^ERG[A-Z]+(\d\d)(\d\d)(\d\d)[-_](\d+)(\.\w+)?$~) {
775 
        $major = $1;
776 
        $minor = $2;
777 
        $patch = $3;
778 
        $build = $4;
779 
        $suffix = $5 || '.sls';
780 
        $isaRipple = 0;
781 
    }
782 
 
783 
    #
784 
    #   Stuff we don't yet handle
785 
    #
392 dpurdie 786 
    else  {
1197 dpurdie 787 
        Warning ("Unknown version number: $name,$version");
392 dpurdie 788 
        $version =~ m~(\.\w+)$~;
789 
        $suffix = $1 || '';
790 
        $result = $version;
791 
    }
792 
 
1197 dpurdie 793 
    $isaRipple = ($build > 0) unless defined $isaRipple;
392 dpurdie 794 
    unless ( $result )
795 
    {
1197 dpurdie 796 
        # Major and minor of 99.99 are normally funny versions
797 
        # Don't make important decisions on them
798 
        #
799 
        if (defined $major && defined $minor && $major == 99 && $minor == 99 )
800 
        {
801 
            $major = 0;
802 
            $minor = 0;
803 
            $patch = 0;
804 
        }
805 
 
392 dpurdie 806 
        $result = sprintf("%3.3d.%3.3d.%3.3d.%3.3d%s", $major,$minor,$patch,$build,$suffix || '.0000');
1197 dpurdie 807 
        $buildVersion = [ $major, $minor, $patch, $build ];
392 dpurdie 808 
    }
809 
 
1197 dpurdie 810 
    $suffix = lc( $suffix );
811 
    if ( exists $suffixFixup{$suffix} )
812 
    {
813 
        $suffix = $suffixFixup{$suffix} ;
814 
    }
392 dpurdie 815 
 
1197 dpurdie 816 
    return ($suffix, $result, $isaRipple, $isaWIP, $buildVersion );
392 dpurdie 817 
}
818 
 
819 
 
820 
#-------------------------------------------------------------------------------
821 
# Function        : LocateStrays
822 
#
823 
# Description     :
824 
#
825 
# Inputs          :
826 
#
827 
# Returns         :
828 
#
829 
sub LocateStrays
830 
{
831 
    Message ("Locate indirectly referenced packages");
832 
    while ( $#StrayPackages >= 0 )
833 
    {
834 
        my $pv_id = pop @StrayPackages;
835 
 
836 
        next if ( exists $Packages{$pv_id}{done} );
837 
#print "... ",$#StrayPackages,"\n";
838 
        GetDepends( $pv_id);
839 
        $Packages{$pv_id}{done} = 1;
840 
    }
841 
}
842 
 
843 
#-------------------------------------------------------------------------------
1197 dpurdie 844 
# Function        : countPackages
392 dpurdie 845 
#
1197 dpurdie 846 
# Description     :
392 dpurdie 847 
#
848 
# Inputs          :
849 
#
1197 dpurdie 850 
# Returns         : Number of packages and number oof versions
392 dpurdie 851 
#
1197 dpurdie 852 
sub countPackages
392 dpurdie 853 
{
1197 dpurdie 854 
    my $v = 0;
855 
    my $p = 0;
856 
    my %names;
392 dpurdie 857 
 
1197 dpurdie 858 
    foreach ( keys %Packages )
859 
    {
860 
        my $name = $Packages{$_}{name};
861 
        next unless ( $name );
862 
        $names{$name} = 1;
863 
        $v++;
864 
    }
392 dpurdie 865 
 
1197 dpurdie 866 
    $p = keys %names;
867 
 
868 
    return $p,$v;
869 
 
870 
}
871 
 
872 
#-------------------------------------------------------------------------------
873 
# Function        : processData
874 
#
875 
# Description     : Process data before its written out
876 
#                       Remove a few packages that we do not want to now about
877 
#                       Determine Reason that a version is in the list
878 
#                       Finish taging packages in NamedProject
879 
#
880 
# Inputs          :
881 
#
882 
# Returns         :
883 
#
884 
sub processData
885 
{
392 dpurdie 886 
    foreach ( keys %Packages )
887 
    {
888 
        delete $Packages{$_}{done};
889 
        next if ( $Packages{$_}{name} =~ ~m~CSWcfengine~ );
890 
 
891 
        if ($Packages{$_}{name} eq 'Activestate Perl - Solaris')
892 
        {
893 
            delete $Packages{$_};
894 
            next;
895 
        }
896 
 
897 
        if ( $Packages{$_}{name} =~ m/^CSW/ || $Packages{$_}{name} =~ m/^Solaris$/)
898 
        {
899 
            delete $Packages{$_};
900 
            next;
901 
        }
902 
 
903 
        if ( $Packages{$_}{name} =~ m/^jats_/)
904 
        {
905 
            delete $Packages{$_};
906 
            next;
907 
        }
1197 dpurdie 908 
 
909 
 
910 
        #
911 
        #   Catch packages that are dependents of NamedProject's
912 
        #
913 
        if ( $doIncludeOnly )
914 
        {
915 
            if ( exists  $Packages{$_}{'sbomBase'} || exists  $Packages{$_}{'sbomOsid'} )
916 
            {
917 
                $Packages{$_}{NamedProject} = 4;
918 
            }
919 
 
920 
            unless ( $Packages{$_}{NamedProject}  )
921 
            {
922 
                my $named;
923 
                my %usedBy;
924 
 
925 
                if ( exists $Packages{$_}{'usedBy'})
926 
                {
927 
                    my @examineThese = @{$Packages{$_}{'usedBy'}};
928 
                    while ( @examineThese )
929 
                    {
930 
                        my $pvid = pop @examineThese;
931 
                        next if ( $usedBy{$pvid} );
932 
 
933 
                        if ( $Packages{$pvid}{NamedProject}  )
934 
                        {
935 
                            $named = 1;
936 
                            last;
937 
                        }
938 
 
939 
                        push @examineThese, @{$Packages{$pvid}{'usedBy'}}
940 
                            if (exists $Packages{$pvid}{'usedBy'});
941 
                    }
942 
                    $Packages{$_}{NamedProject} = 5
943 
                        if ( $named );
944 
                }
945 
#                else
946 
#                {
947 
#                    Warning("Not Named and not usedBy: $Packages{$_}{name} $Packages{$_}{'version'}");
948 
#                }
949 
            }
950 
        }
951 
        else
952 
        {
953 
            $Packages{$_}{NamedProject} = 6;
954 
        }
392 dpurdie 955 
    }
1197 dpurdie 956 
}
392 dpurdie 957 
 
1197 dpurdie 958 
#-------------------------------------------------------------------------------
959 
# Function        : outputData
960 
#
961 
# Description     : Write out data in a form to allow post processing
962 
#
963 
# Inputs          :
964 
#
965 
# Returns         :
966 
#
967 
sub outputData
968 
{
969 
    my $file = "cc2svn.raw.txt";
970 
    Message ("Create: $file");
971 
    my $fh = ConfigurationFile::New( $file );
972 
 
392 dpurdie 973 
    $fh->DumpData(
1197 dpurdie 974 
        "\n# Releases.\n#\n",
975 
        "ScmReleases", \%Releases );
976 
 
977 
    $fh->DumpData(
392 dpurdie 978 
        "\n# Packages.\n#\n",
979 
        "ScmPackages", \%Packages );
980 
 
981 
    $fh->DumpData(
982 
        "\n# Suffixes.\n#\n",
983 
        "ScmSuffixes", \%Suffixes );
984 
 
985 
    $fh->DumpData(
986 
        "\n# All Package Names.\n#\n",
987 
        "ScmAllPackages", \%AllPackages );
988 
 
989 
    #
990 
    #   Close out the file
991 
    #
992 
    $fh->Close();
993 
 
994 
#    #
995 
#    #   Split up package data into small files for easy consumption
996 
#    #
997 
#
998 
#    foreach ( keys %Packages )
999 
#    {
1000 
#        my $file = "cc2svn.raw.${_}.txt";
1001 
#        Message ("Create: $file");
1002 
#        my $fh = ConfigurationFile::New( $file );
1003 
#
1004 
#        $fh->DumpData(
1005 
#            "\n# Releases.\n#\n",
1006 
#            "ScmReleases", \$Packages{$_} );
1007 
#        $fh->Close();
1008 
#    }
1009 
 
1010 
}
1011 
 
1012 
 
1013 
#-------------------------------------------------------------------------------
1014 
#   Documentation
1015 
#
1016 
 
1017 
=pod
1018 
 
1019 
=for htmltoc    SYSUTIL::cc2svn::
1020 
 
1021 
=head1 NAME
1022 
 
1023 
cc2svn_gendata - Extract CC2SVN Essential Package Data from Release Manager
1024 
 
1025 
=head1 SYNOPSIS
1026 
 
1027 
  jats cc2svn_gendata [options]
1028 
 
1029 
 Options:
1030 
    -help              - brief help message
1031 
    -help -help        - Detailed help message
1032 
    -man               - Full documentation
1033 
    -test=version      - Test a version string, then exit
1034 
    -limit=n           - Limit packages processed. Test only
1197 dpurdie 1035 
    -mode=xxx          - Set Mode: all, hops, standard
392 dpurdie 1036 
 
1037 
=head1 OPTIONS
1038 
 
1039 
=over 8
1040 
 
1041 
=item B<-help>
1042 
 
1043 
Print a brief help message and exits.
1044 
 
1045 
=item B<-help -help>
1046 
 
1047 
Print a detailed help message with an explanation for each option.
1048 
 
1049 
=item B<-man>
1050 
 
1051 
Prints the manual page and exits.
1052 
 
1053 
=item B<-test=version>
1054 
 
1055 
Examine a package version string and report how the tool will parse it.
1056 
 
1057 
=item B<-limit=n>
1058 
 
1059 
Limit the number of packages processed by the tool. This is only used to
1060 
simplify testing of the program
1061 
 
1062 
=back
1063 
 
1064 
=head1 DESCRIPTION
1065 
 
1066 
This program is a tool used in the conversion of ClearCase VOBS to subversion.
1067 
It will:
1068 
 
1069 
=over 8
1070 
 
1071 
=item *
1072 
 
1073 
Determine all Releases in Release manager and mark those that
1074 
are to be excluded.
1075 
 
1076 
=item *
1077 
 
1078 
Determine all the package-versions used by the releases that are
1079 
not excluded. These are called 'direct' dependencies.
1080 
 
1081 
=item *
1082 
 
1083 
Recursively find all the dependent packages of all packages. New package
1084 
versions are called 'indirect' dependencies. They are buried. This process can
1085 
take several minutes.
1086 
 
1087 
=back
1088 
 
1089 
The data collected is dumped into a text file for later processing.
1090 
 
1091 
=cut
1092