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