Subversion Repositories DevTools

Rev

Go to most recent revision | Details | 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_importpackage.pl
5 
# Module type   : Makefile system
6 
# Compiler(s)   : Perl
7 
# Environment(s): jats
8 
#
9 
# Description   : Get package information for a package name specified on the
10 
#                 command line.
11 
#
12 
#                 Determine the package id
13 
#                 Locate all packages that have the same package name
14 
#                 Determine essential packages
15 
#                 Prune uneeded packages
16 
#
17 
#                 Pump it into SVN
18 
#
19 
#                 Project Based Pumping, creating branches as needed
20 
#
21 
#......................................................................#
22 
 
23 
require 5.006_001;
24 
use strict;
25 
use warnings;
26 
use JatsError;
27 
use JatsRmApi;
28 
use FileUtils;
29 
use JatsSystem;
30 
use HTTP::Date;
31 
use JatsProperties;
32 
use JatsEnv;
33 
use ConfigurationFile;
34 
use JatsSvn qw(:All);
35 
 
36 
 
37 
#use Data::Dumper;
38 
use Fcntl ':flock'; # import LOCK_* constants
39 
use Cwd;
40 
use DBI;
41 
use Getopt::Long;
42 
use Pod::Usage;                             # required for help support
43 
 
44 
#
45 
#   Options
46 
#
47 
my $opt_help = 0;
48 
my $opt_manual = 0;
49 
my $opt_verbose = 0;
50 
my $opt_repo_base = 'AUPERASVN01/';
51 
my $opt_repo = '';
52 
my $opt_flat;
53 
my $opt_test;
54 
my $opt_reuse;
55 
my $opt_age;
56 
my $opt_dump = 0;
57 
my $opt_images = 0;
58 
my $opt_retaincount = 2;
59 
my $opt_pruneModeString;
60 
my $opt_listTags;
61 
my $opt_name;
62 
my $opt_log = 0;
63 
my @opt_tip;
64 
my $opt_postimage = 1;
65 
my $opt_workDir = '/work';
66 
my $opt_vobMap;
67 
 
68 
################################################################################
69 
#   List of Projects Suffixes and Branch Names to be used within SVN
70 
#
71 
#       Name        - Name of branch for the project
72 
#       Trunk       - Can be a trunk project
73 
#                     First one seen will be placed on the trunk
74 
#                     Others will create project branches
75 
#
76 
my $ProjectTrunk;
77 
my %ProjectsBaseCreated;
78 
my %Projects = (
79 
    '.sea'      => { Name => 'Seattle' },
80 
    '.coct'     => { Name => 'CapeTown' },
81 
    '.sls'      => { Name => 'Stockholm' },
82 
    '.syd'      => { Name => 'Sydney' },
83 
    '.vtk'      => { Name => 'Vasttrafik' },
84 
    '.bei'      => { Name => 'Beijing' },
85 
    '.bkk'      => { Name => 'Bangkok' },
86 
    '.ndl'      => { Name => 'NewDelhi' },
87 
    '.nzs'      => { Name => 'NewZealandStageCoach' },
88 
    '.wdc'      => { Name => 'Washington' },
89 
    '.oso'      => { Name => 'Oslo' },
90 
    '.lvs'      => { Name => 'LasVegas' },
91 
    '.mlc'      => { Name => 'BeijingMlc' },
92 
    '.sfo'      => { Name => 'SanFrancisco' },
93 
    '.sg'       => { Name => 'Singapore' },
94 
    '.gmp'      => { Name => 'GmpteProject' },
95 
    '.ssw'      => { Name => 'UkStageCoach' },
96 
    '.uk'       => { Name => 'UkProject' },
97 
    '.pmb'      => { Name => 'Pietermaritzburg' },
98 
    '.vps'      => { Name => 'VixPayments' },
99 
    '.ncc'      => { Name => 'NSWClubCard' },
100 
    '.rm'       => { Name => 'Rome' },
101 
    'unknown'   => { Name => 'UnknownProject' },
102 
 
103 
    '.ebr'      => { Name => 'eBrio' , Trunk => 1 },
104 
    '.mas'      => { Name => 'Mass'  , Trunk => 1 },
105 
    '.cr'       => { Name => 'Core'  , Trunk => 1 },
106 
    '.cots'     => { Name => 'Cots'  , Trunk => 1 },
107 
    '.tool'     => { Name => 'Tools' , Trunk => 1 },
108 
);
109 
 
110 
my %suffixFixup = (
111 
    '.sf'           => '.sfo',
112 
    '.vt'           => '.vtk',
113 
    '.lv'           => '.lvs',
114 
    '.was'          => '.wdc',
115 
    '.uk.1'         => '.uk',
116 
    '.ssts.demo'    => '.ssts',
117 
    '.u244.syd'     => '.syd',
118 
    '.pxxx.sea'     => '.sea',
119 
    '.pxxx.syd'     => '.syd',
120 
    '.pxxx.sydddd'  => '.syd',
121 
    '.oslo'         => '.oso',
122 
);
123 
 
124 
my %specialPackages = (
125 
#    'core_devl' =>  ',all,protected,',
126 
    'core_devl' =>  ',all,',
127 
    'daf_utils_mos' => ',flat,',
128 
    'mos_packager'  => ',all,',
395 dpurdie 129 
 
130 
    # Need to be handled in a special manner
131 
    # Not done by this utility
132 
    #
133 
    'linux_drivers_eb5600'  => ',protected,',
134 
    'linux_drivers_viper'   => ',protected,',
135 
    'linux_drivers_cobra'   => ',protected,',
136 
    'linux_drivers_bcp4600' => ',protected,',
137 
    'linux_drivers_etx86'   => ',protected,',
138 
    'linux_drivers_tp5600'  => ',protected,',
139 
 
392 dpurdie 140 
);
141 
 
142 
my %notCots = (
143 
    'isl'       => 1,
144 
);
145 
 
146 
################################################################################
147 
#   Global data
148 
#
149 
my $VERSION = "1.0.0";
150 
my $RM_DB;
151 
my $last_pv_id;
152 
my %pkg_ids;
153 
my $first_pkg_id;
154 
my %versions;
155 
my %suffixes;
156 
my @processOrder;
157 
my @startPoints;
158 
my @allStartPoints;
159 
my @endPoints;
160 
my $now = time();
161 
my $logSummary;
162 
my $firstVersionCreated;
163 
my @EssentialPackages;
164 
my $createBranch;
165 
my $createSuffix;
166 
my $currentBranchName;
167 
my $singleProject;
168 
my $pruneCount = 0;
169 
my $trimCount = 0;
170 
my $badVcsCount = 0;
171 
my $ProjectCount = 0;
172 
my $totalVersions = 0;
173 
my $initialTrees = 0;
174 
my $globalError;
175 
my @unknownProjects;
176 
my %knownProjects;
177 
my $badSingletonCount = 0;
178 
my @flatOrder;
179 
my $pruneMode;
180 
my $pruneModeString;
181 
my $threadId = 0;
182 
my $threadCount;
183 
my %tipVersions;
184 
my $allSvn;
185 
my @multiplePaths;
186 
my @badEssentials;
187 
my %svnData;
188 
my $cwd;
189 
 
190 
my $packageNames;
191 
my @packageNames;
192 
my $multiPackages = -1;
193 
my $visitId = 0;
194 
my $noTransfer;
195 
my $rippleCount = 0;
196 
my $svnRepo;
197 
 
198 
our $GBE_RM_URL;
199 
my $UNIX = $ENV{'GBE_UNIX'};
200 
 
201 
my $result = GetOptions (
202 
                "help+"         => \$opt_help,          # flag, multiple use allowed
203 
                "manual:3"      => \$opt_help,
204 
                "verbose:+"     => \$opt_verbose,       # Versose
205 
                "repository:s"  => \$opt_repo,          # Name of repository
206 
                "flat!"         => \$opt_flat,          # Flat structure
207 
                "test!"         => \$opt_test,          # Test operations
208 
                "reuse!"        => \$opt_reuse,         # Reuse ClearCase views
209 
                "age:i"         => \$opt_age,           # Only recent versions
210 
                "dump:1"        => \$opt_dump,          # Dump Data
211 
                "images:1"      => \$opt_images,        # Create DOT images
212 
                "retain:i"      => \$opt_retaincount,   # Retain N packages
213 
                "pruneMode:s"   => \$opt_pruneModeString,
214 
                "listtags:i"    => \$opt_listTags,
215 
                "name:s"        => \$opt_name,          # Alternate output
216 
                "tip:s"         => \@opt_tip,           # Force tip version(s)
217 
                "log!"          => \$opt_log,
218 
                "postimage!"    => \$opt_postimage,
219 
                'workdir:s'     => \$opt_workDir,
220 
                );
221 
 
222 
#
223 
#   Process help and manual options
224 
#
225 
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
226 
pod2usage(-verbose => 1)  if ($opt_help == 2 );
227 
pod2usage(-verbose => 2)  if ($opt_manual || ($opt_help > 2));
228 
 
229 
#
230 
#   Configure the error reporting process now that we have the user options
231 
#
232 
SystemConfig ('ExitOnError' => 1);
233 
ErrorConfig( 'name'    =>'CC2SVN_IMPORT',
234 
             'verbose' => $opt_verbose,
235 
              );
236 
 
237 
Error("Workdir does not exist" ) unless ( -d $opt_workDir );
238 
Error("Specify a package as 'name'" ) unless ( defined $ARGV[0] );
239 
EnvImport('GBE_RM_URL');
240 
$cwd = Getcwd();
241 
 
242 
#
243 
#   Init the pruning mode
244 
#
245 
setPruneMode( $opt_pruneModeString || 'ripple');
246 
 
247 
#
248 
#   Get data for all packages
249 
#
250 
foreach my $packageName ( @ARGV )
251 
{
252 
    next unless ( $packageName );
253 
    Verbose( "Base Package: $packageName");
254 
 
255 
    my $pkg_id = GetPkgIdByName ( $packageName );
256 
    GetData_by_pkg_id ( $pkg_id, $packageName  );
257 
    $pkg_ids{$pkg_id} = 1;
258 
    $first_pkg_id = $pkg_id unless ( $first_pkg_id );
259 
    push @packageNames, $packageName;
260 
    $multiPackages++;
261 
}
262 
 
263 
{
264 
    #
265 
    #   Delete entries that have been created as we read in
266 
    #   data, but don't exist in RM. They will not have a pvid.
267 
    #
268 
    foreach my $entry ( keys(%versions) )
269 
    {
270 
        delete $versions{$entry}
271 
            unless ( exists $versions{$entry}{pvid} );
272 
    }
273 
}
274 
 
275 
$totalVersions = scalar keys %versions;
276 
Error ("No packages specified") unless ( $multiPackages >= 0 );
277 
Warning ("Multiple Packages being processed") if ( $multiPackages > 1 );
278 
$packageNames = join ('_', @packageNames );
279 
$packageNames = $opt_name if ( defined $opt_name );
280 
Message ("PackageName: $packageNames" );
281 
 
282 
#
283 
#   Save logging data
284 
#
285 
if ( $opt_log )
286 
{
287 
    my $opt_logfile = $packageNames . '.import';
288 
    Message ("Logging outout: $opt_logfile" );
289 
    open STDOUT, '>', $opt_logfile  or die "Can't redirect STDOUT: $!";
290 
    open STDERR, ">&STDOUT"         or die "Can't dup STDOUT: $!";
291 
}
292 
 
293 
#
294 
#   Prepare tip version hash
295 
#
296 
$tipVersions{$_} = 1 foreach ( @opt_tip );
297 
 
298 
#
299 
#   Read in external data and massage it all
300 
#
301 
getEssenialPackageVersions();
302 
getVobMapping();
303 
smartPackageType();                 # Determine special prune mode
304 
ReportPathVariance();
305 
massageData();
306 
getSvnData();
307 
smartPackageType();                 # Have another go
308 
 
309 
my @missedTips = keys %tipVersions;
310 
Error ("Specified tip version not found: @missedTips") if ( @missedTips );
311 
 
312 
if ( $opt_flat )
313 
{
314 
#    @flatOrder = sort {$versions{$a}{version} cmp $versions{$b}{version}} keys(%versions);
315 
#    @flatOrder = sort {$versions{$a}{created} cmp $versions{$b}{created}} keys(%versions);
316 
    @flatOrder = sort {$a <=> $b} keys(%versions);
317 
    my $tip = $flatOrder[-1];
318 
    $versions{$tip}{Tip} = 1 if $tip;
319 
}
320 
 
321 
#
322 
#   Generate dumps and images
323 
#
324 
if ( $opt_images )
325 
{
326 
    createImages();
327 
}
328 
 
329 
if ( $opt_dump )
330 
{
331 
    DebugDumpData ("Versions", \%versions );
332 
    DebugDumpData ("Starts", \@startPoints );
333 
    DebugDumpData ("Ends", \@endPoints );
334 
    DebugDumpData ("Suffixes", \%suffixes );
335 
}
336 
 
337 
 
338 
#   Display VCS tags
339 
#
340 
if ( $opt_listTags )
341 
{
342 
    foreach my $entry (sort {$versions{$a}{version} cmp $versions{$b}{version}} keys(%versions) )
343 
    {
344 
        print $versions{$entry}{vcsTag} || '-' ,"\n";
345 
    }
346 
}
347 
exit if ( ($opt_dump > 1) || ($opt_images > 1) );
348 
 
349 
transferPackageToSvn();
350 
 
351 
if ( $opt_postimage )
352 
{
353 
    getSvnData();
354 
    createImages();
355 
}
356 
 
357 
exit 0;
358 
 
359 
#-------------------------------------------------------------------------------
360 
# Function        : transferPackageToSvn
361 
#
362 
# Description     : Transfer the package to SVN
363 
#
364 
# Inputs          :
365 
#
366 
# Returns         :
367 
#
368 
sub transferPackageToSvn
369 
{
370 
    Error ("Repository Path not setup")
371 
        unless ( $svnRepo );
372 
 
373 
    #
374 
    #   Going to do serious work
375 
    #   Need to ensure we have more arguments
376 
    #
377 
    if ( $noTransfer )
378 
    {
379 
        Warning("Protected Package not transferred: $packageNames[0]");
380 
        exit 0;
381 
    }
382 
 
383 
    #
384 
    #   Perform all the work in a package specific subdirectory
385 
    #
386 
    my $workDir = $opt_workDir . '/' . $packageNames;
387 
    mkdir $workDir unless ( -d $workDir );
388 
    chdir $workDir || Error ("Cannot cd to $workDir");
389 
 
390 
    #
391 
    #   Process all packages
392 
    #       Going to create versions based on RM structure
393 
    #       May have several starting points: Process each
394 
    #
395 
    newPackage();
396 
    if ( $opt_flat )
397 
    {
398 
        newProject();
399 
        foreach my $entry (@flatOrder )
400 
        {
401 
            newPackageVersion( $entry, $versions{$entry}{suffix} );
402 
        }
403 
    }
404 
    else
405 
    {
406 
        processBranch(@allStartPoints);
407 
    }
408 
    endPackage();
409 
 
410 
    chdir $cwd || Error ("Cannot cd back to $cwd");
411 
    rmdir $workDir;
412 
    Warning ("Work Directory still exists: $workDir");
413 
    saveData();
414 
}
415 
 
416 
#-------------------------------------------------------------------------------
417 
# Function        : setPruneMode
418 
#
419 
# Description     : Set the pruning mode
420 
#
421 
# Inputs          : mode                    - Text mode value
422 
#
423 
# Returns         : Nothing
424 
#
425 
sub setPruneMode
426 
{
427 
    my ($mode) = @_;
428 
    my $value;
429 
    if ( $mode )
430 
    {
431 
        if ( $mode =~ m/none/i) {
432 
            $value = 0;
433 
        } elsif ( $mode =~ m/ripple/i) {
434 
            $value = 1;
435 
        } elsif ( $mode =~ m/retain/i) {
436 
            $value = 2;
437 
        } elsif ( $mode =~ m/severe/i) {
438 
            $value = 3;
439 
        } else {
440 
            Error ("Unknown pruning mode", "Use: none, ripple, retain or severe");
441 
        }
442 
 
443 
        $pruneModeString = $mode;
444 
        $pruneMode = $value;
445 
    }
446 
}
447 
 
448 
#-------------------------------------------------------------------------------
449 
# Function        : smartPackageType
450 
#
451 
# Description     : Have a look at the projects in the package set and
452 
#                   attempt to determine what sort of mechanism to use
453 
#
454 
# Inputs          : Uses %suffixes data
455 
#
456 
# Returns         :
457 
#
458 
my $packageType = 'UNKNOWN';
459 
sub smartPackageType
460 
{
461 
    #
462 
    #   Rebuild suffixes hash based on  post massaged versions
463 
    #
464 
    my %suffixes;
465 
    my @unknown;
466 
    foreach my $entry ( keys %versions )
467 
    {
468 
        my $suffix = $versions{$entry}{suffix} || '';
469 
        push (@unknown, $entry) if ($suffix eq 'unknown');
470 
 
471 
        next if ( exists $suffixes{$suffix} );
472 
        next if ( $versions{$entry}{badSingleton} );
473 
        next if ( $versions{$entry}{locked} eq 'N' || $versions{$entry}{isaWip} );
474 
        $suffixes{$suffix} = 1;
475 
        $knownProjects{$suffix}{seen} = 1;
476 
 
477 
    }
478 
 
479 
    #
480 
    #   The 'unknown' suffix is really an 'empty' suffix
481 
    #   Try to be clever
482 
    #       Map unknown to 'cr' or 'mas' if present
483 
    #
484 
    #
485 
    if ( exists $suffixes{'unknown'}  )
486 
    {
487 
        my $new_suffix;
488 
        if ( exists $suffixes{'.cr'} ) {
489 
            $new_suffix = '.cr';
490 
        } elsif ( exists $suffixes{'.mas'} ) {
491 
            $new_suffix = '.mas';
492 
        }
493 
 
494 
        if ( $new_suffix )
495 
        {
496 
            foreach my $entry ( @unknown )
497 
            {
498 
                $versions{$entry}{suffix} = $new_suffix;
499 
            }
500 
            delete $suffixes{'unknown'};
501 
            delete $knownProjects{'unknown'}{seen};
502 
        }
503 
    }
504 
 
505 
    if ( exists $suffixes{'.cots'} && !exists ($notCots{$packageNames}) ) {
506 
        $packageType = 'COTS';
507 
        $Projects{'.cots'}{Trunk} = 1;
508 
        $singleProject = 1;
509 
        $opt_flat = 1 unless defined $opt_flat;
510 
        setPruneMode('none') unless (defined $opt_pruneModeString);
511 
 
512 
    } elsif ( exists $suffixes{'.tool'} ) {
513 
        $packageType = 'TOOL';
514 
        $Projects{'.tool'}{'Trunk'} = 1;
515 
        $singleProject = 1;
516 
        setPruneMode('none') unless (defined $opt_pruneModeString);
517 
#        $opt_flat = 1;
518 
 
519 
    } elsif ( scalar (keys %suffixes ) == 1 ) {
520 
        $packageType = 'SINGLE_PROJECT';
521 
        $singleProject = 1;
522 
 
523 
    } else {
524 
        $packageType = 'MULTIPLE_PROJECT';
525 
    }
526 
 
527 
    #
528 
    #   Some packages are special
529 
    #
530 
 
531 
    if ( $packageNames[0] =~ m'^br_applet_' )
532 
    {
533 
        $opt_flat = 1 unless defined $opt_flat;
534 
    }
535 
 
536 
    if ( exists $specialPackages{$packageNames[0]} )
537 
    {
538 
        my $data = $specialPackages{$packageNames[0]};
539 
        if ( index( $data, ',all' ) >= 0) {
540 
            setPruneMode('none') unless (defined $opt_pruneModeString);
541 
        }
542 
 
543 
        if ( index( $data, 'protected,' ) >= 0) {
544 
            $noTransfer = 1;
545 
        }
546 
 
547 
        if ( index( $data, 'flat,' ) >= 0) {
548 
            $opt_flat = 1;
549 
        }
550 
 
551 
    }
552 
 
553 
    Message("Package Type: $packageType, $pruneModeString");
554 
}
555 
 
556 
 
557 
#-------------------------------------------------------------------------------
558 
# Function        : massageData
559 
#
560 
# Description     : Massage all the data to create a tree of package versions
561 
#                   that can be used to create images as well as an import order
562 
#
563 
# Inputs          :
564 
#
565 
# Returns         :
566 
#
567 
my $reprocess=0;
568 
sub calcLinks
569 
{
570 
    #
571 
    #   Process the 'versions' hash and:
572 
    #   Add back references
573 
    #   Find starts and ends
574 
    #       Entry with no previous
575 
    #       Entry with no next
576 
    #
577 
    $reprocess = 0;
578 
    foreach my $entry ( keys(%versions) )
579 
    {
580 
        foreach ( @{ $versions{$entry}{next}} )
581 
        {
582 
            $versions{$_}{last} = $entry;
583 
        }
584 
    }
585 
    @allStartPoints = ();
586 
    @startPoints = ();
587 
    @endPoints = ();
588 
    foreach my $entry ( keys(%versions) )
589 
    {
590 
        push @startPoints, $entry
591 
            unless ( exists $versions{$entry}{last} || $versions{$entry}{badSingleton} );
592 
 
593 
        push @allStartPoints, $entry
594 
            unless ( exists $versions{$entry}{last} );
595 
 
596 
        push @endPoints, $entry
597 
            unless ( @{$versions{$entry}{next}} > 0  )
598 
    }
599 
}
600 
 
601 
sub massageData
602 
{
603 
    #
604 
    #   Report unknown suffixes
605 
    #   Handle bad, or little known project suffixes by creating them
606 
    #
607 
    foreach my $suffix ( keys %suffixes )
608 
    {
609 
        if ( exists $Projects{$suffix} )
610 
        {
611 
            next;
612 
        }
613 
        Message ("Unknown project suffix: '$suffix'");
614 
        push @unknownProjects, $suffix;
615 
        my $cleanSuffix = ucfirst(lc(substr( $suffix, 1)));
616 
        $Projects{$suffix}{Name} = 'Project_' . $cleanSuffix;
617 
    }
618 
 
619 
    calcLinks();
620 
 
621 
    $initialTrees = scalar @allStartPoints;
622 
    Message ('Total RM versions: ' . $totalVersions );
623 
    Message ('Initial trees: ' . $initialTrees );
624 
    #
625 
    #   Attempt to glue all the start points into one chain.
626 
    #   This should allow us to track projects that branch from each other
627 
    #   in cases where the RM data is incorrect/incomplete
628 
    #       Strays are those that have no next or last
629 
    #
630 
    #   Glue based on Name, then PVID (Creation Order)
631 
    #
632 
    {
633 
        #
634 
        #   Examine threads. If it is a single entry thats bad then drop it
635 
        #   This is simple to do. Should examine all entries, but thats a
636 
        #   bit harder. Perhaps later.
637 
        #
638 
        if (1) {
639 
            Message ("Dropping Bad Singletons");
640 
            my $badSingletons;
641 
            foreach my $entry ( sort {$a <=> $b} @startPoints )
642 
            {
643 
                my $ep = $versions{$entry};
644 
                unless ( $ep->{last} || $ep->{next}[0] )
645 
                {
646 
#                    if (  $ep->{isaWip}  )
647 
                    if ( (exists $ep->{badVcsTag} && $ep->{badVcsTag}) || $ep->{isaWip}  )
648 
                    {
649 
                        $ep->{badSingleton} = 1;
650 
                        $reprocess = 1;
651 
                        $badSingletonCount++;
652 
 
653 
                        # Add to a list of its own.
654 
                        if ( $badSingletons )
655 
                        {
656 
                            push @{$versions{$badSingletons}{next}}, $entry;
657 
                        }
658 
                        $badSingletons = $entry;
659 
                    }
660 
                }
661 
            }
662 
            calcLinks()
663 
                if ( $reprocess );
664 
        }
665 
 
666 
        #
667 
        #   Create simple trees out of the chains
668 
        #   Tree is based on suffix (project) and version
669 
        #
670 
        {
671 
            my %trees;
672 
            Message ("Entries into trees");
673 
            foreach my $single ( @startPoints )
674 
            {
675 
                my $suffix = $versions{$single}{suffix} || '';
676 
                push @{$trees{$suffix}}, $single;
677 
            }
678 
 
679 
            foreach  ( keys %trees )
680 
            {
681 
                my $last;
682 
                foreach my $entry ( sort { $versions{$a}{version} cmp $versions{$b}{version}  } @{$trees{$_}} )
683 
                {
684 
                    if ( $last )
685 
                    {
686 
                        $versions{$last}{MakeTree} = 1;
687 
                        push @{$versions{$last}{next}}, $entry;
688 
                        $reprocess = 1;
689 
                    }
690 
                    $last = $entry;
691 
                }
692 
            }
693 
            calcLinks()
694 
                if ( $reprocess );
695 
        }
696 
 
697 
        #
698 
        #   Have a number of trees that are project related
699 
        #   Attempt to create a single tree by inserting
700 
        #   Secondary trees into the main line at suitable points
701 
        #
702 
        my @AllVersions = sort { $a <=> $b } @startPoints;
703 
        my $lastEntry = shift @AllVersions;
704 
        Error ("Oldest entry has a previous version") if ( $versions{$lastEntry}{last}  );
705 
#print "Oldest: $lastEntry\n";
706 
        #
707 
        #   Insert remaining entries into out list, which is now sorted
708 
        #
709 
        my @completeList;
710 
        foreach my $base ( @AllVersions  )
711 
        {
712 
            push @completeList, recurseList($lastEntry);
713 
            @completeList = sort {$a <=> $b} @completeList;
714 
#            Message("Complete List: ", @completeList);
715 
#            Message("Complete List($completeList[0]) Length: " . scalar @completeList);
716 
            $lastEntry = $base;
717 
 
718 
            my $last;
719 
            foreach my $entry ( @completeList )
720 
            {
721 
                if ( $entry > $base )
722 
                {
723 
                    Error ("Not expecting last to be empty. $base, $entry") unless ( $last );
724 
                    last;
725 
                }
726 
                $last = $entry;
727 
            }
728 
 
729 
            #
730 
            #   Insert at end if point not yet found
731 
            #
732 
#print "Inserting $base at $last\n";
733 
            push @{$versions{$last}{next}}, $base;
734 
            $versions{$base}{GluedIn} = 1;
735 
            $reprocess = 1;
736 
        }
737 
 
738 
        #
739 
        #   Recalc basic links if any processing done
740 
        #
741 
        calcLinks()
742 
            if ( $reprocess );
743 
 
744 
    }
745 
 
746 
 
747 
    #
748 
    #   Remove Dead Ends
749 
    #   Packages that were never released
750 
    #       Not locked, unless essential or a branchpoint
751 
    #   Won't consider these to be mainline path.
752 
    #
753 
    {
754 
        Message ("Remove Dead Ends");
755 
        foreach my $entry ( @endPoints )
756 
        {
757 
            my $deadWood;
758 
            while ( $entry )
759 
            {
760 
                last if ( $versions{$entry}{Essential} );
761 
 
762 
                my @next = @{$versions{$entry}{next}};
763 
                my $count = @next;
764 
                last if ( $count > 1 );
765 
 
766 
                last unless ( $versions{$entry}{locked} eq 'N' || $versions{$entry}{isaWip} );
767 
 
768 
                $versions{$entry}{DeadWood} = 1;
769 
                $trimCount++;
770 
            } continue {
771 
                $entry = $versions{$entry}{last};
772 
            }
773 
        }
774 
    }
775 
 
776 
    #
777 
    #   Walk each starting point list and determine new Projects
778 
    #   branchpoints.
779 
    #
780 
    Message ("Locate Projects branch points");
781 
    foreach my $bentry ( keys(%versions) )
782 
    {
783 
        my $baseSuffix = $versions{$bentry}{suffix};
784 
        foreach my $entry ( @{$versions{$bentry}{next}} )
785 
        {
786 
            if ( $baseSuffix ne $versions{$entry}{suffix})
787 
            {
788 
                unless ( exists $versions{$entry}{DeadWood} || $versions{$entry}{badSingleton} )
789 
                {
790 
#print "--- Project Branch $versions{$entry}{vname}\n";
791 
                    $versions{$entry}{branchPoint} = 1;
792 
                    $versions{$entry}{newSuffix} = 1;
793 
                }
794 
            }
795 
        }
796 
    }
797 
 
798 
    #
799 
    #   Prune
800 
    #   Marks paths to root for all essential packages
801 
    #   Marks the last-N from all essential packages
802 
    #
803 
    if ( $pruneMode )
804 
    {
805 
        Message ("Prune Tree: $pruneModeString");
806 
        foreach ( @EssentialPackages )
807 
        {
808 
            #next unless ( exists $versions{$_} );      # Aleady deleted
809 
 
810 
            # Mark previous-N to be retained as well
811 
            my $entry = $_;
812 
            my $count = 0;
813 
            while ( $entry )
814 
            {
815 
                last if ( $versions{$entry}{KeepMe} );
816 
                unless ( $versions{$entry}{isaRipple} )
817 
                {
818 
                    my $keepFlag = ($count++ < $opt_retaincount);
819 
                    last unless ( $keepFlag );
820 
                    $versions{$entry}{KeepMe} = $keepFlag;
821 
                }
822 
                $entry = $versions{$entry}{last}
823 
            }
824 
        }
825 
 
826 
        #
827 
        #   Keep versions that are common parents to Essential Versions
828 
        #       Mark paths through the tree to essential versions
829 
        #       Mark nodes with the number of essential versions that they sprout
830 
        #   Don't do it if we are ripple pruning
831 
        #
832 
        Message ("Prune Tree keep common parents");
833 
        if ( $pruneMode != 1 )
834 
        {
835 
            foreach my $entry ( @endPoints )
836 
            {
837 
                my $hasEssential = 0;
838 
                $visitId++;
839 
                while ( $entry )
840 
                {
841 
                    $hasEssential = 1 if ( exists ($versions{$entry}{Essential}) && $versions{$entry}{Essential} );
842 
                    if ( $hasEssential )
843 
                    {
844 
                        if ( @{$versions{$entry}{next}} > 1 )
845 
                        {
846 
                            $versions{$entry}{EssentialSplitPoint}++;
847 
                        }
848 
                        last if ( exists $versions{$entry}{EssentialPath} );
849 
                        $versions{$entry}{EssentialPath} = 1;
850 
                    }
851 
 
852 
                    if ( ($versions{$entry}{visitId} || 0) == $visitId )
853 
                    {
854 
                        DebugDumpData ("Versions", \%versions );
855 
                        Warning ("Circular dependency");
856 
                        last;
857 
                    }
858 
                    $versions{$entry}{visitId} = $visitId;
859 
 
860 
                    $entry = $versions{$entry}{last};
861 
                }
862 
            }
863 
        }
864 
 
865 
        #
866 
        #   Keep first version of each ripple. Must keep first
867 
        #   Group ripples together so that they can be proccessed at the same time
868 
        #
869 
        calcRippleGroups()
870 
            if ( $pruneMode == 1);
871 
 
872 
        #
873 
        #   Delete all nodes that are not marked for retention
874 
        #   This is rough on the tree
875 
        #
876 
        Message ("Prune Tree Deleting");
877 
 
878 
        # 0 - Keep me
879 
        # 1 - Prune me
880 
        sub pruneMe
881 
        {
882 
            my ($entry) = @_;
883 
 
884 
            return 0 unless ( exists $versions{$entry} );
885 
            return 0 unless ( $versions{$entry}{last} );
886 
            return 0 if ( ($pruneMode == 2) && exists $versions{$entry}{KeepMe} );
887 
            return 0 if ( exists $versions{$entry}{Essential} );
888 
            return 0 if ( $versions{$entry}{newSuffix} );
889 
            return 0 if ( $versions{$entry}{newSuffix} && (exists $versions{$entry}{EssentialPath}) );
890 
#            return 1 if ( exists $versions{$entry}{DeadWood} );
891 
            return 0 if ( exists $versions{$entry}{EssentialSplitPoint} && $versions{$entry}{EssentialSplitPoint} > 1 );
892 
            return 0 if ( exists $versions{$entry}{keepLowestRipple} &&  $versions{$entry}{keepLowestRipple} );
893 
            return 0 if ( ($pruneMode == 1) && ! $versions{$entry}{isaRipple} );
894 
            return 1;
895 
        }
896 
 
897 
        foreach my $entry ( keys(%versions) )
898 
        {
899 
#last;
900 
            next unless ( pruneMe($entry) );
901 
#print "--- Prune: $versions{$entry}{vname}\n";
902 
 
903 
            # Delete the current node
904 
            #
905 
            my @newNext;
906 
            $pruneCount++;
907 
            my $last = $versions{$entry}{last};
908 
            foreach ( @{$versions{$last}{next}} )
909 
            {
910 
                next if ( $_ == $entry );
911 
                push @newNext, $_;
912 
            }
913 
            foreach ( @{$versions{$entry}{next}} )
914 
            {
915 
                push @newNext, $_;
916 
                $versions{$_}{last} = $last;
917 
            }
918 
 
919 
            @{$versions{$last}{next}} = @newNext;
920 
            delete $versions{$entry};
921 
        }
922 
 
923 
        # Recalculate endpoints
924 
        calcLinks();
925 
    }
926 
    else
927 
    {
928 
        #   No rippling happening
929 
        #   Some process still need to happen
930 
        #
931 
        calcRippleGroups();
932 
    }
933 
 
934 
    #
935 
    #   Calculate best through-path for branches in the tree
936 
    #   Attempt to keep that 'max' version on the mainline
937 
    #   May be modified by -tip=nnnn
938 
    #
939 
    #   For each leaf (end point), walk backwards and mark each node with the
940 
    #   max version see. If we get to a node which already has been marked then
941 
    #   stop if our version is greater. We want the value to be the max version
942 
    #   to a leaf
943 
    #
944 
    #   Account for 'suffix'. When suffix changes, then the 'max' version must
945 
    #   be recalculated
946 
    #
947 
 
948 
    Message ("Calculate Max Version");
949 
    my $maxVersion;
950 
 
951 
    foreach my $entry ( @endPoints )
952 
    {
953 
        my $lastSuffix;
954 
        my $forceTip;
955 
        while ( $entry )
956 
        {
957 
            if (!defined($lastSuffix) || ($versions{$entry}{suffix} ne $lastSuffix) )
958 
            {
959 
                $maxVersion = '0';
960 
                $visitId++;
961 
                $forceTip = ( exists $tipVersions{$versions{$entry}{vname}} );
962 
                delete $tipVersions{$versions{$entry}{vname}};
963 
                $maxVersion = '999.999.999.999.zzz' if ( $forceTip );
964 
                $lastSuffix = $versions{$entry}{suffix};
965 
#print "---Tip Found\n" if $forceTip;
966 
            }
967 
 
968 
            # Detect circular dependencies
969 
            if ( ($versions{$entry}{visitId} || 0) == $visitId )
970 
            {
971 
                DebugDumpData ("Circular dependency: Versions", \%versions );
972 
                Warning ("Circular dependency");
973 
                last;
974 
            }
975 
            $versions{$entry}{visitId} = $visitId;
976 
 
977 
            my $thisVersion = $versions{$entry}{version} || '';
978 
            if ( $thisVersion gt $maxVersion )
979 
            {
980 
                $maxVersion = $thisVersion;
981 
            }
982 
 
983 
            if ( exists $versions{$entry}{maxVersion} )
984 
            {
985 
                if ( $versions{$entry}{maxVersion} gt $maxVersion )
986 
                {
987 
                    last;
988 
                }
989 
            }
990 
 
991 
            $versions{$entry}{maxVersion} = $maxVersion;
992 
            $entry = $versions{$entry}{last};
993 
        }
994 
    }
995 
 
996 
 
997 
    #
998 
    #   Locate all instances where a package-version branches
999 
    #   Determine the version that should be on the non-branching path
1000 
    #
1001 
    #   Reorder the 'next' list so that the first item is the non-branching
1002 
    #   path. This will be used in the data-insertion phase to simplify the
1003 
    #   processing.
1004 
    #
1005 
    Message ("Calculate package version branches");
1006 
    foreach my $entry ( sort {$a <=> $b} keys(%versions) )
1007 
    {
1008 
        calculateWalkOrder($entry);
1009 
    }
1010 
 
1011 
    #
1012 
    #   Mark Project Branch Tips as they will be in the Repository
1013 
    #   Find each project head and walk primary entry to the end.
1014 
    #
1015 
    foreach my $entry ( keys(%versions) )
1016 
    {
1017 
        #
1018 
        #   Root of each tree is 'new'
1019 
        #
1020 
        unless ( defined $versions{$entry}{last})
1021 
        {
1022 
            unless ( $versions{$entry}{badSingleton} )
1023 
            {
1024 
                $versions{$entry}{newSuffix} = 1;
1025 
            }
1026 
        }
1027 
 
1028 
        #
1029 
        #   Update stats
1030 
        #
1031 
        $badVcsCount++ if ( $versions{$entry}{badVcsTag} );
1032 
        $ProjectCount++ if ( $versions{$entry}{newSuffix} );
1033 
        next if ( $opt_flat );
1034 
 
1035 
        next unless ($versions{$entry}{newSuffix} );
1036 
#print "--- Project new Suffix $versions{$entry}{vname}\n";
1037 
 
1038 
 
1039 
        my $suffix = $versions{$entry}{suffix};
1040 
        $knownProjects{$suffix}{count}++;
1041 
 
1042 
        my $next = $versions{$entry}{next}[0];
1043 
        my $tip;
1044 
        while ( $next )
1045 
        {
1046 
            last if ( $suffix ne $versions{$next}{suffix} );
1047 
            $tip = $next unless (exists ($versions{$next}{DeadWood}) || $versions{$next}{badSingleton});
1048 
            $next = $versions{$next}{next}[0];
1049 
        }
1050 
 
1051 
        $versions{$tip}{Tip} = 1 if $tip;
1052 
    }
1053 
 
1054 
    unless ( $opt_flat )
1055 
    {
1056 
        my $finalTrees = scalar @startPoints;
1057 
        Warning ("Still have multiple trees: $finalTrees") unless ( $finalTrees == 1 );
1058 
    }
1059 
 
1060 
    #
1061 
    #   Display warnings about multiple
1062 
    #
1063 
    foreach ( sort keys %knownProjects )
1064 
    {
1065 
        my $count = $knownProjects{$_}{count} || 0;
1066 
        Warning ("Multiple Project Roots: $_ ($count)" )
1067 
            if ( $count > 1 );
1068 
    }
1069 
 
1070 
    #
1071 
    #   Display warnings about Bad Essential Packages
1072 
    #
1073 
    $allSvn = 1;
1074 
    foreach my $entry ( keys(%versions) )
1075 
    {
1076 
        $rippleCount++ if ( exists($versions{$entry}{isaRipple}) && $versions{$entry}{isaRipple} );
1077 
        $allSvn = 0 unless ( $versions{$entry}{isSvn} );
1078 
        next unless ( exists $versions{$entry}{Essential}  );
1079 
        next unless ( $versions{$entry}{badVcsTag}  );
1080 
        push @badEssentials, $entry;
1081 
        Warning ("BadVCS Essential: " . GetVname($entry))
1082 
    }
1083 
 
1084 
    #
1085 
    #   All done
1086 
    #
1087 
    Message("Retained entries: " . (scalar keys %versions) );
1088 
    Message("Pruned entries: $pruneCount");
1089 
    Message("Deadwood entries: $trimCount");
1090 
    Message("Bad Singletons: $badSingletonCount");
1091 
    Message("Ripples: $rippleCount");
1092 
}
1093 
 
1094 
sub calculateWalkOrder
1095 
{
1096 
    my ($entry) = @_;
1097 
    my @next = @{$versions{$entry}{next}};
1098 
    my $count = @next;
1099 
    my @ordered;
1100 
    my $main;
1101 
 
1102 
    if ( $count > 1 )
1103 
    {
1104 
        # Array to hash to simplify removal
1105 
        my %nexts = map { $_ => 1 } @next;
1106 
        foreach my $e ( @next )
1107 
        {
1108 
 
1109 
            #
1110 
            #   Locate branch points that are not a part of a new project
1111 
            #   These will not be preferred paths for walking
1112 
            #
1113 
            if ( !defined($versions{$e}{branchPoint}) && $versions{$entry}{suffix} ne $versions{$e}{suffix} )
1114 
            {
1115 
                unless ( exists $versions{$e}{DeadWood} || $versions{$e}{badSingleton}  )
1116 
                {
1117 
#print "--- Project Branch (1) $versions{$e}{vname}\n";
1118 
                    $versions{$e}{branchPoint} = 1;
1119 
                    $versions{$e}{newSuffix} = 1;
1120 
                }
1121 
            }
1122 
 
1123 
            #
1124 
            #   Remove those that already have a branch,
1125 
            #
1126 
            if ( $versions{$e}{branchPoint} || $versions{$e}{newSuffix} || $versions{$e}{DeadWood}  )
1127 
            {
1128 
                push @ordered, $e;
1129 
                delete $nexts{$e};
1130 
            }
1131 
        }
1132 
        #
1133 
        #   Select longest arm as the non-branching path
1134 
        #   Note: Reverse sort order
1135 
        #         Done so that 'newest' item is given preference
1136 
        #         to the main trunk in cases where all subtrees are
1137 
        #         the same length
1138 
        #
1139 
        my $maxData = '';
1140 
        my $countEntry;
1141 
        foreach my $e ( sort {$b <=> $a} keys %nexts )
1142 
        {
1143 
            if ( $versions{$e}{maxVersion} gt $maxData )
1144 
            {
1145 
                $maxData = $versions{$e}{maxVersion};
1146 
                $countEntry = $e;
1147 
            }
1148 
        }
1149 
        if ($countEntry)
1150 
        {
1151 
            $main = $countEntry;
1152 
            delete $nexts{$countEntry};
1153 
        }
1154 
 
1155 
        #
1156 
        #   Append the remaining
1157 
        #
1158 
        push @ordered, keys %nexts;
1159 
 
1160 
        #
1161 
        #   Re-order 'next' so that the main path is first
1162 
        #   Sort (non main) by number
1163 
        #
1164 
        @ordered = sort {$a <=> $b} @ordered;
1165 
        unshift @ordered, $main if ( $main );
1166 
        @{$versions{$entry}{next}} = @ordered;
1167 
 
1168 
        #
1169 
        #   Ensure all except the first are a branch point
1170 
        #   First may still be a branch point
1171 
        #
1172 
        shift @ordered;
1173 
        foreach my $e ( @ordered )
1174 
        {
1175 
            $versions{$e}{branchPoint} = 1;
1176 
        }
1177 
    }
1178 
}
1179 
 
1180 
#-------------------------------------------------------------------------------
1181 
# Function        : calcRippleGroups
1182 
#
1183 
# Description     : Locate and mark ripple groups
1184 
#                   packages that are ripples fo each other
1185 
#                       Keep first version of each ripple. Must keep first
1186 
#                       Group ripples together so that they can be
1187 
#                       proccessed at the same time
1188 
#
1189 
# Inputs          :
1190 
#
1191 
# Returns         :
1192 
#
1193 
sub calcRippleGroups
1194 
{
1195 
    my %rippleVersions;
1196 
    foreach my $entry ( keys(%versions) )
1197 
    {
1198 
        my $ep = $versions{$entry};
1199 
        if ( defined $ep->{buildVersion} )
1200 
        {
1201 
            my $suffix = $ep->{suffix};
1202 
            my ($major, $minor, $patch, $build) = @{$ep->{buildVersion}};
1203 
#print "--- $major, $minor, $patch, $build, $suffix\n";
1204 
            $rippleVersions{$suffix}{"$major.$minor.$patch"}{count}++;
1205 
            my $rp = $rippleVersions{$suffix}{"$major.$minor.$patch"};
1206 
            $rp->{list}{$entry} = 1;
1207 
 
1208 
            next if ( $ep->{badVcsTag} );
1209 
            next if ( $ep->{locked} eq 'N');
1210 
            if (!defined ($rp->{min}) || $rp->{min} > $build )
1211 
            {
1212 
                $rp->{pvid} = $entry;
1213 
                $rp->{min} = $build;
1214 
            }
1215 
        }
1216 
    }
1217 
#            DebugDumpData("rippleVersions", \%rippleVersions );
1218 
 
1219 
    while ( my($suffix, $e1) = each %rippleVersions )
1220 
    {
1221 
        while ( my( $mmp, $e2) = each %{$e1} )
1222 
        {
1223 
            next unless ( exists  $e2->{pvid} );
1224 
            my $entry = $e2->{pvid};
1225 
            if ( !exists $versions{$entry} )
1226 
            {
1227 
                Error ("Internal: Expected entry not found: $entry, $mmp");
1228 
            }
1229 
 
1230 
            $versions{$entry}{keepLowestRipple} = 1;
1231 
#print "--- Keep Riple $versions{$entry}{vname}\n";
1232 
 
1233 
            #
1234 
            #   Update entry with list of associated ripples, removing lowest
1235 
            #
1236 
            delete $e2->{list}{$entry};
1237 
            my @rippleList = sort keys %{$e2->{list}};
1238 
            if ( @rippleList)
1239 
            {
1240 
#DebugDumpData("LIST: $entry", $e2->{list}, \@rippleList  );
1241 
                @{$versions{$entry}{rippleList}} = @rippleList;
1242 
            }
1243 
        }
1244 
    }
1245 
}
1246 
 
1247 
#-------------------------------------------------------------------------------
1248 
# Function        : processBranch
1249 
#
1250 
# Description     : Process one complete branch within the tree of versions
1251 
#                   May be called recursivly to walk the tree
1252 
#
1253 
# Inputs          : Array of package-version ID to process
1254 
#
1255 
# Returns         : Nothing
1256 
#
1257 
 
1258 
sub processBranch
1259 
{
1260 
    foreach my $entry ( @_ )
1261 
    {
1262 
        #
1263 
        #   Do we need to create a branch before we can process this package
1264 
        #
1265 
        if ( $versions{$entry}{newSuffix} || $versions{$entry}{branchPoint} )
1266 
        {
1267 
            newProject();
1268 
            $createBranch = 1;
1269 
            $createSuffix = 1 if $versions{$entry}{newSuffix};
1270 
        }
1271 
 
1272 
        newPackageVersion( $entry );
1273 
no warnings "recursion";
1274 
        processBranch (@{$versions{$entry}{next}});
1275 
    }
1276 
}
1277 
 
1278 
#-------------------------------------------------------------------------------
1279 
# Function        : newPackageVersion
1280 
#
1281 
# Description     : Create a package version
1282 
#
1283 
# Inputs          : $entry              - Ref to entry being proccessed
1284 
#
1285 
# Returns         :
1286 
#
1287 
sub newPackageVersion
1288 
{
1289 
    my ($entry) = @_;
1290 
    my %data;
1291 
    my $flags = 'e';
1292 
    my $rv = 1;
1293 
    my $startTime = time();
1294 
    my $timestamp = localtime;
1295 
 
1296 
    $data{rmRef} = 'ERROR';
1297 
    $data{tag} = 'ERROR';
1298 
 
1299 
    #
1300 
    #   If its been processed then fake that its been done
1301 
    #   May have been a ripple that we processed
1302 
    #
1303 
    Message ("------------------------------------------------------------------" );
1304 
    Message ("New package-version: " . GetVname($entry) . " Tag: " . $versions{$entry}{vcsTag} );
1305 
    return if ($versions{$entry}{Processed});
1306 
 
1307 
 
1308 
    #
1309 
    #   If we have a global error,then we pretend to process, but we
1310 
    #   report errors for the logging system
1311 
    #
1312 
    unless ( $globalError )
1313 
    {
1314 
        #
1315 
        #   Call worker function
1316 
        #   It will exist on any error so that it can be logged
1317 
        #
1318 
        $rv = newPackageVersionBody( \%data, @_ );
1319 
        $globalError = 1 if ( $rv >= 10 );
1320 
    }
1321 
 
1322 
    #
1323 
    #   Highlight essential packages that failed to transfer
1324 
    #
1325 
    if ( $globalError ) {
1326 
        $flags = 'e';
1327 
    } elsif ( $rv && ( exists $versions{$entry}{Essential} ) ) {
1328 
        $flags = 'X';
1329 
    } elsif ( $rv ) {
1330 
        $flags = 'E';
1331 
    } else {
1332 
        $flags = 'G';
1333 
    }
1334 
 
1335 
    #
1336 
    #   Always log results to a file
1337 
    #   Flags:
1338 
    #       e - Error: Global Fatal causes other versions to be ignored
1339 
    #       X - Essential Package NOT proccessed
1340 
    #       E - Error processing package
1341 
    #       G - Good
1342 
    #
1343 
    my $duration = time() - $startTime;
1344 
    my $line = join(';',
1345 
            $flags,
1346 
            $entry,
1347 
            $packageNames,
1348 
            $versions{$entry}{vname},
1349 
            $data{rmRef},
1350 
            $data{tag},
1351 
            $timestamp,
1352 
            $duration,
1353 
            $data{errStr} || ''
1354 
            );
1355 
    logToFile( $cwd . '/importsummary.txt', ";$line;");
1356 
 
1357 
    #
1358 
    #   Sava data
1359 
    #
1360 
    $versions{$entry}{rmRef} = $data{rmRef};
1361 
    $versions{$entry}{errStr} = $data{errStr};
1362 
    $versions{$entry}{errFlags} = $flags;
1363 
 
1364 
    #
1365 
    #   Delete the created view
1366 
    #   Its just a directory, so delete it
1367 
    #
1368 
    if ( $data{ViewRoot} && -d $data{ViewRoot})
1369 
    {
1370 
        RmDirTree ($data{ViewRoot} ) if ( !$opt_reuse || $rv );
1371 
    }
1372 
 
1373 
 
1374 
    #
1375 
    #   If this version has any 'ripples' then process them while we have the
1376 
    #   main view. Note the ripple list may contain entries that do not
1377 
    #   exist - they will have been pruned.
1378 
    #
1379 
    foreach my $rentry ( @{$versions{$entry}{rippleList}} )
1380 
    {
1381 
        next unless( exists $versions{$rentry} );
1382 
 
1383 
        if ($versions{$rentry}{Processed})
1384 
        {
1385 
            Warning ("Ripple Processed before main entry");
1386 
            $versions{$rentry}{rippleProcessed} = 1;
1387 
        }
1388 
 
1389 
        Message ("Proccessing associated Ripple: " . GetVname($rentry));
1390 
        newPackageVersion($rentry);
1391 
    }
1392 
}
1393 
 
1394 
#-------------------------------------------------------------------------------
1395 
# Function        : newPackageVersionBody
1396 
#
1397 
# Description     : Perform the bulk of the work in creating a new PackageVersion
1398 
#                   Designed to return on error and have error processing
1399 
#                   performed by caller
1400 
#
1401 
# Inputs          : $data               - Shared data
1402 
#                   $entry              - Package entry to process
1403 
#
1404 
# Returns         : Error Code
1405 
#                         0 - All is well
1406 
#                       <10 - Recoveralble error
1407 
#                       >10 - Fatal error
1408 
#
1409 
sub newPackageVersionBody
1410 
{
1411 
    my ($data, $entry) = @_;
1412 
    my $rv;
1413 
    my $cc_label;
1414 
    my $cc_path;
1415 
 
1416 
    #
1417 
    #   Init Data
1418 
    #
1419 
    $data->{rmRef} = 'ERROR';
1420 
    $data->{tag} = '';
1421 
    $data->{ViewRoot} = undef;
1422 
    $data->{ViewPath} = undef;
1423 
    $data->{flags} = undef;
1424 
    $data->{errStr} = '';
1425 
    $versions{$entry}{Processed} = 1;
1426 
 
1427 
 
1428 
    SystemConfig ('ExitOnError' => 0);
1429 
 
1430 
    push @processOrder, $entry;
1431 
    return 0 if ( $opt_test );
1432 
 
1433 
#   Keep DeadWood. May be a WIP
1434 
#    if ( exists $versions{$entry}{DeadWood} && $versions{$entry}{DeadWood} )
1435 
#    {
1436 
#        $data->{errStr} = 'Package is DeadWood';
1437 
#        return 3;
1438 
#    }
1439 
 
1440 
    #
1441 
    #   Determine version information
1442 
    #
1443 
    $data->{tag} = $versions{$entry}{vcsTag} || '';
1444 
    if ( $versions{$entry}{badVcsTag} )
1445 
    {
1446 
        Warning ("Error: Bad VcsTag for: " . GetVname($entry),
1447 
                 "Tag: $data->{tag}" );
1448 
        $data->{errStr} = 'VCS Tag Marked as Bad';
1449 
        return 1;
1450 
    }
1451 
 
1452 
 
1453 
    $data->{tag} =~ m~^(.+?)::(.*?)(::(.+))?$~;
1454 
    $cc_label = $4;
1455 
    $cc_path = $2;
1456 
    $cc_path = '/' . $cc_path;
1457 
    $cc_path =~ tr~\\/~/~s;
1458 
 
1459 
    #
1460 
    #   Correct well known path mistakes
1461 
    #
394 dpurdie 1462 
    $cc_path =~ s~/MASS_Dev/Bus/~/MASS_Dev_Bus/~i;
392 dpurdie 1463 
    $cc_path =~ s~/MASS_Dev_Bus/Cbp/~/MASS_Dev_Bus/CBP/~i;
1464 
    $cc_path =~ s~/MREF_Package/ergpostmongui$~/MREF_Package/ergpostmongui~i;
1465 
 
1466 
#print "--- Path: $cc_path, Label: $cc_label\n";
1467 
 
1468 
    #
1469 
    #   Create CC view
1470 
    #   Import into Subversion View
1471 
    #
1472 
    $data->{ViewRoot} = $opt_name ? $opt_name : "$cc_label";
1473 
    $data->{ViewPath} =  $data->{ViewRoot} . '/' . $cc_path;
1474 
    $data->{ViewPath} =~  tr~/~/~s;
1475 
 
1476 
    if ( $opt_reuse && -d $data->{ViewPath}  )
1477 
    {
1478 
        Message ("Reusing view: $cc_label");
1479 
    }
1480 
    else
1481 
    {
1482 
        my @args;
1483 
        push (@args, '-view', $opt_name ) if ( defined $opt_name );
1484 
        $rv = JatsToolPrint ( 'jats_ccrelease', '-extractfiles', '-root=.' , '-noprefix',
1485 
                    "-label=$cc_label" ,
1486 
                    "-path=$cc_path",
1487 
                    @args
1488 
                    );
1489 
 
1490 
        unless ( -d $data->{ViewPath}  )
1491 
        {
1492 
            $data->{errStr} = 'Failed to extract files from CC';
1493 
            return 2;
1494 
        }
1495 
    }
1496 
 
1497 
    #
1498 
    #   Have a CC view
1499 
    #   Now we can create the SVN package and branching point before we
1500 
    #   import the CC data into SVN
1501 
    #
1502 
    my @args;
1503 
 
1504 
    #
1505 
    #   Calculate args for functions
1506 
    #
1507 
    my $author = $versions{$entry}{created_id};
1508 
    if ( $author )
1509 
    {
1510 
        push @args, '-author', $author;
1511 
    }
1512 
    my $created = $versions{$entry}{created};
1513 
    if ( $created )
1514 
    {
1515 
        $created =~ s~ ~T~;
1516 
        $created .= '00000Z';
1517 
        push @args, '-date', $created;
1518 
    }
1519 
 
1520 
    my $log = $versions{$entry}{comment};
1521 
    if ( $log )
1522 
    {
1523 
        push @args, '-log', $log;
1524 
    }
1525 
 
1526 
    #
1527 
    #   Create package skeleton if needed
1528 
    #
1529 
    $rv = createPackage( $author, $created);
1530 
    if ( $rv )
1531 
    {
1532 
        $data->{errStr} = 'Failed to create Package';
1533 
        return 10;
1534 
    }
1535 
 
1536 
    #
1537 
    #   Calculate the label for the target package
1538 
    #   Use format <packageName>_<PackageVersion>
1539 
    #   Need to handle WIPs too.
1540 
    #
1541 
    my $import_label = saneLabel($entry);
1542 
 
1543 
    #
1544 
    #   May need to create the branchpoint
1545 
    #   The process is delayed until its needed so avoid creating unneeded
1546 
    #   branch points
1547 
    #
1548 
    if ( $createBranch )
1549 
    {
1550 
        $rv = createBranchPoint ($entry, $author, $created);
1551 
        $createBranch = 0;
1552 
        $createSuffix = 0;
1553 
        if ( $rv )
1554 
        {
1555 
            $data->{errStr} = 'Failed to create Branch Point';
1556 
            return 11;
1557 
        }
1558 
    }
1559 
    push @args, "-branch=$currentBranchName" if ( defined $currentBranchName );
1560 
 
1561 
    my $datafile = "importdata.$import_label.properties";
1562 
    $rv = JatsToolPrint ( 'jats_svn', 'import', '-reuse' ,
1563 
                    "-package=$svnRepo/$packageNames",
1564 
                    "-dir=$data->{ViewPath}",
1565 
                    "-label=$import_label",
1566 
                    "-datafile=$datafile",
1567 
                    @args,
1568 
                     );
1569 
 
1570 
    if ( $rv )
1571 
    {
1572 
        $data->{errStr} = 'Failed to import to SVN';
1573 
        return 12;
1574 
    }
1575 
 
1576 
    $versions{$entry}{TagCreated} = 1;
1577 
    $firstVersionCreated = $entry unless ( $firstVersionCreated );
1578 
 
1579 
    #
1580 
    #   Read in the Rm Reference
1581 
    #   Retain entries in a global file
1582 
    #
1583 
    if ( -f $datafile  )
1584 
    {
1585 
        my $rmData = JatsProperties::New($datafile);
1586 
        $data->{rmRef} = 'SVN::' . $rmData->getProperty('subversion.tag');
1587 
    }
1588 
 
1589 
    unless ( $data->{rmRef}  )
1590 
    {
1591 
        $data->{errStr} = 'Failed to determin Rm Reference';
1592 
        return 13;
1593 
    }
1594 
 
1595 
    Message ("RM Ref: $data->{rmRef}");
1596 
    unlink $datafile;
1597 
 
1598 
    #
1599 
    #   All is good
1600 
    #
1601 
    $data->{errStr} = '';
1602 
    return 0;
1603 
}
1604 
 
1605 
 
1606 
#-------------------------------------------------------------------------------
1607 
# Function        : newProject
1608 
#
1609 
# Description     : Start a new project within a package
1610 
#
1611 
# Inputs          :
1612 
#
1613 
# Returns         :
1614 
#
1615 
sub newProject
1616 
{
1617 
#    Message ("---- New Project");
1618 
    $createSuffix = 0;
1619 
 
1620 
    #
1621 
    #   New project
1622 
    #   Kill the running import directory
1623 
    #
1624 
    RmDirTree ('SvnImportDir');
1625 
}
1626 
 
1627 
#-------------------------------------------------------------------------------
1628 
# Function        : newPackage
1629 
#
1630 
# Description     : Start processing a new package
1631 
#
1632 
# Inputs          :
1633 
#
1634 
# Returns         :
1635 
#
1636 
my $createPackageDone;
1637 
sub newPackage
1638 
{
1639 
#    Message( "---- New Package");
1640 
 
1641 
    #
1642 
    #   Create a package specific log file
1643 
    #
1644 
    $logSummary = $packageNames . ".summary.log";
1645 
    unlink $logSummary;
1646 
    Message( "PackageName: $packageNames");
1647 
    $createPackageDone = 1;
1648 
    $createBranch = 0;
1649 
    $createSuffix = 0;
1650 
 
1651 
    #
1652 
    #   First entry being created
1653 
    #   Prime the work area
1654 
    #
1655 
    RmDirTree ('SvnImportDir');
1656 
}
1657 
 
1658 
#-------------------------------------------------------------------------------
1659 
# Function        : createPackage
1660 
#
1661 
# Description     : Create a new Package in SVN
1662 
#                   Called before any serious SVN operation to ensure that the
1663 
#                   package has been created. Don't create a package until
1664 
#                   we expect to put something into it.
1665 
#
1666 
#                   Will only create a package once
1667 
 
1668 
#
1669 
# Inputs          : $author         - Who done it
1670 
#                   $date           - When
1671 
#
1672 
# Returns         :
1673 
#
1674 
sub createPackage
1675 
{
1676 
    my ($author, $date) = @_;
1677 
    my @opts;
1678 
    push (@opts, '-date', $date) if ( $date );
1679 
    push (@opts, '-author', $author) if ( $author );
1680 
    #
1681 
    #   Only do once
1682 
    #
1683 
    return unless ( $createPackageDone );
1684 
    $createPackageDone = 0;
1685 
 
1686 
    Message ("Creating new SVN package: $packageNames");
1687 
    JatsToolPrint ( 'jats_svn', 'delete-package', '-noerror',  "$svnRepo/$packageNames" );
1688 
    JatsToolPrint ( 'jats_svn', 'create', "$svnRepo/$packageNames", @opts );
1689 
}
1690 
 
1691 
 
1692 
#-------------------------------------------------------------------------------
1693 
# Function        : createBranchPoint
1694 
#
1695 
# Description     : Create a branch point for the current work
1696 
#                   Perform the calculation to determine the details of
1697 
#                   the branch point. The work will only be done when its
1698 
#                   needed. This will avoid the creation of branchpoints
1699 
#                   that are not used.
1700 
#
1701 
# Inputs          : $entry                  Entry being processed
1702 
#                   $author         - Who done it
1703 
#                   $date           - When
1704 
#
1705 
# Returns         :
1706 
#
1707 
sub createBranchPoint
1708 
{
1709 
    my ($entry, $author, $date) = @_;
1710 
    my $forceNewProject;
1711 
 
1712 
#    Message ("---- Create Branch Point");
1713 
 
1714 
    #
1715 
    #   Find previous good tag
1716 
    #   We are walking a tree so something should have been created, but
1717 
    #   the one we want may have had an error
1718 
    #
1719 
    #   Walk backwards looking for one that has been created
1720 
    #
1721 
    my $last = $versions{$entry}{last};
1722 
    while ( $last )
1723 
    {
1724 
        unless ( $versions{$last}{TagCreated} )
1725 
        {
1726 
            $last = $versions{$last}{last};
1727 
        }
1728 
        else
1729 
        {
1730 
            last;
1731 
        }
1732 
    }
1733 
 
1734 
    #
1735 
    #   If we have walked back to the base of the tree
1736 
    #   If we transferred any software at all, then use the first
1737 
    #   version as the base for this disconnected version
1738 
    #
1739 
    #   Otherwise we create a new, and empty, view
1740 
    #
1741 
    unless ( $last )
1742 
    {
1743 
        if ( $firstVersionCreated )
1744 
        {
1745 
            Warning ("Cannot find previous version to branch. Use first version");
1746 
            $last = $firstVersionCreated;
1747 
        }
1748 
        else
1749 
        {
1750 
            Warning ("Forcing First instance of a Project");
1751 
            $forceNewProject = 1;
1752 
        }
1753 
    }
1754 
 
1755 
    #
1756 
    #   Determine source name
1757 
    #   This MUST have been created before we can branch
1758 
    #
1759 
    my $src_label;
1760 
    $src_label = saneLabel($last) if $last;
1761 
 
1762 
    #
1763 
    #   Create target name
1764 
    #
1765 
    my $tgt_label;
1766 
    if ( $forceNewProject || $versions{$entry}{newSuffix} || $createSuffix || !defined $src_label )
1767 
    {
1768 
        #
1769 
        #   Create target name based on project
1770 
        #
1771 
        return if ( $singleProject );
1772 
 
1773 
        my $suffix = $versions{$entry}{suffix};
1774 
        if ( $suffix )
1775 
        {
1776 
            Error ("Unknown Project: $suffix") unless ( defined $Projects{$suffix} );
1777 
 
1778 
            #
1779 
            #   If this project can be considered to be a truck, then 'claim' the
1780 
            #   truck for the first created element.
1781 
            #
1782 
            if ( $Projects{$suffix}{Trunk} )
1783 
            {
1784 
                # This project can use the trunk, if it has not been allocated.
1785 
                $ProjectTrunk = $suffix unless ( defined $ProjectTrunk );
1786 
 
1787 
                #
1788 
                #   If this package has multiple instances of the potential
1789 
                #   trunk, then don't place either of them on the trunk as it
1790 
                #   may cause confusion
1791 
                #
1792 
                if ($knownProjects{$suffix}{count} < 2 )
1793 
                {
1794 
                    if ( $suffix eq $ProjectTrunk )
1795 
                    {
1796 
                        return unless $currentBranchName;
1797 
                    }
1798 
                }
1799 
            }
1800 
 
1801 
            $tgt_label = $Projects{$suffix}{Name};
1802 
            $tgt_label = $versions{$entry}{name} . '_' . $tgt_label if ($multiPackages);
1803 
            if ( !exists $ProjectsBaseCreated{$tgt_label}  )
1804 
            {
1805 
                $ProjectsBaseCreated{$tgt_label} = 1;
1806 
            }
1807 
            else
1808 
            {
1809 
                #   Project Base Already taken
1810 
                #   Have disjoint starting points
1811 
                $tgt_label .= '.' . $ProjectsBaseCreated{$tgt_label} ++;
1812 
            }
1813 
        }
1814 
        else
1815 
        {
1816 
            #
1817 
            #   No suffix in use
1818 
            #
1819 
            #   Currently not handled
1820 
            #   May have to force the use of the trunk
1821 
            #
1822 
            Error ("INTERNAL ERROR: No suffix present");
1823 
        }
1824 
    }
1825 
    else
1826 
    {
1827 
        $tgt_label = saneLabel($entry, $src_label . '_for_');
1828 
    }
1829 
 
1830 
    #
1831 
    #   Save branch name for use when populating sandbox
1832 
    #
1833 
    $currentBranchName = $tgt_label;
1834 
 
1835 
    #
1836 
    #   Perform the branch
1837 
    #
1838 
    if ( defined $src_label )
1839 
    {
1840 
        my @opts;
1841 
        push (@opts, '-date', $date) if ( $date );
1842 
        push (@opts, '-author', $author) if ( $author );
1843 
 
1844 
        JatsToolPrint ( 'jats_svnlabel',
1845 
                        '-packagebase', "$svnRepo/$packageNames",
1846 
                        'tags/' . $src_label,
1847 
                        '-branch',
1848 
                        '-clone', $tgt_label,
1849 
                        @opts
1850 
                      );
1851 
    }
1852 
}
1853 
 
1854 
 
1855 
#-------------------------------------------------------------------------------
1856 
# Function        : endPackage
1857 
#
1858 
# Description     : End of package processing
1859 
#                   Clean up and display problems
1860 
#
1861 
# Inputs          :
1862 
#
1863 
# Returns         :
1864 
#
1865 
sub endPackage
1866 
{
1867 
    RmDirTree ('SvnImportDir');
1868 
 
1869 
    #
1870 
    #   Display versions that did get captured
1871 
    #
1872 
    foreach my $entry ( @processOrder )
1873 
    {
1874 
        $versions{$entry}{Scanned} = 1;
1875 
        next unless ( $versions{$entry}{TagCreated} );
1876 
        Warning ("Processed: " . GetVname($entry) . ' :: ' . $versions{$entry}{rmRef} || $versions{$entry}{errStr} || '???' );
1877 
    }
1878 
 
1879 
    #
1880 
    #   Display versions that did not get created
1881 
    #
1882 
    foreach my $entry ( @processOrder )
1883 
    {
1884 
        $versions{$entry}{Scanned} = 1;
1885 
        next if ( $versions{$entry}{TagCreated} );
1886 
        Warning ("Not Processed: " . GetVname($entry) );
1887 
    }
1888 
 
1889 
    foreach my $entry ( keys(%versions) )
1890 
    {
1891 
        next if ( $versions{$entry}{Scanned} );
1892 
        Warning ("(E) INTERNAL ERROR. Package Not Processed: " . GetVname($entry) );
1893 
    }
1894 
 
1895 
    Message ("All Done");
1896 
}
1897 
 
1898 
sub JatsToolPrint
1899 
{
1900 
    Information ("Command: @_");
1901 
    JatsTool @_;
1902 
}
1903 
 
1904 
sub GetVname
1905 
{
1906 
    my ($entry) = @_;
1907 
    my $me = 'NONE';
1908 
    if ( $entry )
1909 
        {
1910 
        $me = $versions{$entry}{vname};
1911 
        unless ( $me )
1912 
        {
1913 
            $me = 'Unknown-' . $entry;
1914 
        }
1915 
    }
1916 
    return $me;
1917 
}
1918 
 
1919 
sub saneLabel
1920 
{
1921 
    my ($entry, $pkgname) = @_;
1922 
    my $me = $versions{$entry}{vname};
1923 
    $pkgname = $versions{$entry}{name} unless ( defined $pkgname );
1924 
 
1925 
    Error ("Package does have a version string: pvid: $entry")
1926 
        unless ( defined $me );
1927 
 
1928 
    #
1929 
    #   Convert Wip format (xxxx) into a string that can be used for a label
1930 
    #
1931 
    if ( $me =~ m~^(.*)\((.*)\)(.*)$~ )
1932 
    {
1933 
        $me = $1 . '_' . $2 . '_' . $3 . '.WIP';
1934 
        $me =~ s~_\.~.~;
1935 
        $me =~ s~^_~~;
1936 
    }
1937 
 
1938 
    #
1939 
    #   Allow for WIPS
1940 
    #   Get rid of multiple '_'
1941 
    #   Replace space with -
1942 
    #
1943 
    $me = $pkgname . '_' . $me;
1944 
    $me =~ tr~ ~-~s;
1945 
    $me =~ tr~-~-~s;
1946 
    $me =~ tr~_~_~s;
1947 
 
1948 
    return $me;
1949 
}
1950 
 
1951 
 
1952 
exit 0;
1953 
 
1954 
 
1955 
#-------------------------------------------------------------------------------
1956 
# Function        : GetPkgIdByName
1957 
#
1958 
# Description     :
1959 
#
1960 
# Inputs          : pkg_name
1961 
#
1962 
# Returns         : pkg_id
1963 
#
1964 
sub GetPkgIdByName
1965 
{
1966 
    my ( $pkg_name ) = @_;
1967 
    my (@row);
1968 
    my $pv_id;
1969 
    my $pkg_id;
1970 
 
1971 
    #
1972 
    #   Establish a connection to Release Manager
1973 
    #
1974 
    connectRM(\$RM_DB) unless ( $RM_DB );
1975 
 
1976 
    #
1977 
    #   Extract data from Release Manager
1978 
    #
1979 
    my $m_sqlstr = "SELECT pkg.PKG_NAME, pkg.PKG_ID" .
1980 
                   " FROM RELEASE_MANAGER.PACKAGES pkg" .
1981 
                   " WHERE pkg.PKG_NAME = \'$pkg_name\'";
1982 
 
1983 
    my $sth = $RM_DB->prepare($m_sqlstr);
1984 
    if ( defined($sth) )
1985 
    {
1986 
        if ( $sth->execute( ) )
1987 
        {
1988 
            if ( $sth->rows )
1989 
            {
1990 
                while ( @row = $sth->fetchrow_array )
1991 
                {
1992 
                    Verbose( "DATA: " . join(',', @row) );
1993 
                    $pkg_id = $row[1] || 0;
1994 
                    last;
1995 
                }
1996 
            }
1997 
            else
1998 
            {
1999 
                Error ("GetPkgIdByName:No Data for package: $pkg_name");
2000 
            }
2001 
            $sth->finish();
2002 
        }
2003 
    }
2004 
    else
2005 
    {
2006 
        Error("GetPkgIdByName:Prepare failure" );
2007 
    }
2008 
 
2009 
    return $pkg_id;
2010 
}
2011 
 
2012 
#-------------------------------------------------------------------------------
2013 
# Function        : GetData_by_pkg_id
2014 
#
2015 
# Description     :
2016 
#
2017 
# Inputs          : pv_id
2018 
#
2019 
# Returns         :
2020 
#
2021 
sub GetData_by_pkg_id
2022 
{
2023 
    my ( $pkg_id, $packageName ) = @_;
2024 
    my (@row);
2025 
 
2026 
    #
2027 
    #   Establish a connection to Release Manager
2028 
    #
2029 
    Message ("Extract package versions from Release Manager: $packageName");
2030 
    connectRM(\$RM_DB) unless ( $RM_DB );
2031 
 
2032 
    #
2033 
    #   Extract data from Release Manager
2034 
    #
2035 
    my $m_sqlstr = "SELECT pkg.PKG_NAME, pv.PKG_VERSION, pkg.PKG_ID, pv.PV_ID, pv.LAST_PV_ID, pv.MODIFIED_STAMP, release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), amu.USER_NAME, pv.COMMENTS, pv.DLOCKED, pv.CREATOR_ID ".
2036 
                   " FROM RELEASE_MANAGER.PACKAGES pkg, RELEASE_MANAGER.PACKAGE_VERSIONS pv, ACCESS_MANAGER.USERS amu" .
2037 
                   " WHERE pv.PKG_ID = \'$pkg_id\' AND pkg.PKG_ID = pv.PKG_ID AND amu.USER_ID (+) = pv.CREATOR_ID";
2038 
 
2039 
 
2040 
    my $sth = $RM_DB->prepare($m_sqlstr);
2041 
    if ( defined($sth) )
2042 
    {
2043 
        if ( $sth->execute( ) )
2044 
        {
2045 
            if ( $sth->rows )
2046 
            {
2047 
                while ( @row = $sth->fetchrow_array )
2048 
                {
2049 
                    Verbose( "DATA: " . join(',', @row) );
2050 
                    my $pkg_name = $row[0] || 'Unknown';
2051 
                    my $pkg_ver = $row[1] || 'Unknown';
2052 
                       $pkg_ver =~ s~\s+$~~;
2053 
                       $pkg_ver =~ s~^\s+~~;
2054 
                    my $pv_id = $row[3] || 'Unknown';
2055 
                    my $last_pv_id = $row[4];
2056 
                    my $created =  $row[5] || 'Unknown';
2057 
                    my $vcstag =  $row[6] || 'Unknown';
394 dpurdie 2058 
 
392 dpurdie 2059 
                    my $created_id =  $row[7] || ($row[10] ? "Userid_$row[10]" :'Unknown');
2060 
                    my $comment =  $row[8] || '';
2061 
                    my $locked =  $row[9] || 'N';
2062 
 
2063 
                    #
2064 
                    #   Some developers have a 'special' package version
2065 
                    #   We really need to ignore them
2066 
                    #
2067 
                    next if ( $pkg_ver eq '23.23.23.ssw' );
2068 
 
2069 
                    #
2070 
                    #   Add data to the hash
2071 
                    #       Remove entries that address themselves
2072 
                    #
2073 
                    push (@{$versions{$last_pv_id}{next}}, $pv_id) unless ($pv_id == $last_pv_id || $last_pv_id == 0) ;
2074 
                    $versions{$pv_id}{name} = $pkg_name;
2075 
                    $versions{$pv_id}{pvid} = $pv_id;
2076 
                    $versions{$pv_id}{vname} = $pkg_ver;
2077 
                    $versions{$pv_id}{vcsTag} = $vcstag;
2078 
                    $versions{$pv_id}{created} = $created;
2079 
                    $versions{$pv_id}{created_id} = $created_id;
2080 
                    $versions{$pv_id}{comment} = $comment;
2081 
                    $versions{$pv_id}{locked} = $locked;
2082 
                    $versions{$pv_id}{TimeStamp} = str2time( $created );
2083 
                    $versions{$pv_id}{Age} = ($now - $versions{$pv_id}{TimeStamp}) / (60 * 60 * 24);
2084 
                    $versions{$pv_id}{TooOld} = 1 if ( $opt_age && $opt_age <= $versions{$pv_id}{Age} );
2085 
                    examineVcsTag($pv_id);
2086 
 
2087 
                    #
2088 
                    #   Process version number
2089 
                    #
2090 
                    my ($suffix, $version, $isaR, $isaWip, $buildVersion ) = massageVersion($pkg_ver, $pkg_name);
2091 
 
2092 
                    $versions{$pv_id}{version} = $version;
2093 
                    $versions{$pv_id}{buildVersion} = $buildVersion;
2094 
                    $versions{$pv_id}{isaRipple} = 1 if ( $isaR );
2095 
                    $versions{$pv_id}{isaWip} = 1 if ( $isaWip );
2096 
 
2097 
                    #
2098 
                    #   Process suffix
2099 
                    #
2100 
                    $suffix = 'Unknown' unless ( $suffix );
2101 
                    $suffix = lc ($suffix);
2102 
                    $versions{$pv_id}{suffix} = $suffix;
2103 
                    push @{$suffixes{$suffix}}, $pv_id;
2104 
 
2105 
#                    print "$pkg_name, $pkg_ver, $pv_id, $last_pv_id, $locked, $created, $created_id, $suffix\n";
2106 
                }
2107 
            }
2108 
            else
2109 
            {
2110 
                Error ("GetData_by_pkg_id: No Data: $m_sqlstr");
2111 
            }
2112 
            $sth->finish();
2113 
        }
2114 
        else
2115 
        {
2116 
                Error ("GetData_by_pkg_id: Execute: $m_sqlstr");
2117 
        }
2118 
    }
2119 
    else
2120 
    {
2121 
        Error("GetData_by_pkg_id:Prepare failure" );
2122 
    }
2123 
}
2124 
 
2125 
#-------------------------------------------------------------------------------
2126 
# Function        : massageVersion
2127 
#
2128 
# Description     : Process a version number and return usful bits
2129 
#
2130 
# Inputs          : Version Number
2131 
#                   Package Name - debug only
2132 
#
2133 
# Returns         : An array
2134 
#                       suffix
2135 
#                       multipart version string useful for text comparisons
2136 
#
2137 
sub massageVersion
2138 
{
2139 
    my ($version, $name) = @_;
2140 
    my ($major, $minor, $patch, $build, $suffix);
2141 
    my $result;
2142 
    my $buildVersion;
2143 
    my $isaRipple;
2144 
    my $isaWIP;
2145 
    $build = 0;
2146 
 
2147 
#print "--- $name, $version\n";
2148 
    $version =~ s~^_~~;
2149 
    $version =~ s~^${name}_~~;
2150 
 
2151 
    #
2152 
    #   xxxxxxxxx.nnnn.cots
2153 
    #
2154 
    if ( $version =~ m~(.*)\.cots$~ ) {
2155 
        my $cots_base = $1;
2156 
        $suffix = '.cots';
2157 
        if ( $version =~ m~(.*?)\.([0-9]{4})\.cots$~ )
2158 
        {
2159 
            $result = $1 . sprintf (".%4.4d", $2) . $suffix;
2160 
        }
2161 
        else
2162 
        {
2163 
            $result = $cots_base . '.0000.cots';
2164 
        }
2165 
    }
2166 
    #
2167 
    #   Convert version into full form for comparisions
2168 
    #       nnn.nnn.nnn.[p]nnn.xxx
2169 
    #       nnn.nnn.nnn.[p]nnn-xxx
2170 
    #       nnn.nnn.nnn-[p]nnn.xxx
2171 
    #       nnn.nnn.nnn-[p]nnn-xxx
2172 
    #       nnn.nnn.nnn[p]nnn-xxx
2173 
    #   Don't flag as ripples - they are patches
2174 
    #
2175 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-.p][p]?(\d+)([-.](.*))?$~ ) {
2176 
        $major = $1;
2177 
        $minor = $2;
2178 
        $patch = $3;
2179 
        $build = $4;
2180 
        $suffix = defined $6 ? ".$6" : '';
2181 
        $isaRipple = 0;
2182 
    }
2183 
    #
2184 
    #       nn.nnn.nnnnn.xxx
2185 
    #       nn.nnn.nnnnn-xxx
2186 
    #       nnn.nnn.nnnx.xxx
2187 
    #   Don't flag as ripples - they are patches
2188 
    #
2189 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)\w?([-.](.*))?$~ ) {
2190 
        $major = $1;
2191 
        $minor = $2;
2192 
        $patch = $3;
2193 
        if ( length( $patch) >= 4 )
2194 
        {
2195 
            $build = substr( $patch, -3 ,3);
2196 
            $patch = substr( $patch,  0 ,length($patch)-3);
2197 
        }
2198 
        $suffix = defined $5 ? ".$5" : '';
2199 
    }
2200 
 
2201 
    #
2202 
    #       nnn.nnn.nnn
2203 
    #       nnn.nnn-nnn
2204 
    #       nnn.nnn_nnn
2205 
    #
2206 
    elsif ( $version =~ m~^(\d+)\.(\d+)[-._](\d+)$~ ) {
2207 
        $major = $1;
2208 
        $minor = $2;
2209 
        $patch = $3;
2210 
        $suffix = '';
2211 
    }
2212 
 
2213 
    #
2214 
    #       nnn.nnn.nnn.nnn
2215 
    #       nnn.nnn.nnn-nnn
2216 
    #       nnn.nnn.nnn_nnn
2217 
    #
2218 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-._](\d+)$~ ) {
2219 
        $major = $1;
2220 
        $minor = $2;
2221 
        $patch = $3;
2222 
        $build = $4;
2223 
        $suffix = '';
2224 
        $isaRipple = 0;
2225 
    }
2226 
 
2227 
 
2228 
    #
2229 
    #       nnn.nnn
2230 
    #
2231 
    elsif ( $version =~ m~^(\d+)\.(\d+)$~ ) {
2232 
        $major = $1;
2233 
        $minor = $2;
2234 
        $patch = 0;
2235 
        $suffix = '';
2236 
    }
2237 
    #
2238 
    #       nnn.nnn.xxx
2239 
    #
2240 
    elsif ( $version =~ m~^(\d+)\.(\d+)(\.\w+)$~ ) {
2241 
        $major = $1;
2242 
        $minor = $2;
2243 
        $patch = 0;
2244 
        $suffix = $3;
2245 
    }
2246 
 
2247 
    #
2248 
    #       nnn.nnn.nnnz
2249 
    #
2250 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)([a-z])$~ ) {
2251 
        $major = $1;
2252 
        $minor = $2;
2253 
        $patch = $3;
2254 
        $build = ord($4) - ord('a');
2255 
        $suffix = '.cots';
2256 
        $isaRipple = 0;
2257 
    }
2258 
    #
2259 
    #       ???REV=???
2260 
    #
2261 
    elsif ( $version =~ m~REV=~ ) {
2262 
        $suffix = '.cots';
2263 
        $result = $version . '.0000.cots';
2264 
    }
2265 
 
2266 
    #
2267 
    #   Wip Packages
2268 
    #   (nnnnnn).xxx
2269 
    #   Should be essential, but want to sort very low
2270 
    #
2271 
    elsif ($version =~ m~\((.*)\)(\..*)?~) {
2272 
        $suffix = $2 || '';
2273 
        $result = "000.000.000.000$suffix";
2274 
        $isaWIP = 1;
2275 
    }
2276 
 
2277 
    #
2278 
    #   !current
2279 
    #
2280 
    elsif ($version eq '!current' || $version eq 'current_$USER' || $version eq 'current' || $version eq 'beta' || $version eq 'latest' || $version eq 'beta.cr' || $version eq 'CREATE') {
2281 
        $suffix = '';
2282 
        $result = "000.000.000.000$suffix";
2283 
        $isaWIP = 1;
2284 
    }
2285 
 
2286 
    #
2287 
    #   Also WIP: FINRUN.103649.BEI.WIP
2288 
    elsif ($version =~ m~(\.[a-zA-Z]+)\.WIP$~) {
2289 
        $suffix = lc($1);
2290 
        $result = "000.000.000.000$suffix";
2291 
        $isaWIP = 1;
2292 
    }
2293 
 
2294 
    #
2295 
    #   Also ERGOFSSLS190100_015
2296 
    #   Don't flag as a ripple
2297 
    elsif ($version =~ m~^ERG[A-Z]+(\d\d)(\d\d)(\d\d)[-_](\d+)(\.\w+)?$~) {
2298 
        $major = $1;
2299 
        $minor = $2;
2300 
        $patch = $3;
2301 
        $build = $4;
2302 
        $suffix = $5 || '.sls';
2303 
        $isaRipple = 0;
2304 
    }
2305 
 
2306 
    #
2307 
    #   Stuff we don't yet handle
2308 
    #
2309 
    else  {
2310 
        Warning ("Unknown version number: $name,$version");
2311 
        $version =~ m~(\.\w+)$~;
2312 
        $suffix = $1 || '';
2313 
        $result = $version;
2314 
    }
2315 
 
2316 
    $isaRipple = ($build > 0) unless defined $isaRipple;
2317 
    unless ( $result )
2318 
    {
2319 
        # Major and minor of 99.99 are normally funy versions
2320 
        # Don't make important desicions on them
2321 
        #
2322 
        if ( $major == 99 && $minor == 99 )
2323 
        {
2324 
            $major = 0;
2325 
            $minor = 0;
2326 
            $patch = 0;
2327 
        }
2328 
 
2329 
        $result = sprintf("%3.3d.%3.3d.%3.3d.%3.3d%s", $major,$minor,$patch,$build,$suffix || '.0000');
2330 
        $buildVersion = [ $major, $minor, $patch, $build ];
2331 
    }
2332 
 
2333 
    $suffix = lc( $suffix );
2334 
    if ( exists $suffixFixup{$suffix} )
2335 
    {
2336 
        $suffix = $suffixFixup{$suffix} ;
2337 
    }
2338 
 
2339 
    return ($suffix, $result, $isaRipple, $isaWIP, $buildVersion );
2340 
}
2341 
 
2342 
#-------------------------------------------------------------------------------
394 dpurdie 2343 
# Function        : vcsCleanup
2344 
#
2345 
# Description     : Cleanup and rewrite a vcstag
2346 
#
2347 
#                   DUPLICATED IN:
2348 
#                       - cc2svn_procdata
395 dpurdie 2349 
#                       - cc2svn_importpackage
394 dpurdie 2350 
#
2351 
# Inputs          : vcstag
2352 
#
2353 
# Returns         : Cleaned up vcs tag
2354 
#
2355 
sub vcsCleanup
2356 
{
2357 
    my ($tag) = @_;
2358 
    $tag =~ tr~\\/~/~;
2359 
    if ( $tag =~ m~^CC::~ )
2360 
    {
2361 
        $tag =~ s~CC::\s+~CC::~;
2362 
        $tag =~ s~MASS_Dev_Bus/Cbp/~MASS_Dev_Bus/CBP/~i;
2363 
        $tag =~ s~MASS_Dev_Bus~MASS_Dev_Bus~i;
2364 
        $tag =~ s~/MASS_Dev/Infra~MASS_Dev_Infra~i;
2365 
        $tag =~ s~/MASS_Dev/Bus/web~/MASS_Dev_Bus/web~i;
2366 
 
2367 
        $tag =~ s~/Vastraffik/~/Vasttrafik/~;
2368 
        $tag =~ s~/MREF_Package/ergpostmongui$~/MREF_Package/ergpostmongui~i;
395 dpurdie 2369 
        $tag =~ s~DPC_SWCode/~DPG_SWCode/~i;
394 dpurdie 2370 
    }
2371 
    return $tag;
2372 
}
2373 
 
2374 
#-------------------------------------------------------------------------------
392 dpurdie 2375 
# Function        : examineVcsTag
2376 
#
2377 
# Description     : Examine a VCS Tag and determine if it looks like rubbish
394 dpurdie 2378 
#                   Give it a clean
392 dpurdie 2379 
#
2380 
# Inputs          : $entry
2381 
#
2382 
# Returns         : Will add Data to the $entry
2383 
#
2384 
sub examineVcsTag
2385 
{
2386 
    my ($entry) = @_;
2387 
    my $bad = 0;
394 dpurdie 2388 
 
395 dpurdie 2389 
    $versions{$entry}{vcsTag} = vcsCleanup($versions{$entry}{vcsTag});
2390 
    my $vcstag = $versions{$entry}{vcsTag};
394 dpurdie 2391 
 
392 dpurdie 2392 
    if ( $vcstag =~ m~^SVN::~ ) {
2393 
        $versions{$entry}{isSvn} = 1;
2394 
 
2395 
    } elsif ( $vcstag =~ m~^CC::(.*?)(::(.+))?$~ ) {
2396 
        my $path = $1  || '';
2397 
        my $label = $2 || '';
2398 
        $bad = 1 unless ( $label );
2399 
        $bad = 1 if ( $label =~ m~^N/A$~i || $label  =~ m~^na$~i );
2400 
 
2401 
        $bad = 1 unless ( $path );
2402 
        $bad = 1 if ( $path =~ m~^N/A$~i || $path  =~ m~^na$~i );
2403 
        $bad = 1 if ( $path =~ m~^/dpkg_archive~ || $path  =~ m~^dpkg_archive~ );
2404 
        $bad = 1 if ( $path =~ m~^/devl/~ || $path  =~ m~^devl/~ );
395 dpurdie 2405 
        $bad = 1 if ( $path =~ m~^CVS~ );
392 dpurdie 2406 
        $bad = 1 if ( $path =~ m~^http:~i );
2407 
        $bad = 1 if ( $path =~ m~^[A-Za-z]\:~ );
2408 
        $bad = 1 if ( $path =~ m~^//~ );
394 dpurdie 2409 
        $bad = 1 if ( $path =~ m~^/*none~i );
2410 
        $bad = 1 if ( $path =~ m~^/*NoWhere~i );
2411 
        $bad = 1 if ( $path =~ m~^-$~i );
392 dpurdie 2412 
        $bad = 1 if ( $path =~ m~^cvsserver:~ );
2413 
        $bad = 1 if ( $path =~ m~,\s*module:~ );
2414 
#        $bad = 1 unless ( $path =~ m~^/~ );
2415 
    }
2416 
    else
2417 
    {
2418 
        $bad = 1;
2419 
    }
2420 
    $versions{$entry}{badVcsTag} = 1 if ( $bad );
2421 
}
2422 
 
2423 
#-------------------------------------------------------------------------------
2424 
# Function        : logToFile
2425 
#
2426 
# Description     : Log some data to a named file
2427 
#                   Use file locking to allow multiple process to log
2428 
#
2429 
# Inputs          : $filename           - Name of file to log
2430 
#                   ...                 - Data to log
2431 
#
2432 
# Returns         : Nothing
2433 
#
2434 
sub logToFile
2435 
{
2436 
    my ($file, @data) = @_;
2437 
 
2438 
    open  (LOGFILE, '>>', $file);
2439 
    flock (LOGFILE, LOCK_EX);
2440 
    print  LOGFILE "@data\n";
2441 
    flock (LOGFILE, LOCK_UN);
2442 
    close (LOGFILE);
2443 
}
2444 
 
2445 
#-------------------------------------------------------------------------------
2446 
# Function        : createImages
2447 
#
2448 
# Description     : Create nice images of the RM version tree
2449 
#
2450 
# Inputs          :
2451 
#
2452 
# Returns         :
2453 
#
2454 
sub createImages
2455 
{
2456 
 
2457 
    my $filebase = "${packageNames}";
2458 
    open (FH, '>', "$filebase.dot" ) or die "Cannot open output";
2459 
    print FH "digraph \"${packageNames}\" {\n";
2460 
    #print FH "rankdir=LR;\n";
2461 
    print FH "node[fontsize=16];\n";
2462 
    print FH "node[target=_graphviz];\n";
2463 
#    print FH "subgraph cluster_A {\n";
2464 
#    print FH "node[fontsize=12];\n";
2465 
 
2466 
    {
2467 
        my @text;
2468 
        push @text, $packageNames;
2469 
        push @text, 'HyperLinked to Release Manager';
2470 
        push @text, 'Created:' . localtime();
2471 
        push @text, '|';
2472 
 
2473 
        push @text, 'Total RM versions: ' . $totalVersions;
2474 
        push @text, 'Essential Entries: ' . scalar @EssentialPackages;
2475 
        push @text, 'Initial trees: ' . $initialTrees;
2476 
 
2477 
        push @text, 'Number of Entries: ' . scalar keys %versions;
2478 
        push @text, 'Type : ' . $packageType;
2479 
        push @text, 'All versions in Subversion' if ( $allSvn );
2480 
 
2481 
        push @text, '|';
2482 
        push @text, 'Total Project Branches: ' . $ProjectCount;
2483 
        foreach ( sort keys %knownProjects )
2484 
        {
2485 
            my $count = $knownProjects{$_}{count} || 0;
2486 
            if ( $count )
2487 
            {
2488 
                my $text = 'Project Branch: ' . $_;
2489 
                $text .= " (" . $count . ")" if ( $count > 1 );
2490 
                push @text, $text;
2491 
            }
2492 
        }
2493 
 
2494 
        push @text, '|';
2495 
        push @text, 'Bad VCS : ' . $badVcsCount;
2496 
        push @text, 'Bad Singletions : ' . $badSingletonCount;
2497 
        push @text, 'Deadwood entries : ' . $trimCount;
2498 
        push @text, 'Walking Mode : Flat' if ($opt_flat);
2499 
        push @text, 'Pruned Mode : ' . $pruneModeString;
2500 
        push @text, 'Pruned entries : ' . $pruneCount;
2501 
 
2502 
        if ( @unknownProjects )
2503 
        {
2504 
            push @text, '|';
2505 
            push @text, 'Unknown Projects';
2506 
            push @text, 'Unknown Project: ' . $_ foreach (sort @unknownProjects );
2507 
        }
2508 
 
2509 
        #
2510 
        #   Multiple Paths
2511 
        #
2512 
        if ( scalar @multiplePaths > 1 )
2513 
        {
2514 
            push @text, '|';
2515 
            push @text, 'Multiple Paths';
2516 
            push @text, @multiplePaths;
2517 
        }
2518 
 
2519 
        #
2520 
        #   Bad essentials
2521 
        #
2522 
        if ( @badEssentials  )
2523 
        {
2524 
            push @text, '|';
2525 
            push @text, 'Bad Essential Versions';
2526 
            push @text, GetVname($_) foreach ( @badEssentials );
2527 
        }
2528 
 
2529 
        #
2530 
        #   Subversion Data
2531 
        #
2532 
        if ( %svnData )
2533 
        {
2534 
            push @text, '|';
2535 
            push @text, 'Subversion';
2536 
            push @text, 'Trunk used' if exists $svnData{branches}{trunk} ;
2537 
            push @text, 'Labels: ' . scalar keys %{$svnData{tags}} ;
2538 
            push @text, 'Branches: ' . scalar keys %{$svnData{branches}} ;
2539 
        }
2540 
 
2541 
        push @text, '';
2542 
        my $text = join '\l', @text;
2543 
        $text =~ s~\|\\l~|~g;
2544 
 
2545 
        my @attributes;
2546 
        push @attributes, "shape=record";
2547 
        push @attributes, "label=\"{$text}\"";
2548 
        push @attributes, "tooltip=\"$packageNames\"";
2549 
        push @attributes, "URL=\"" . $GBE_RM_URL . "/view_by_version.asp?pkg_id=$first_pkg_id" . "\"";
2550 
        push @attributes, "color=red";
2551 
        my $attr = join( ' ', @attributes);
2552 
 
2553 
        my $tld_done = 'TitleBlock';
2554 
        print FH "$tld_done [$attr]\n";
2555 
    }
2556 
 
2557 
    #
2558 
    #   Generate Legend
2559 
    #
2560 
    {
2561 
        my @text;
2562 
        push @text, 'Legend';
2563 
        push @text, '|';
2564 
        push @text, 'Node Content';
2565 
        push @text, 'Package Version';
2566 
#        push @text, 'Release Manager Ref (pvid)';
2567 
        push @text, 'Creation Date: yyyy-mm-dd';
2568 
        push @text, '(Coded information)';
2569 
        push @text, '|{Code';
2570 
        push @text, '|{N: Not Locked';
2571 
        push @text, 'b: Bad Singleton';
396 dpurdie 2572 
        push @text, 'd: A dependency';
392 dpurdie 2573 
        push @text, 'B: Bad VCS Tag';
2574 
        push @text, 'D: DeadWood';
396 dpurdie 2575 
        push @text, 'e: Essential BOM Version';
2576 
        push @text, 'E: Essential Release Version';
392 dpurdie 2577 
        push @text, 'G: Glued into Version Tree';
2578 
        push @text, 'S: Splitpoint';
2579 
        push @text, 't: Glued into Project Tree';
2580 
        push @text, 'T: Tip version';
2581 
        push @text, 'V: In SVN';
2582 
        push @text, '+: In Subversion';
2583 
        push @text, '}}';
2584 
 
2585 
        push @text, '|';
2586 
        push @text, 'Outline';
2587 
        push @text, 'Red: Dead or Bad VCS Tag';
2588 
        push @text, 'Orange: Project Branch Root';
2589 
        push @text, 'Green: Ripple Build Version';
2590 
        push @text, 'Blue: Essential Version';
2591 
        push @text, 'Darkmagenta: Entry Glued into tree';
2592 
        push @text, 'Magenta: Entry added to project tree';
2593 
 
2594 
 
2595 
        push @text, '|';
2596 
        push @text, 'Fill';
2597 
        push @text, 'PowderBlue: Essential Version';
2598 
        push @text, 'Red: Bad Essential Version';
2599 
        push @text, 'Light Green: Migrated to SVN';
2600 
#        push @text, 'Red: Entry Glued into tree';
2601 
#        push @text, 'Green: Entry added to project tree';
2602 
 
2603 
        push @text, '|';
2604 
        push @text, 'Shape';
2605 
        push @text, 'Oval: Normal Package Version';
2606 
        push @text, 'Invhouse: Project Branch Root';
2607 
        push @text, 'Octagon: Branch Point';
2608 
        push @text, 'Box: Bad Single version with no history';
2609 
        push @text, 'Doublecircle: Tip of a Project Branch';
2610 
 
2611 
        push @text, '';
2612 
        my $text = join '\l', @text;
2613 
        $text =~ s~\|\\l~|~g;
2614 
        $text =~ s~\}\\l~}~g;
2615 
 
2616 
        my @attributes;
2617 
        push @attributes, "shape=record";
2618 
        push @attributes, "label=\"{$text}\"";
2619 
        push @attributes, "color=red";
2620 
        my $attr = join( ' ', @attributes);
2621 
 
2622 
        my $tld_done = 'LegendBlock';
2623 
        print FH "$tld_done [$attr]\n";
2624 
    }
2625 
 
2626 
#    print FH "\n}\n";
2627 
    print FH "TitleBlock -> LegendBlock [style=invis]\n";
2628 
 
2629 
    sub genLabelText
2630 
    {
2631 
        my ($entry) = @_;
2632 
        my @label;
2633 
        push @label, $versions{$entry}{name} if ( $multiPackages );
2634 
        push @label, $versions{$entry}{vname};
2635 
#        push @label, $entry;       # Add PVID
2636 
        push @label, substr( $versions{$entry}{created}, 0, 10); #  2008-02-19
2637 
#        push @label, 'V=' . $versions{$entry}{maxVersion};
2638 
#        push @label, 'B=' . $versions{$entry}{svnBranchTip} if ( exists $versions{$entry}{svnBranchTip} );
2639 
 
396 dpurdie 2640 
        my $reason = '';
2641 
        if (exists $versions{$entry}{Essential})
2642 
        {
2643 
            $reason = 'E';
2644 
            if (exists $versions{$entry}{Reason})
2645 
            {
2646 
                if ( $versions{$entry}{Reason} =~ m~bom~ )
2647 
                {
2648 
                    $reason = 'e';
2649 
                }
2650 
                if ( $versions{$entry}{Reason} =~ m~Depend~ )
2651 
                {
2652 
                    $reason .= 'd';
2653 
                }
2654 
            }
2655 
        }
392 dpurdie 2656 
 
2657 
        my $stateText = '';
2658 
        $stateText .= 'N' if ($versions{$entry}{locked} eq 'N');
2659 
        $stateText .= 'b' if (exists $versions{$entry}{badSingleton});
2660 
        $stateText .= 'B' if (exists $versions{$entry}{badVcsTag});
2661 
        $stateText .= 'G' if (exists $versions{$entry}{GluedIn});
2662 
        $stateText .= 't' if (exists $versions{$entry}{MakeTree});
396 dpurdie 2663 
#        $stateText .= 'E' if (exists $versions{$entry}{Essential});
2664 
        $stateText .= $reason if ( $reason );
392 dpurdie 2665 
        $stateText .= 'D' if (exists $versions{$entry}{DeadWood});
2666 
        $stateText .= 'S' if (exists $versions{$entry}{EssentialSplitPoint} && $versions{$entry}{EssentialSplitPoint} > 1 );
2667 
        $stateText .= 'T' if (exists $versions{$entry}{Tip} );
2668 
        $stateText .= 'V' if (exists $versions{$entry}{isSvn} );
2669 
        $stateText .= '+' if (exists $versions{$entry}{svnVersion} );
2670 
#        $stateText .= 's' if (exists $versions{$entry}{branchPoint} );
2671 
#        $stateText .= ' T='. $versions{$entry}{threadId} if (exists $versions{$entry}{threadId});
2672 
#        $stateText .= ' EssentalPath' if (exists $versions{$entry}{EssentialPath});
2673 
#        $stateText .= ' Count='. $versions{$entry}{EssentialSplitPoint} if (exists $versions{$entry}{EssentialSplitPoint});
2674 
#        $stateText .= ' M='. $versions{$entry}{maxVersion} if (exists $versions{$entry}{maxVersion});
2675 
 
2676 
        push @label, "(${stateText})" if ( $stateText );
2677 
 
2678 
        return join ('\n', @label );
2679 
    }
2680 
 
2681 
    sub genAttributes
2682 
    {
2683 
        my ($entry) = @_;
2684 
        my @attributes;
2685 
        push @attributes, 'label="' . genLabelText($entry) . '"';
2686 
        push @attributes, 'URL="' . dotUrl($entry) . '"';
2687 
        push @attributes, 'tooltip="' . "Goto: $versions{$entry}{vname}, PVID=$entry" ,'"';
2688 
        my $shape;
2689 
            $shape = 'box' if ($versions{$entry}{badSingleton});
2690 
            $shape = 'octagon'  if ($versions{$entry}{branchPoint});
2691 
            $shape = 'invhouse' if ($versions{$entry}{newSuffix});
2692 
            $shape = 'doublecircle' if ($versions{$entry}{Tip});
2693 
 
2694 
 
2695 
        push @attributes, 'shape=' . $shape if ( $shape );
2696 
 
2697 
        my $color;
2698 
        my $fill;
2699 
           $color = 'color=green style=bold' if ( $versions{$entry}{isaRipple} );
2700 
           $color = 'color=orange style=bold' if ( $versions{$entry}{newSuffix} );
2701 
           $color = 'color=red style=bold' if ( $versions{$entry}{DeadWood} || $versions{$entry}{badVcsTag} );
2702 
           $color = 'color=blue style=bold' if ( $versions{$entry}{Essential} );
2703 
           $color = 'color=darkmagenta style=bold' if ( $versions{$entry}{GluedIn} );
2704 
           $color = 'color=magenta style=bold' if ( $versions{$entry}{MakeTree} );
2705 
 
2706 
           $fill = 'style=filled fillcolor=powderblue' if ( $versions{$entry}{Essential} );
2707 
           $fill = 'style=filled fillcolor=red' if ( $versions{$entry}{Essential} && $versions{$entry}{badVcsTag} );
2708 
           $fill = 'style=filled fillcolor="#99FF99"' if ( exists $versions{$entry}{svnVersion} );
2709 
 
2710 
 
2711 
        push @attributes, $color if ( $color );
2712 
        push @attributes, $fill if ( $fill );
2713 
 
2714 
        return '[' . join( ' ', @attributes) . ']';
2715 
    }
2716 
 
2717 
    sub genArrowAttributes
2718 
    {
2719 
        my ($not_first, $entry) = @_;
2720 
        my @attributes;
2721 
 
2722 
        push @attributes, 'arrowhead=empty' if ( $not_first );
2723 
        push ( @attributes, 'label="' . $versions{$entry}{svnBranchTip} .'"' ) if ( exists $versions{$entry}{svnBranchTip} );
2724 
 
2725 
        return ('[' . join( ' ', @attributes) . ']') if ( @attributes ) ;
2726 
        return '';
2727 
    }
2728 
 
2729 
    #
2730 
    #   Flat
2731 
    #
2732 
    if ( $opt_flat )
2733 
    {
2734 
        my $last = 0;
2735 
        foreach my $entry (@flatOrder )
2736 
        {
2737 
            if ( $last )
2738 
            {
2739 
                my $me = dotTag($last);
2740 
 
2741 
                print FH pentry($me)  ,' -> ', pentry(dotTag($entry)), genArrowAttributes(0, $entry) ,";\n";
2742 
                print FH pentry($me)  ,genAttributes($last) . ";\n";
2743 
            }
2744 
            $last = $entry;
2745 
        }
2746 
        print FH pentry(dotTag($last))  ,genAttributes($last) . ";\n";
2747 
 
2748 
    }
2749 
    else
2750 
    {
2751 
        foreach my $entry ( sort {$a <=> $b} keys(%versions) )
2752 
        {
2753 
            my $me = dotTag($entry);
2754 
            my @versions = @{ $versions{$entry}{next}};
2755 
            my $ii = 0;
2756 
            foreach ( @versions )
2757 
            {
2758 
                print FH pentry($me)  ," -> ",pentry(dotTag($_)), genArrowAttributes($ii++, $_), ";\n";
2759 
            }
2760 
 
2761 
            print FH pentry($me)  ,genAttributes($entry) . ";\n";
2762 
        }
2763 
    }
2764 
 
2765 
    print FH "\n};\n";
2766 
    close FH;
2767 
 
2768 
    #
2769 
    #   Convert DOT to a SVG
2770 
    #
2771 
    unless ( $UNIX )
2772 
    {
2773 
    print "Generating graphical images\n";
2774 
#    system( "dot $filebase.dot -Tjpg -o$filebase.jpg" );  # -v
2775 
    system( "dot $filebase.dot -Tsvg -o$filebase.svg" );  # -v
2776 
#    unlink("$filebase.dot");
2777 
 
2778 
    #
2779 
    #   Display a list of terminal packages
2780 
    #   These are packages that are not used by any other package
2781 
    #
2782 
    print "\n";
2783 
#    print "Generated: $filebase.dot\n";
2784 
#    print "Generated: $filebase.jpg\n";
2785 
    print "Generated: $filebase.svg\n";
2786 
    }
2787 
    else
2788 
    {
2789 
        print "Generated: $filebase.dot\n";
2790 
    }
2791 
}
2792 
 
2793 
sub dotTag
2794 
{
2795 
    my ($entry) = @_;
2796 
 
2797 
    my $label = '';
2798 
    $label .= $versions{$entry}{name} if $multiPackages;
2799 
    $label .= $versions{$entry}{vname};
2800 
    $label =~ s~[-() ]~_~g;
2801 
    return $label;
2802 
}
2803 
 
2804 
sub dotUrl
2805 
{
2806 
    my ($entry) = @_;
2807 
 
2808 
    my $pv_base = $GBE_RM_URL . "/fixed_issues.asp?pv_id=$entry";
2809 
}
2810 
 
2811 
#-------------------------------------------------------------------------------
2812 
# Function        : pentry
2813 
#
2814 
# Description     : Generate an entry list as text
2815 
#                   Replace "." with "_" since DOT doesn't like .'s
2816 
#                   Seperate the arguments
2817 
#
2818 
# Inputs          : @_          - An array of entries to process
2819 
#
2820 
# Returns         : A string
2821 
#
2822 
sub pentry
2823 
{
2824 
    my ($data) = @_;
2825 
    $data =~ s~\.~_~g;
2826 
    $result = '"' . $data . '"' ;
2827 
    return $result;
2828 
}
2829 
 
2830 
#-------------------------------------------------------------------------------
2831 
# Function        : getVobMapping
2832 
#
2833 
# Description     : Read in Package to Repository Mapping
2834 
#
2835 
# Inputs          :
2836 
#
2837 
# Returns         : Populates %VobMapping
2838 
#                             Mapping of PackageName to RepoName[/Subdir]
2839 
#
2840 
our %ScmRepoMap;
2841 
sub getVobMapping
2842 
{
2843 
    Message ("Read in Vob Mapping");
2844 
 
2845 
    my $fname = 'cc2svn.repo.dat';
2846 
    Error "Cannot locate $fname" unless ( -f $fname );
2847 
    require $fname;
2848 
 
2849 
    Error "Data in $fname is not valid\n"
2850 
        unless ( keys(%ScmRepoMap) >= 0 );
2851 
 
2852 
    $opt_vobMap = $ScmRepoMap{$packageNames}{repo}
2853 
        if (exists $ScmRepoMap{$packageNames});
2854 
 
2855 
    #
2856 
    #   Free the memory
2857 
    #
2858 
    %ScmRepoMap = ();
2859 
 
2860 
    #
2861 
    #   Calculate Target Repo
2862 
    #
2863 
    Warning ("No VOB Mapping found")
2864 
        unless ($opt_vobMap);
2865 
    Error("No repository specified. ie -repo=DevTools or -repo=COTS")
2866 
        unless ( $opt_repo || $opt_vobMap );
2867 
 
2868 
    my $r1 = ($opt_repo || '') . '/' . ($opt_vobMap || '');
2869 
    $r1 =~ s~^/~~;
2870 
    $r1 =~ s~/$~~;
2871 
    $svnRepo = $opt_repo_base . $r1;
2872 
 
2873 
    Verbose( "Repo URL: $svnRepo");
2874 
}
2875 
 
2876 
 
2877 
#-------------------------------------------------------------------------------
2878 
# Function        : getEssenialPackageVersions
2879 
#
2880 
# Description     : Determine the 'Essental' Package Versions
2881 
#                   Read the data in from an external file
2882 
#
2883 
# Inputs          :
2884 
#
2885 
# Returns         : Populates @EssentialPackages
2886 
#
2887 
 
2888 
our %ScmReleases;
2889 
our %ScmPackages;
2890 
our %ScmSuffixes;
2891 
sub getEssenialPackageVersions
2892 
{
2893 
    Message ("Read in Essential Package Versions");
2894 
 
2895 
    my $fname = 'cc2svn.raw.txt';
2896 
    Error "Cannot locate $fname" unless ( -f $fname );
2897 
    require $fname;
2898 
 
2899 
    Error "Data in $fname is not valid\n"
2900 
        unless ( keys(%ScmReleases) >= 0 );
2901 
 
2902 
#    DebugDumpData("ScmReleases", \%ScmReleases );
2903 
#    DebugDumpData("ScmPackages", \%ScmPackages );
2904 
#    DebugDumpData("ScmSuffixes", \%ScmSuffixes );
2905 
 
2906 
    #
2907 
    #   Create a list of essential packages
2908 
    #   Retain packages-versions used in this program
2909 
    #
2910 
    foreach ( keys %ScmPackages )
2911 
    {
2912 
        next unless ( exists  $pkg_ids{ $ScmPackages{$_}{pkgid} } );
2913 
        push @EssentialPackages, $_;
2914 
        Error ("Essential Package Version not in extracted Release Manager Data: $_")
2915 
            unless ( exists $versions{$_} );
2916 
        $versions{$_}{Essential} = 1;
396 dpurdie 2917 
        $versions{$_}{Reason} = $ScmPackages{$_}{Reason};
2918 
#print "ESSENTIAL: $versions{$_}{name} $versions{$_}{vname} $versions{$_}{Reason}\n";
392 dpurdie 2919 
    }
2920 
 
2921 
    #
2922 
    #   Free memory
2923 
    #
2924 
    %ScmReleases = ();
2925 
    %ScmPackages = ();
2926 
    %ScmSuffixes = ();
2927 
 
2928 
#    DebugDumpData("Essential", \@EssentialPackages );
2929 
    Message ("Essential Versions: " . scalar @EssentialPackages );
2930 
}
2931 
 
2932 
#-------------------------------------------------------------------------------
2933 
# Function        : ReportPathVariance
2934 
#
2935 
# Description     : Report variance in paths used by the versions
2936 
#
2937 
# Inputs          :
2938 
#
2939 
# Returns         :
2940 
#
2941 
my %VobPaths;
2942 
sub ReportPathVariance
2943 
{
2944 
    Message ("Detect Multiple Paths");
2945 
    foreach my $entry ( keys(%versions) )
2946 
    {
2947 
        my $e = $versions{$entry};
2948 
        next if ( isSet ($e, 'DeadWood' ) );
2949 
        next if ( isSet ($e, 'badVcsTag') );
2950 
        next if ( isSet ($e, 'isSvn') );
2951 
        my $tag = $e->{vcsTag};
2952 
        next unless ( $tag );
2953 
 
2954 
        $tag =~ m~^(.+?)::(.*?)(::(.+))?$~;
2955 
        my $vcsType = $1;
2956 
        my $cc_label = $4;
2957 
        my $cc_path = $2;
2958 
        $cc_path = '/' . $cc_path;
2959 
        $cc_path =~ tr~\\/~/~s;
2960 
 
2961 
        $VobPaths{$cc_path}++;
2962 
    }
2963 
 
2964 
    @multiplePaths = sort keys %VobPaths;
2965 
    if ( scalar @multiplePaths > 1 )
2966 
    {
2967 
        Warning ("Multiple Paths:" . $_ ) foreach (@multiplePaths);
2968 
    }
2969 
}
2970 
 
2971 
sub isSet
2972 
{
2973 
    my ($base, $element) = @_;
2974 
    return 0 unless ( exists $base->{$element} );
2975 
    return $base->{$element};
2976 
}
2977 
 
2978 
 
2979 
#-------------------------------------------------------------------------------
2980 
# Function        : recurseList
2981 
#
2982 
# Description     : Return a list of all element below a given head element
2983 
#
2984 
# Inputs          : $head               - Head element
2985 
#
2986 
# Returns         : A list, not in any particular order
2987 
#
2988 
 
2989 
our @recurseList;
2990 
sub recurseList
2991 
{
2992 
    @recurseList = ();
2993 
    recurseListBody (@_);
2994 
    return @recurseList;
2995 
}
2996 
sub recurseListBody
2997 
{
2998 
    foreach my $entry ( @_ )
2999 
    {
3000 
        push @recurseList, $entry;
3001 
no warnings "recursion";
3002 
        recurseListBody (@{$versions{$entry}{next}});
3003 
    }
3004 
}
3005 
 
3006 
#-------------------------------------------------------------------------------
3007 
# Function        : getSvnData
3008 
#
3009 
# Description     : Read the SVN tree and see what we have
3010 
#
3011 
# Inputs          :
3012 
#
3013 
# Returns         :
3014 
#
3015 
my @svnDataItems;
3016 
sub getSvnData
3017 
{
3018 
    Message ("Examine Subversion Tree");
3019 
 
3020 
    #
3021 
    #   Re-init data
3022 
    #
3023 
    @svnDataItems = ();
3024 
    %svnData = ();
3025 
 
3026 
    #
3027 
    #   Create an SVN session
3028 
    #
3029 
    return unless ( $svnRepo );
3030 
    my $svn = NewSessionByUrl ( "$svnRepo/$packageNames" );
3031 
    return unless ( $svn );
3032 
 
3033 
    #
3034 
    #   extract data
3035 
    #
3036 
#    DebugDumpData("SVN", $svn );
3037 
    $svn->SvnCmd ( 'log', '-v', '--xml', '--stop-on-copy', $svn->Full()
3038 
                    , { 'credentials' => 1,
3039 
                        'process' => \&ProcessSvnLog,
3040 
                         }
3041 
                        );
3042 
 
3043 
    #
3044 
    #   Process data
3045 
    foreach my $entry ( @svnDataItems )
3046 
    {
3047 
        my $name;
3048 
        my $isaBranch;
3049 
        my $target = $entry->{target};
3050 
        if ( $target =~ m~/tags/(.*)~ ) {
3051 
            $name = $1;
3052 
            $svnData{tags}{$name} = 1;
3053 
        } elsif ( $target =~ m~/branches/(.*)~ )  {
3054 
            $name = $1;
3055 
    #        $branches{$1} = 1;
3056 
        } else {
3057 
            $svnData{nonTag}{$target} = 1;
3058 
        }
3059 
 
3060 
        my $fromBranch;
3061 
        if ( $entry->{fromPath} =~ m~/trunk$~  ) {
3062 
            $fromBranch = 'trunk';
3063 
        } elsif ( $entry->{fromPath} =~ m~/branches/(.*)~ ) {
3064 
            $fromBranch = $1;
3065 
        }
3066 
 
3067 
        if ( defined($fromBranch) && ! exists $svnData{branches}{$fromBranch} )
3068 
        {
3069 
            unless ( $name eq $fromBranch )
3070 
            {
3071 
                $svnData{branches}{$fromBranch} = $name;
3072 
                $svnData{tips}{$name} = $fromBranch;
3073 
            }
3074 
        }
3075 
    }
3076 
#    DebugDumpData("SvnData", \%svnData);
3077 
 
3078 
    foreach my $entry ( keys(%versions) )
3079 
    {
3080 
        my $import_label = saneLabel($entry);
3081 
        delete $versions{$entry}{svnVersion};
3082 
        delete $versions{$entry}{svnBranchTip};
3083 
 
3084 
        if ( exists $svnData{tags}{$import_label} )
3085 
        {
3086 
            $versions{$entry}{svnVersion} = 1;
3087 
        }
3088 
 
3089 
        if ( exists $svnData{tips}{$import_label} )
3090 
        {
3091 
            $versions{$entry}{svnBranchTip} = $svnData{tips}{$import_label};
3092 
        }
3093 
    }
3094 
 
3095 
    Message ( 'Trunk used: ' . (exists $svnData{branches}{trunk} ? 'Yes' : 'No') );
3096 
    Message ( 'Labels    : ' . scalar keys %{$svnData{tags}} );
3097 
    Message ( 'Branches  : ' . scalar keys %{$svnData{branches}} );
3098 
}
3099 
 
3100 
#-------------------------------------------------------------------------------
3101 
# Function        : ProcessSvnLog
3102 
#
3103 
# Description     :
3104 
#                   Parse
3105 
#                       <logentry
3106 
#                          revision="24272">
3107 
#                       <author>bivey</author>
3108 
#                       <date>2005-07-25T15:45:35.000000Z</date>
3109 
#                       <paths>
3110 
#                       <path
3111 
#                          prop-mods="false"
3112 
#                          text-mods="false"
3113 
#                          kind="dir"
3114 
#                          copyfrom-path="/enqdef/branches/Stockholm"
3115 
#                          copyfrom-rev="24271"
3116 
#                          action="A">/enqdef/tags/enqdef_24.0.1.sls</path>
3117 
#                       </paths>
3118 
#                       <msg>COTS/enqdef: Tagged by Jats Svn Import</msg>
3119 
#                       </logentry>
3120 
#
3121 
# Inputs          :
3122 
#
3123 
# Returns         :
3124 
#
3125 
my $entryData;
3126 
sub  ProcessSvnLog
3127 
{
3128 
    my ($self, $line ) = @_;
3129 
#print "----- $line\n";
3130 
    if ( $line =~ m~^<logentry~ ) {
3131 
        $entryData = ();
3132 
 
3133 
    } elsif ( $line =~ m~^\s+revision="(\d+)"~ ) {
3134 
        $entryData->{Rev} = $1;
3135 
 
3136 
    } elsif ( $line =~ m~^\s+copyfrom-path="(.*)"~ ) {
3137 
        $entryData->{fromPath} = $1;
3138 
 
3139 
    } elsif ( $line =~ m~^\s+copyfrom-rev="(\d+)"~ ) {
3140 
        $entryData->{fromRev} = $1;
3141 
 
3142 
    } elsif ( $line =~ m~\s+action=.*?>(.*)</path~ ) {
3143 
        $entryData->{target} = $1;
3144 
 
3145 
    } elsif ( $line =~ m~</logentry~ ) {
3146 
        if ( exists $entryData->{fromPath} )
3147 
        {
3148 
#            DebugDumpData("Data", $entryData);
3149 
            push @svnDataItems, $entryData;
3150 
        }
3151 
    }
3152 
 
3153 
    #
3154 
    #   Return 0 to keep on going
3155 
    return 0;
3156 
}
3157 
 
3158 
 
3159 
 
3160 
#-------------------------------------------------------------------------------
3161 
# Function        : saveData
3162 
#
3163 
# Description     : Save essential data
3164 
#
3165 
# Inputs          :
3166 
#
3167 
# Returns         :
3168 
#
3169 
sub saveData
3170 
{
3171 
    my $file = $cwd . "/${packageNames}.data";
3172 
 
3173 
    Message ("Create: $file");
3174 
    my $fh = ConfigurationFile::New( $file );
3175 
 
3176 
    $fh->DumpData(
3177 
        "\n# ScmVersions.\n#\n",
3178 
        "ScmVersions", \%versions );
3179 
 
3180 
    #
3181 
    #   Close out the file
3182 
    #
3183 
    $fh->Close();
3184 
}
3185 
 
3186 
 
3187 
#-------------------------------------------------------------------------------
3188 
#   Documentation
3189 
#
3190 
 
3191 
=pod
3192 
 
3193 
=for htmltoc    SYSUTIL::cc2svn::
3194 
 
3195 
=head1 NAME
3196 
 
3197 
cc2svn_gendata - CC2SVN tool to import an entire package into SVN
3198 
 
3199 
=head1 SYNOPSIS
3200 
 
3201 
  jats cc2svn_importpackage [options] package_name
3202 
 
3203 
 Options:
3204 
    -help              - brief help message
3205 
    -help -help        - Detailed help message
3206 
    -man               - Full documentation
3207 
    -repository=name   - Specify target repository
3208 
    -[no]flat          - Do not create project tree. Def: -noflat
3209 
    -prunemode=mode    - Mode: none, ripple, retain, severe, Def=ripple
3210 
    -retain=N          - Specify retain count for pruning. Def=2
3211 
    -[no]test          - Do not create packages. Def:-notest
3212 
    -[no]reuse         - Keep and reuse ClearCase views
3213 
    -age=nnDays        - Only keep recent package
3214 
    -dump[=n]          - Dump raw data. N=0,1,2
3215 
    -images[=n]        - Create SVG of version tree. N=0,1,2
3216 
    -name=aaa          - Alternate output package name. Test Only
3217 
    -[no]log           - Write output to log file. Def: -nolog
3218 
    -[no]postimage     - Create image after transger: Def: -post
3219 
    -workdir=path      - Use for temp storage (def:/work)
3220 
 
3221 
=head1 OPTIONS
3222 
 
3223 
=over 8
3224 
 
3225 
=item B<-help>
3226 
 
3227 
Print a brief help message and exits.
3228 
 
3229 
=item B<-help -help>
3230 
 
3231 
Print a detailed help message with an explanation for each option.
3232 
 
3233 
=item B<-man>
3234 
 
3235 
Prints the manual page and exits.
3236 
 
3237 
=item B<-prunemode=mode>
3238 
 
3239 
This option control the manner in which excess versions will be pruned. Valid
3240 
modes are:
3241 
 
3242 
=over 8
3243 
 
3244 
=item   none
3245 
 
3246 
No pruning will be performed
3247 
 
3248 
=item   ripple
3249 
 
3250 
Non-Essential packages that are ripple builds will be removed.
3251 
 
3252 
=item   retain
3253 
 
3254 
Versions that preceed an Essential version will be retained.
3255 
 
3256 
=item   severe
3257 
 
3258 
Only Essential Versions, and Branching points will be retained.
3259 
 
3260 
=back
3261 
 
3262 
=back
3263 
 
3264 
=head1 DESCRIPTION
3265 
 
3266 
This program is a tool used in the conversion of ClearCase VOBS to subversion.
3267 
It will take a complete package and all relevent versions from ClearCase and
3268 
insert them into subversion in a sessible manner. It will attempt to retain
3269 
file change order and history.
3270 
 
3271 
It will:
3272 
 
3273 
=over 8
3274 
 
3275 
=item *
3276 
 
3277 
Read in the Essential Package Version list.
3278 
 
3279 
=item *
3280 
 
3281 
Extract, from Release Manager, all known versions of the specified package.
3282 
 
3283 
=item *
3284 
 
3285 
It will attempt to determine the type of package: COTS, TOOL, CORE, PROJECT
3286 
and alter the processing accordingly.
3287 
 
3288 
=item *
3289 
 
3290 
It will create a version dependency tree and determine 'new' project branch
3291 
points. It will remove (prune) versions that are excess to requirements.
3292 
 
3293 
=item *
3294 
 
3295 
It will extract source from ClearCase and insert it into SVN, creating
3296 
branches and tags as it goes.
3297 
 
3298 
=back
3299 
 
3300 
The program can also be used to create a SVG image of the version dependency
3301 
tree. This does not work on Linux; only Windows with 'dot' installed.
3302 
 
3303 
=cut
3304