Subversion Repositories DevTools

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
1271 dpurdie 1 
########################################################################
2 
# Copyright (C) 1998-2012 Vix Technology, All rights reserved
3 
#
4 
# Module name   : cc2svn_importpackage3.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 
use JatsLocateFiles;
2439 dpurdie 36 
use Encode;
1271 dpurdie 37 
 
38 
 
39 
#use Data::Dumper;
40 
use Fcntl ':flock'; # import LOCK_* constants
41 
use Cwd;
42 
use DBI;
43 
use Getopt::Long;
44 
use Pod::Usage;                             # required for help support
2429 dpurdie 45 
use Encode;
1271 dpurdie 46 
 
47 
#
48 
#   Options
49 
#
50 
my $opt_help = 0;
51 
my $opt_manual = 0;
52 
my $opt_verbose = 0;
53 
my $opt_repo_base = 'AUPERASVN01/';
54 
my $opt_repo = '';
2439 dpurdie 55 
my $opt_repoSubdir = '';
1271 dpurdie 56 
my $opt_flat;
57 
my $opt_test;
58 
my $opt_reuse;
59 
my $opt_age;
60 
my $opt_dump = 0;
61 
my $opt_images = 0;
62 
my $opt_retaincount = 2;
63 
my $opt_pruneModeString;
64 
my $opt_listTags;
65 
my $opt_name;
66 
my $opt_log = 0;
67 
my @opt_tip;
68 
my $opt_postimage = 1;
69 
my $opt_workDir = '/work';
70 
my $opt_vobMap;
71 
my $opt_fileList;
72 
my $opt_preserveProjectBase;
73 
my $opt_ignoreProjectBaseErrors;
74 
my $opt_resume;
2439 dpurdie 75 
my $opt_ignoreMakeProjectErrors;
1272 dpurdie 76 
my $opt_delete;
2429 dpurdie 77 
my $opt_recentAge = 14;             # Days
78 
my $opt_relabel = 1;
1271 dpurdie 79 
 
80 
################################################################################
81 
#   List of Projects Suffixes and Branch Names to be used within SVN
82 
#
83 
#       Name        - Name of branch for the project
84 
#       Trunk       - Can be a trunk project
85 
#                     First one seen will be placed on the trunk
86 
#                     Others will create project branches
87 
#
88 
my $ProjectTrunk;
89 
my %ProjectsBaseCreated;
90 
my %Projects = (
91 
    '.sea'      => { Name => 'Seattle' },
92 
    '.coct'     => { Name => 'CapeTown' },
93 
    '.sls'      => { Name => 'Stockholm' },
94 
    '.syd'      => { Name => 'Sydney' },
95 
    '.vtk'      => { Name => 'Vasttrafik' },
96 
    '.bei'      => { Name => 'Beijing' },
97 
    '.bkk'      => { Name => 'Bangkok' },
98 
    '.ndl'      => { Name => 'NewDelhi' },
99 
    '.nzs'      => { Name => 'NewZealandStageCoach' },
100 
    '.wdc'      => { Name => 'Washington' },
101 
    '.oso'      => { Name => 'Oslo' },
102 
    '.lvs'      => { Name => 'LasVegas' },
103 
    '.mlc'      => { Name => 'BeijingMlc' },
104 
    '.sfo'      => { Name => 'SanFrancisco' },
105 
    '.sg'       => { Name => 'Singapore' },
106 
    '.gmp'      => { Name => 'GmpteProject' },
107 
    '.ssw'      => { Name => 'UkStageCoach' },
108 
    '.uk'       => { Name => 'UkProject' },
109 
    '.pmb'      => { Name => 'Pietermaritzburg' },
110 
    '.vps'      => { Name => 'VixPayments' },
111 
    '.ncc'      => { Name => 'NSWClubCard' },
112 
    '.rm'       => { Name => 'Rome' },
2429 dpurdie 113 
    '.vss'      => { Name => 'SmartSite' },
1271 dpurdie 114 
    'unknown'   => { Name => 'UnknownProject' },
115 
 
116 
    '.ebr'      => { Name => 'eBrio' , Trunk => 1 },
117 
    '.mas'      => { Name => 'Mass'  , Trunk => 1 },
118 
    '.cr'       => { Name => 'Core'  , Trunk => 1 },
119 
    '.cots'     => { Name => 'Cots'  , Trunk => 1 },
120 
    '.tool'     => { Name => 'Tools' , Trunk => 1 },
121 
);
122 
 
123 
my %suffixFixup = (
124 
    '.sf'           => '.sfo',
125 
    '.vt'           => '.vtk',
126 
    '.lv'           => '.lvs',
127 
    '.was'          => '.wdc',
128 
    '.uk.1'         => '.uk',
129 
    '.ssts.demo'    => '.ssts',
130 
    '.u244.syd'     => '.syd',
131 
    '.pxxx.sea'     => '.sea',
132 
    '.pxxx.syd'     => '.syd',
133 
    '.pxxx.sydddd'  => '.syd',
134 
    '.oslo'         => '.oso',
135 
    '.osl'          => '.oso',
136 
);
137 
 
2429 dpurdie 138 
my @excludeFromImport = (
139 
 
140 
    # 22-Oct-12: Excluded on request from Kasun Sirikumara
141 
    # Pending VSS work
142 
    'agency_website',
143 
    'alx',
144 
    'alx-api',
145 
    'cardholder_website',
146 
    'loginmodule-ad',
147 
    'ols-enquiry',
148 
    'ols-enquiry-api',
149 
    'olsrpc4j',
150 
    'orca-middleware',
151 
    'orca-middleware-api',
152 
    'orca-salesEngine',
153 
    'orca-web-api',
154 
    'orca-web-utils',
155 
    'TestPaymentGateway',
156 
    'tgen4j',
157 
    'web-cd-client',
2439 dpurdie 158 
 
159 
 
160 
    # 05-Nov-12: Pending fixup for include.txt files that escape the VOB
161 
    #
162 
#    'ddu_app_manager',
163 
#    'ddu_dog',
164 
#    'ddu_dog_lib',
165 
#    'ddu_fim',
166 
#    'ddu_logging_lib',
167 
#    'ddu_management',
168 
#    'ddu_mccain',
169 
#    'ddu_mon',
170 
#    'ddu_rcu',
171 
#    'ddu_status_logging',
172 
 
2429 dpurdie 173 
);
174 
 
1271 dpurdie 175 
my %specialPackages = (
2429 dpurdie 176 
    'core_devl'           =>  ',all,protected,',
177 
    'daf_utils_mos'       => ',flat,',
178 
    'mos_packager'        => ',all,',
179 
    'cfmgr-cfmgr'         => ',flat,',
180 
    'daf_utils_button_st' => ',flat,',
181 
    'ReleaseName'         => ',flat,',
182 
    'reports'             => ',utf8,',
183 
    'cda_imports'         => ',utf8,',
184 
    'cdxforms'            => ',utf8,',
185 
    'db_cda'              => ',utf8,',
2450 dpurdie 186 
    'Dataman'             => ',utf8,',
2439 dpurdie 187 
    'CommandServer'       => ',IgnoreMakeProject,',
188 
    'TDSExporterControl'  => ',IgnoreMakeProject,',
189 
    'cdagui'              => ',IgnoreMakeProject,',
1271 dpurdie 190 
 
2429 dpurdie 191 
 
1271 dpurdie 192 
    # Need to be handled in a special manner
193 
    # Not done by this utility
194 
    #
195 
    'linux_drivers_eb5600'  => ',protected,',
196 
    'linux_drivers_viper'   => ',protected,',
197 
    'linux_drivers_cobra'   => ',protected,',
198 
    'linux_drivers_bcp4600' => ',protected,',
199 
    'linux_drivers_etx86'   => ',protected,',
200 
    'linux_drivers_tp5600'  => ',protected,',
201 
 
2429 dpurdie 202 
# Not in the ukHops migration at the moment
203 
    'cs'                        => ',protected,',
204 
 
205 
    'DBA-Common'                => ',protected,',
206 
    'DBA-DatabaseInstall'       => ',protected,',
207 
    'DBA-ExternalPerlModules'   => ',protected,',
208 
    'DBA-OraUserBuild'          => ',protected,',
209 
    'DBA-OST'                   => ',protected,',
210 
    'orahops-install'           => ',protected,',
211 
    'orahops-patch'             => ',protected,',
212 
    'orahops-ssw-install'       => ',protected,',
213 
    'orahops-ssw-patch'         => ',protected,',
214 
# End of ukHops migration exclussion
215 
 
1271 dpurdie 216 
    'ftp'                   => 'SetProjectBase,',
2439 dpurdie 217 
    'ddu_app_manager'       => 'SetProjectBase,',
1271 dpurdie 218 
 
219 
    'icl'                   => 'IgnoreProjectBase,',
220 
    'itso'                  => 'IgnoreProjectBase,',
221 
    'daf_osa_mos'           => 'IgnoreProjectBase,',
222 
    'daf_utils_mos'         => 'IgnoreProjectBase,',
223 
    'itso_ud'               => 'IgnoreProjectBase,',
224 
#    'mos_api'               => 'IgnoreProjectBase,',
225 
#    'mos_fonts'             => 'IgnoreProjectBase,',
226 
#    'sntp'                  => 'IgnoreProjectBase,',
227 
#    'time_it'               => 'IgnoreProjectBase,',
228 
);
229 
 
230 
my %notCots = (
231 
    'isl'       => 1,
232 
);
233 
 
2429 dpurdie 234 
my $ukHopsMode = 0;
235 
my %ukHopsReleases = (
236 
    '6222'      => { name => 'MainLine', 'trunk' => 1 },
237 
    '14503'     => { name => 'Hops3' },
238 
    '21864'     => { name => 'Hops3.6' },
239 
    '22303'     => { name => 'Hops3.7' },
240 
    '17223'     => { name => 'Hops4' },
241 
);
242 
 
243 
# The following packages will have the version in the specified release forced to be on the trunk
244 
# A trunk will be forced and the version will be on it.
245 
#   May only work if the version in the release is also a TIP
246 
my %ukHopsTip = (
247 
    'ItsoMessaging'         => '6222',
248 
    'MessageProcessor'      => '6222',
249 
    'StrongNameKey'         => '6222',
250 
);
251 
 
1271 dpurdie 252 
################################################################################
253 
#   Global data
254 
#
255 
my $VERSION = "1.0.0";
256 
my $RM_DB;
257 
my $last_pv_id;
258 
my %pkg_ids;
259 
my $first_pkg_id;
260 
my %versions;
261 
my %suffixes;
262 
my @processOrder;
263 
my @startPoints;
264 
my @allStartPoints;
265 
my @endPoints;
266 
my $now = time();
267 
my $logSummary;
268 
my $firstVersionCreated;
269 
my @EssentialPackages;
270 
my $createBranch;
271 
my $createSuffix;
272 
my $currentBranchName;
273 
my $singleProject;
274 
my $pruneCount = 0;
275 
my $trimCount = 0;
276 
my $badVcsCount = 0;
277 
my $ProjectCount = 0;
278 
my $totalVersions = 0;
279 
my $initialTrees = 0;
280 
my $globalError;
281 
my @unknownProjects;
282 
my %knownProjects;
283 
my $badSingletonCount = 0;
284 
my @flatOrder;
285 
my $pruneMode;
286 
my $pruneModeString;
287 
my $threadId = 0;
288 
my $threadCount;
289 
my %tipVersions;
290 
my $allSvn;
291 
my @multiplePaths;
292 
my @badEssentials;
293 
my %svnData;
294 
my $cwd;
2429 dpurdie 295 
my $mustConvertFileNames;
2439 dpurdie 296 
my $workDir;
1271 dpurdie 297 
 
298 
my $packageNames;
299 
my @packageNames;
300 
my $multiPackages = -1;
301 
my $visitId = 0;
302 
my $noTransfer;
303 
my $rippleCount = 0;
304 
my $svnRepo;
1272 dpurdie 305 
my $processCount = 0;
306 
my $processTotal = 0;
2429 dpurdie 307 
my $recentCount = 0;
308 
my $packageReLabelCount = 0;
309 
my %saneLabels;
1271 dpurdie 310 
 
311 
our $GBE_RM_URL;
312 
my $UNIX = $ENV{'GBE_UNIX'};
313 
 
314 
my $result = GetOptions (
315 
                "help+"         => \$opt_help,          # flag, multiple use allowed
316 
                "manual:3"      => \$opt_help,
317 
                "verbose:+"     => \$opt_verbose,       # Versose
318 
                "repository:s"  => \$opt_repo,          # Name of repository
2439 dpurdie 319 
                'subdir:s'      => \$opt_repoSubdir,    # Subdir within repo
2429 dpurdie 320 
                'rbase:s'       => \$opt_repo_base,     # Base of the repo
1271 dpurdie 321 
                "flat!"         => \$opt_flat,          # Flat structure
322 
                "test!"         => \$opt_test,          # Test operations
323 
                "reuse!"        => \$opt_reuse,         # Reuse ClearCase views
324 
                "age:i"         => \$opt_age,           # Only recent versions
325 
                "dump:1"        => \$opt_dump,          # Dump Data
326 
                "images:1"      => \$opt_images,        # Create DOT images
327 
                "retain:i"      => \$opt_retaincount,   # Retain N packages
328 
                "pruneMode:s"   => \$opt_pruneModeString,
329 
                "listtags:i"    => \$opt_listTags,
330 
                "name:s"        => \$opt_name,          # Alternate output
331 
                "tip:s"         => \@opt_tip,           # Force tip version(s)
332 
                "log!"          => \$opt_log,
1272 dpurdie 333 
                "delete!"       => \$opt_delete,
1271 dpurdie 334 
                "postimage!"    => \$opt_postimage,
335 
                'workdir:s'     => \$opt_workDir,
336 
                'filelist:s'    => \$opt_fileList,      # A list of CC tags
337 
                'resume:s'      => \$opt_resume,
2429 dpurdie 338 
                'relabel!'      => \$opt_relabel,
1271 dpurdie 339 
                );
340 
 
341 
#
342 
#   Process help and manual options
343 
#
344 
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
345 
pod2usage(-verbose => 1)  if ($opt_help == 2 );
346 
pod2usage(-verbose => 2)  if ($opt_manual || ($opt_help > 2));
347 
 
348 
#
349 
#   Configure the error reporting process now that we have the user options
350 
#
351 
SystemConfig ('ExitOnError' => 1);
352 
ErrorConfig( 'name'    =>'CC2SVN_IMPORT',
353 
             'verbose' => $opt_verbose,
354 
              );
355 
 
356 
Error("Workdir does not exist" ) unless ( -d $opt_workDir );
357 
Error("Specify a package as 'name'" ) unless ( defined $ARGV[0] );
358 
EnvImport('GBE_RM_URL');
359 
$cwd = Getcwd();
360 
 
361 
#
362 
#   Init the pruning mode
363 
#
364 
setPruneMode( $opt_pruneModeString || 'ripple');
365 
 
366 
if ( $opt_fileList )
367 
{
368 
    GetData_by_filelist( $opt_fileList );
369 
    push @packageNames, $ARGV[0];
370 
    $multiPackages++;
371 
 
372 
}
373 
else
374 
{
375 
    #
376 
    #   Get data for all packages
377 
    #
378 
    foreach my $packageName ( @ARGV )
379 
    {
380 
        next unless ( $packageName );
381 
        Verbose( "Base Package: $packageName");
382 
 
383 
        my $pkg_id = GetPkgIdByName ( $packageName );
384 
        GetData_by_pkg_id ( $pkg_id, $packageName  );
385 
        $pkg_ids{$pkg_id} = 1;
386 
        $first_pkg_id = $pkg_id unless ( $first_pkg_id );
387 
        push @packageNames, $packageName;
388 
        $multiPackages++;
389 
    }
390 
 
391 
    {
392 
        #
393 
        #   Delete entries that have been created as we read in
394 
        #   data, but don't exist in RM. They will not have a pvid.
395 
        #
396 
        foreach my $entry ( keys(%versions) )
397 
        {
398 
            delete $versions{$entry}
399 
                unless ( exists $versions{$entry}{pvid} );
400 
        }
401 
    }
402 
}
403 
 
404 
$totalVersions = scalar keys %versions;
405 
Error ("No packages specified") unless ( $multiPackages >= 0 );
406 
Warning ("Multiple Packages being processed") if ( $multiPackages > 1 );
407 
$packageNames = join ('_', @packageNames );
408 
$packageNames = $opt_name if ( defined $opt_name );
409 
Message ("PackageName: $packageNames" );
410 
 
411 
#
412 
#   Save logging data
413 
#
414 
if ( $opt_log )
415 
{
416 
    my $opt_logfile = $packageNames . '.import';
417 
    Message ("Logging outout: $opt_logfile" );
418 
    open STDOUT, '>', $opt_logfile  or die "Can't redirect STDOUT: $!";
419 
    open STDERR, ">&STDOUT"         or die "Can't dup STDOUT: $!";
420 
}
421 
 
422 
#
423 
#   Prepare tip version hash
424 
#
425 
$tipVersions{$_} = 1 foreach ( @opt_tip );
426 
 
427 
#
428 
#   Read in external data and massage it all
429 
#
430 
getEssenialPackageVersions() unless $opt_fileList;
431 
getVobMapping();
432 
smartPackageType();                 # Determine special prune mode
433 
ReportPathVariance();
434 
massageData();
435 
getSvnData();
436 
smartPackageType();                 # Have another go
437 
 
438 
my @missedTips = keys %tipVersions;
439 
Error ("Specified tip version not found: @missedTips") if ( @missedTips );
440 
 
441 
if ( $opt_flat )
442 
{
443 
#    @flatOrder = sort {$versions{$a}{version} cmp $versions{$b}{version}} keys(%versions);
444 
#    @flatOrder = sort {$versions{$a}{created} cmp $versions{$b}{created}} keys(%versions);
445 
    @flatOrder = sort {$a <=> $b} keys(%versions);
446 
    my $tip = $flatOrder[-1];
447 
    $versions{$tip}{Tip} = 1 if $tip;
448 
}
449 
 
450 
#
451 
#   Generate dumps and images
452 
#
453 
if ( $opt_images )
454 
{
455 
    createImages();
456 
}
457 
 
458 
if ( $opt_dump )
459 
{
460 
    DebugDumpData ("Versions", \%versions );
461 
    DebugDumpData ("Starts", \@startPoints );
462 
    DebugDumpData ("Ends", \@endPoints );
463 
    DebugDumpData ("Suffixes", \%suffixes );
464 
}
465 
 
466 
 
467 
#   Display VCS tags
468 
#
469 
if ( $opt_listTags )
470 
{
471 
    foreach my $entry (sort {$versions{$a}{version} cmp $versions{$b}{version}} keys(%versions) )
472 
    {
473 
        print $versions{$entry}{vcsTag} || '-' ,"\n";
474 
    }
475 
}
476 
exit if ( ($opt_dump > 1) || ($opt_images > 1) );
477 
 
478 
transferPackageToSvn();
479 
 
480 
if ( $opt_postimage )
481 
{
482 
    getSvnData();
483 
    createImages();
484 
}
485 
 
486 
exit 0;
487 
 
488 
#-------------------------------------------------------------------------------
489 
# Function        : transferPackageToSvn
490 
#
491 
# Description     : Transfer the package to SVN
492 
#
493 
# Inputs          :
494 
#
495 
# Returns         :
496 
#
497 
sub transferPackageToSvn
498 
{
499 
    Error ("Repository Path not setup")
500 
        unless ( $svnRepo );
501 
 
502 
    #
503 
    #   Going to do serious work
504 
    #   Need to ensure we have more arguments
505 
    #
506 
    if ( $noTransfer )
507 
    {
508 
        Warning("Protected Package not transferred: $packageNames[0]");
509 
        exit 0;
510 
    }
511 
 
512 
    #
513 
    #   Perform all the work in a package specific subdirectory
514 
    #
2439 dpurdie 515 
    $workDir = $opt_workDir . '/' . $packageNames;
1271 dpurdie 516 
    mkdir $workDir unless ( -d $workDir );
517 
    chdir $workDir || Error ("Cannot cd to $workDir");
518 
 
519 
    #
520 
    #   Process all packages
521 
    #       Going to create versions based on RM structure
522 
    #       May have several starting points: Process each
523 
    #
524 
    newPackage();
525 
    if ( $opt_flat )
526 
    {
527 
        newProject();
528 
        foreach my $entry (@flatOrder )
529 
        {
530 
            newPackageVersion( $entry, $versions{$entry}{suffix} );
531 
        }
532 
    }
533 
    else
534 
    {
535 
        processBranch(@allStartPoints);
536 
    }
537 
    endPackage();
538 
 
539 
    chdir $cwd || Error ("Cannot cd back to $cwd");
540 
    rmdir $workDir;
541 
    Warning ("Work Directory still exists: $workDir");
542 
    saveData();
543 
}
544 
 
545 
#-------------------------------------------------------------------------------
546 
# Function        : setPruneMode
547 
#
548 
# Description     : Set the pruning mode
549 
#
550 
# Inputs          : mode                    - Text mode value
551 
#
552 
# Returns         : Nothing
553 
#
554 
sub setPruneMode
555 
{
556 
    my ($mode) = @_;
557 
    my $value;
558 
    if ( $mode )
559 
    {
560 
        if ( $mode =~ m/none/i) {
561 
            $value = 0;
562 
        } elsif ( $mode =~ m/ripple/i) {
563 
            $value = 1;
564 
        } elsif ( $mode =~ m/retain/i) {
565 
            $value = 2;
566 
        } elsif ( $mode =~ m/severe/i) {
567 
            $value = 3;
568 
        } else {
569 
            Error ("Unknown pruning mode", "Use: none, ripple, retain or severe");
570 
        }
571 
 
572 
        $pruneModeString = $mode;
573 
        $pruneMode = $value;
574 
    }
575 
}
576 
 
577 
#-------------------------------------------------------------------------------
578 
# Function        : smartPackageType
579 
#
580 
# Description     : Have a look at the projects in the package set and
581 
#                   attempt to determine what sort of mechanism to use
582 
#
583 
# Inputs          : Uses %suffixes data
584 
#
585 
# Returns         :
586 
#
587 
my $packageType = 'UNKNOWN';
588 
sub smartPackageType
589 
{
590 
    #
591 
    #   Rebuild suffixes hash based on  post massaged versions
592 
    #
593 
    my %suffixes;
594 
    my @unknown;
595 
    foreach my $entry ( keys %versions )
596 
    {
597 
        my $suffix = $versions{$entry}{suffix} || '';
598 
        push (@unknown, $entry) if ($suffix eq 'unknown');
599 
 
600 
        next if ( exists $suffixes{$suffix} );
601 
        next if ( $versions{$entry}{badSingleton} );
602 
        next if ( $versions{$entry}{locked} eq 'N' || $versions{$entry}{isaWip} );
603 
        $suffixes{$suffix} = 1;
604 
        $knownProjects{$suffix}{seen} = 1;
605 
 
606 
    }
607 
 
608 
    #
609 
    #   The 'unknown' suffix is really an 'empty' suffix
610 
    #   Try to be clever
611 
    #       Map unknown to 'cr' or 'mas' if present
612 
    #
613 
    #
614 
    if ( exists $suffixes{'unknown'}  )
615 
    {
616 
        my $new_suffix;
617 
        if ( exists $suffixes{'.cr'} ) {
618 
            $new_suffix = '.cr';
619 
        } elsif ( exists $suffixes{'.mas'} ) {
620 
            $new_suffix = '.mas';
621 
        }
622 
 
623 
        if ( $new_suffix )
624 
        {
625 
            foreach my $entry ( @unknown )
626 
            {
627 
                $versions{$entry}{suffix} = $new_suffix;
628 
            }
629 
            delete $suffixes{'unknown'};
630 
            delete $knownProjects{'unknown'}{seen};
631 
        }
632 
    }
633 
 
634 
    if ( exists $suffixes{'.cots'} && !exists ($notCots{$packageNames}) ) {
635 
        $packageType = 'COTS';
636 
        $Projects{'.cots'}{Trunk} = 1;
637 
        $singleProject = 1;
638 
        $opt_flat = 1 unless defined $opt_flat;
639 
        setPruneMode('none') unless (defined $opt_pruneModeString);
640 
 
641 
    } elsif ( exists $suffixes{'.tool'} ) {
642 
        $packageType = 'TOOL';
2429 dpurdie 643 
        $Projects{'.tool'}{Trunk} = 1;
1271 dpurdie 644 
        $singleProject = 1;
645 
        setPruneMode('none') unless (defined $opt_pruneModeString);
646 
#        $opt_flat = 1;
647 
 
648 
    } elsif ( scalar (keys %suffixes ) == 1 ) {
649 
        $packageType = 'SINGLE_PROJECT';
650 
        $singleProject = 1;
651 
 
652 
    } else {
653 
        $packageType = 'MULTIPLE_PROJECT';
654 
    }
655 
 
656 
    #
657 
    #   Some packages are special
658 
    #
2429 dpurdie 659 
    if ( $svnRepo =~ m~/Manufacturing(/|$)~ )
660 
    {
661 
        Message ("Set Manufacturing Repo style");
662 
        $opt_flat = 1;
663 
        setPruneMode('none') unless (defined $opt_pruneModeString);
664 
    }
1271 dpurdie 665 
 
2429 dpurdie 666 
 
1271 dpurdie 667 
    if ( $packageNames[0] =~ m'^br_applet_' )
668 
    {
2429 dpurdie 669 
      $opt_flat = 1 unless defined $opt_flat;
1271 dpurdie 670 
    }
671 
 
2429 dpurdie 672 
    foreach  ( @excludeFromImport )
673 
    {
674 
         $specialPackages{$_} .= 'protected,';
675 
    }
676 
 
1271 dpurdie 677 
    if ( exists $specialPackages{$packageNames[0]} )
678 
    {
679 
        my $data = $specialPackages{$packageNames[0]};
680 
        if ( index( $data, ',all' ) >= 0) {
681 
            setPruneMode('none') unless (defined $opt_pruneModeString);
682 
        }
683 
 
684 
        if ( index( $data, 'protected,' ) >= 0) {
685 
            $noTransfer = 1;
686 
        }
687 
 
688 
        if ( index( $data, 'flat,' ) >= 0) {
689 
            $opt_flat = 1;
690 
        }
691 
 
692 
        if ( index( $data, 'SetProjectBase,' ) >= 0) {
693 
            $opt_preserveProjectBase = 1;
694 
            $opt_ignoreProjectBaseErrors = 1;
695 
            Message ("Preserving ProjectBase");
696 
        }
697 
 
698 
        if ( index( $data, 'IgnoreProjectBase,' ) >= 0) {
699 
            $opt_ignoreProjectBaseErrors = 1;
700 
            Message ("Ignore ProjectBase Errors");
701 
        }
702 
 
2439 dpurdie 703 
        if ( index( $data, 'IgnoreMakeProject,' ) >= 0) {
704 
            $opt_ignoreMakeProjectErrors = 1;
705 
            Message ("Ignore MakeProject Usage");
706 
        }
707 
 
708 
 
2429 dpurdie 709 
        if ( index( $data, 'utf8,' ) >= 0) {
710 
            $mustConvertFileNames = 1;
711 
            Message ("Convert filenames to UTF8");
712 
        }
1271 dpurdie 713 
    }
714 
 
715 
    Message("Package Type: $packageType, $pruneModeString");
716 
}
717 
 
718 
 
719 
#-------------------------------------------------------------------------------
720 
# Function        : massageData
721 
#
722 
# Description     : Massage all the data to create a tree of package versions
723 
#                   that can be used to create images as well as an import order
724 
#
725 
# Inputs          :
726 
#
727 
# Returns         :
728 
#
729 
my $reprocess=0;
730 
sub calcLinks
731 
{
732 
    #
733 
    #   Process the 'versions' hash and:
734 
    #   Add back references
735 
    #   Find starts and ends
736 
    #       Entry with no previous
737 
    #       Entry with no next
738 
    #
739 
    $reprocess = 0;
740 
    foreach my $entry ( keys(%versions) )
741 
    {
742 
        foreach ( @{ $versions{$entry}{next}} )
743 
        {
744 
            $versions{$_}{last} = $entry;
745 
        }
746 
    }
747 
    @allStartPoints = ();
748 
    @startPoints = ();
749 
    @endPoints = ();
750 
    foreach my $entry ( keys(%versions) )
751 
    {
752 
        push @startPoints, $entry
753 
            unless ( exists $versions{$entry}{last} || $versions{$entry}{badSingleton} );
754 
 
755 
        push @allStartPoints, $entry
756 
            unless ( exists $versions{$entry}{last} );
757 
 
758 
        push @endPoints, $entry
759 
            unless ( @{$versions{$entry}{next}} > 0  )
760 
    }
761 
}
762 
 
763 
sub massageData
764 
{
765 
    #
766 
    #   Report unknown suffixes
767 
    #   Handle bad, or little known project suffixes by creating them
768 
    #
769 
    foreach my $suffix ( keys %suffixes )
770 
    {
771 
        if ( exists $Projects{$suffix} )
772 
        {
773 
            next;
774 
        }
775 
        Message ("Unknown project suffix: '$suffix'");
776 
        push @unknownProjects, $suffix;
777 
        my $cleanSuffix = ucfirst(lc(substr( $suffix, 1)));
778 
        $Projects{$suffix}{Name} = 'Project_' . $cleanSuffix;
779 
    }
780 
 
781 
    calcLinks();
782 
 
783 
    $initialTrees = scalar @allStartPoints;
784 
    Message ('Total RM versions: ' . $totalVersions );
785 
    Message ('Initial trees: ' . $initialTrees );
786 
    #
787 
    #   Attempt to glue all the start points into one chain.
788 
    #   This should allow us to track projects that branch from each other
789 
    #   in cases where the RM data is incorrect/incomplete
790 
    #       Strays are those that have no next or last
791 
    #
792 
    #   Glue based on Name, then PVID (Creation Order)
793 
    #
794 
    {
795 
        #
796 
        #   Examine threads. If it is a single entry thats bad then drop it
797 
        #   This is simple to do. Should examine all entries, but thats a
798 
        #   bit harder. Perhaps later.
799 
        #
800 
        if (1) {
801 
            Message ("Dropping Bad Singletons");
802 
            my $badSingletons;
803 
            foreach my $entry ( sort {$a <=> $b} @startPoints )
804 
            {
805 
                my $ep = $versions{$entry};
806 
                unless ( $ep->{last} || $ep->{next}[0] )
807 
                {
808 
#                    if (  $ep->{isaWip}  )
809 
                    if ( (exists $ep->{badVcsTag} && $ep->{badVcsTag}) || $ep->{isaWip}  )
810 
                    {
811 
                        $ep->{badSingleton} = 1;
812 
                        $reprocess = 1;
813 
                        $badSingletonCount++;
814 
 
815 
                        # Add to a list of its own.
816 
                        if ( $badSingletons )
817 
                        {
818 
                            push @{$versions{$badSingletons}{next}}, $entry;
819 
                        }
820 
                        $badSingletons = $entry;
821 
                    }
822 
                }
823 
            }
824 
            calcLinks()
825 
                if ( $reprocess );
826 
        }
827 
 
828 
        #
829 
        #   Create simple trees out of the chains
830 
        #   Tree is based on suffix (project) and version
831 
        #
832 
        {
833 
            my %trees;
834 
            Message ("Entries into trees");
835 
            foreach my $single ( @startPoints )
836 
            {
837 
                my $suffix = $versions{$single}{suffix} || '';
838 
                push @{$trees{$suffix}}, $single;
839 
            }
840 
 
841 
            foreach  ( keys %trees )
842 
            {
843 
                my $last;
844 
                foreach my $entry ( sort { $versions{$a}{version} cmp $versions{$b}{version}  } @{$trees{$_}} )
845 
                {
846 
                    if ( $last )
847 
                    {
848 
                        $versions{$last}{MakeTree} = 1;
849 
                        push @{$versions{$last}{next}}, $entry;
850 
                        $reprocess = 1;
851 
                    }
852 
                    $last = $entry;
853 
                }
854 
            }
855 
            calcLinks()
856 
                if ( $reprocess );
857 
        }
858 
 
859 
        #
860 
        #   Have a number of trees that are project related
861 
        #   Attempt to create a single tree by inserting
862 
        #   Secondary trees into the main line at suitable points
863 
        #
864 
        my @AllVersions = sort { $a <=> $b } @startPoints;
865 
        my $lastEntry = shift @AllVersions;
866 
        Error ("Oldest entry has a previous version") if ( $versions{$lastEntry}{last}  );
867 
#print "Oldest: $lastEntry\n";
868 
        #
869 
        #   Insert remaining entries into out list, which is now sorted
870 
        #
871 
        my @completeList;
872 
        foreach my $base ( @AllVersions  )
873 
        {
874 
            push @completeList, recurseList($lastEntry);
875 
            @completeList = sort {$a <=> $b} @completeList;
876 
#            Message("Complete List: ", @completeList);
877 
#            Message("Complete List($completeList[0]) Length: " . scalar @completeList);
878 
            $lastEntry = $base;
879 
 
880 
            my $last;
881 
            foreach my $entry ( @completeList )
882 
            {
883 
                if ( $entry > $base )
884 
                {
885 
                    Error ("Not expecting last to be empty. $base, $entry") unless ( $last );
886 
                    last;
887 
                }
888 
                $last = $entry;
889 
            }
890 
 
891 
            #
892 
            #   Insert at end if point not yet found
893 
            #
894 
#print "Inserting $base at $last\n";
895 
            push @{$versions{$last}{next}}, $base;
896 
            $versions{$base}{GluedIn} = 1;
897 
            $reprocess = 1;
898 
        }
899 
 
900 
        #
901 
        #   Recalc basic links if any processing done
902 
        #
903 
        calcLinks()
904 
            if ( $reprocess );
905 
 
906 
    }
907 
 
908 
 
909 
    #
910 
    #   Remove Dead Ends
911 
    #   Packages that were never released
912 
    #       Not locked, unless essential or a branchpoint
913 
    #   Won't consider these to be mainline path.
914 
    #
915 
    {
916 
        Message ("Remove Dead Ends");
917 
        foreach my $entry ( @endPoints )
918 
        {
919 
            my $deadWood;
920 
            while ( $entry )
921 
            {
922 
                last if ( $versions{$entry}{Essential} );
923 
 
924 
                my @next = @{$versions{$entry}{next}};
925 
                my $count = @next;
926 
                last if ( $count > 1 );
927 
 
928 
                last unless ( $versions{$entry}{locked} eq 'N' || $versions{$entry}{isaWip} );
929 
 
930 
                $versions{$entry}{DeadWood} = 1;
931 
                $trimCount++;
932 
            } continue {
933 
                $entry = $versions{$entry}{last};
934 
            }
935 
        }
936 
    }
937 
 
938 
    #
939 
    #   Walk each starting point list and determine new Projects
940 
    #   branchpoints.
941 
    #
942 
    Message ("Locate Projects branch points");
943 
    foreach my $bentry ( keys(%versions) )
944 
    {
945 
        my $baseSuffix = $versions{$bentry}{suffix};
946 
        foreach my $entry ( @{$versions{$bentry}{next}} )
947 
        {
948 
            if ( $baseSuffix ne $versions{$entry}{suffix})
949 
            {
950 
                unless ( exists $versions{$entry}{DeadWood} || $versions{$entry}{badSingleton} )
951 
                {
952 
#print "--- Project Branch $versions{$entry}{vname}\n";
953 
                    $versions{$entry}{branchPoint} = 1;
954 
                    $versions{$entry}{newSuffix} = 1;
955 
                }
956 
            }
957 
        }
958 
    }
2429 dpurdie 959 
 
960 
    #
961 
    #   Mark UkHops special points
962 
    #
963 
    foreach my $entry ( keys(%versions) ) {
964 
        foreach my $rtag_id ( keys %{$versions{$entry}{Releases}}  ) {
965 
            next unless ( exists $ukHopsReleases{$rtag_id} );
966 
            next unless ( $svnRepo =~ m~/ITSO_TRACS$~ );
967 
 
968 
            #
969 
            #   This package is current in a special ukHops release
970 
            #   Need to handle the differently
971 
            #
972 
            my $ukData =  $ukHopsReleases{$rtag_id};
973 
 
974 
            # Mark version we want on the trunk
975 
            # Will calculate tip later
976 
            if ( $ukData->{trunk} )
977 
            {
978 
                #
979 
                #   Can only place on trunk IFF its a tip
980 
                #   May have a WIP.
981 
                #   Solution. Walk to the tip, but only if there is one
982 
                #             path.
983 
                #
984 
                my $end = $entry;
985 
                my $last;
986 
                while ( $end )
987 
                {
988 
                    $last = $end;
989 
                    if ( @{$versions{$end}{next}} > 1)
990 
                    {
991 
                        Warning ("Uk Release. Preferred trunk is not a tip: $versions{$entry}{vname}");
992 
                        last;
993 
                    }
994 
 
995 
                    $end = @{$versions{$end}{next}}[0];
996 
                }
997 
                $versions{$last}{ukTrunk} = 1 ;
998 
            }
999 
 
1000 
            #
1001 
            #   What to do if the version is in more than one release
1002 
            #
1003 
            $versions{$entry}{ukBranch}++;
1004 
            if ( $versions{$entry}{ukBranch} > 1 )
1005 
            {
1006 
                Warning ("Version found in multiple Uk Releases - don't know what to do");
1007 
            }
1008 
 
1009 
            #
1010 
            #   What to do if the package has multiple version in a release
1011 
            #
1012 
            $ukData->{count}++;
1013 
            if ( $ukData->{count} > 1 )
1014 
            {
1015 
                Warning ("Package has multiple versions in the one Uk Release: $versions{$entry}{Releases}{$rtag_id}{rname}");
1016 
            }
1017 
        }
1018 
    }
1271 dpurdie 1019 
 
1020 
    #
1021 
    #   Prune
1022 
    #   Marks paths to root for all essential packages
1023 
    #   Marks the last-N from all essential packages
1024 
    #
1025 
    if ( $pruneMode )
1026 
    {
1027 
        Message ("Prune Tree: $pruneModeString");
1028 
        foreach ( @EssentialPackages )
1029 
        {
1030 
            #next unless ( exists $versions{$_} );      # Aleady deleted
1031 
 
1032 
            # Mark previous-N to be retained as well
1033 
            my $entry = $_;
1034 
            my $count = 0;
1035 
            while ( $entry )
1036 
            {
1037 
                last if ( $versions{$entry}{KeepMe} );
2429 dpurdie 1038 
#                unless ( $versions{$entry}{isaRipple} )
1271 dpurdie 1039 
                {
1040 
                    my $keepFlag = ($count++ < $opt_retaincount);
1041 
                    last unless ( $keepFlag );
1042 
                    $versions{$entry}{KeepMe} = $keepFlag;
1043 
                }
1044 
                $entry = $versions{$entry}{last}
1045 
            }
1046 
        }
1047 
 
1048 
        #
2429 dpurdie 1049 
        #   Keep recent versions
1050 
        #       Keep versions created in the last N days
1051 
        #       Will keep recent ripples too
1052 
        #
1053 
        if ( $pruneMode == 1 )
1054 
        {
1055 
            foreach my $entry ( keys(%versions) )
1056 
            {
1057 
                next unless ( $versions{$entry}{Age} <= $opt_recentAge  );
1058 
                $versions{$entry}{keepRecent} = 1;
1059 
                $recentCount++;
1060 
#print "--- Recent version $versions{$entry}{vname}, $versions{$entry}{Age} <= $opt_recentAge\n";
1061 
            }
1062 
 
1063 
#            #
1064 
#            #   Keep the tip of each branch
1065 
#            #
1066 
#            foreach my $entry ( @endPoints )
1067 
#            {
1068 
#                next if exists $versions{$entry}{keepRecent};
1069 
#                $versions{$entry}{keepRecent} = 1;
1070 
##print "--- Tip version $versions{$entry}{vname}\n";
1071 
#            }
1072 
        }
1073 
 
1074 
        #
1271 dpurdie 1075 
        #   Keep versions that are common parents to Essential Versions
1076 
        #       Mark paths through the tree to essential versions
1077 
        #       Mark nodes with the number of essential versions that they sprout
1078 
        #   Don't do it if we are ripple pruning
1079 
        #
1080 
        Message ("Prune Tree keep common parents");
1081 
        if ( $pruneMode != 1 )
1082 
        {
1083 
            foreach my $entry ( @endPoints )
1084 
            {
1085 
                my $hasEssential = 0;
1086 
                $visitId++;
1087 
                while ( $entry )
1088 
                {
1089 
                    $hasEssential = 1 if ( exists ($versions{$entry}{Essential}) && $versions{$entry}{Essential} );
1090 
                    if ( $hasEssential )
1091 
                    {
1092 
                        if ( @{$versions{$entry}{next}} > 1 )
1093 
                        {
1094 
                            $versions{$entry}{EssentialSplitPoint}++;
1095 
                        }
1096 
                        last if ( exists $versions{$entry}{EssentialPath} );
1097 
                        $versions{$entry}{EssentialPath} = 1;
1098 
                    }
1099 
 
1100 
                    if ( ($versions{$entry}{visitId} || 0) == $visitId )
1101 
                    {
1102 
                        DebugDumpData ("Versions", \%versions );
1103 
                        Warning ("Circular dependency");
1104 
                        last;
1105 
                    }
1106 
                    $versions{$entry}{visitId} = $visitId;
1107 
 
1108 
                    $entry = $versions{$entry}{last};
1109 
                }
1110 
            }
1111 
        }
1112 
 
1113 
        #
1114 
        #   Keep first version of each ripple. Must keep first
1115 
        #   Group ripples together so that they can be proccessed at the same time
1116 
        #
1117 
        calcRippleGroups()
1118 
            if ( $pruneMode == 1);
1119 
 
1120 
        #
1121 
        #   Delete all nodes that are not marked for retention
1122 
        #   This is rough on the tree
1123 
        #
1124 
        Message ("Prune Tree Deleting");
1125 
 
1126 
        # 0 - Keep me
1127 
        # 1 - Prune me
1128 
        sub pruneMe
1129 
        {
1130 
            my ($entry) = @_;
1131 
 
1132 
            return 0 unless ( exists $versions{$entry} );
1133 
            return 0 unless ( $versions{$entry}{last} );
2429 dpurdie 1134 
#            return 0 if ( ($pruneMode == 2) && exists $versions{$entry}{KeepMe} );
1135 
            return 0 if ( exists $versions{$entry}{KeepMe} );
1271 dpurdie 1136 
            return 0 if ( exists $versions{$entry}{Essential} );
1137 
            return 0 if ( $versions{$entry}{newSuffix} );
1138 
            return 0 if ( $versions{$entry}{newSuffix} && (exists $versions{$entry}{EssentialPath}) );
1139 
#            return 1 if ( exists $versions{$entry}{DeadWood} );
1140 
            return 0 if ( exists $versions{$entry}{EssentialSplitPoint} && $versions{$entry}{EssentialSplitPoint} > 1 );
1141 
            return 0 if ( exists $versions{$entry}{keepLowestRipple} &&  $versions{$entry}{keepLowestRipple} );
1142 
            return 0 if ( ($pruneMode == 1) && ! $versions{$entry}{isaRipple} );
2429 dpurdie 1143 
            return 0 if ( exists $versions{$entry}{keepRecent} && $versions{$entry}{keepRecent} );
1271 dpurdie 1144 
            return 1;
1145 
        }
1146 
 
1147 
        foreach my $entry ( keys(%versions) )
1148 
        {
1149 
#last;
1150 
            next unless ( pruneMe($entry) );
1151 
#print "--- Prune: $versions{$entry}{vname}\n";
1152 
 
1153 
            # Delete the current node
1154 
            #
1155 
            my @newNext;
1156 
            $pruneCount++;
1157 
            my $last = $versions{$entry}{last};
1158 
            foreach ( @{$versions{$last}{next}} )
1159 
            {
1160 
                next if ( $_ == $entry );
1161 
                push @newNext, $_;
1162 
            }
1163 
            foreach ( @{$versions{$entry}{next}} )
1164 
            {
1165 
                push @newNext, $_;
1166 
                $versions{$_}{last} = $last;
1167 
            }
1168 
 
1169 
            @{$versions{$last}{next}} = @newNext;
1170 
            delete $versions{$entry};
1171 
        }
1172 
 
1173 
        # Recalculate endpoints
1174 
        calcLinks();
1175 
    }
1176 
    else
1177 
    {
1178 
        #   No rippling happening
1179 
        #   Some process still need to happen
1180 
        #
1181 
        calcRippleGroups();
1182 
    }
1183 
 
1184 
    #
2429 dpurdie 1185 
    #   Want some versions to be forced to tip trunk
1186 
    #
1187 
    foreach my $name ( keys %ukHopsTip )
1188 
    {
1189 
        foreach my $entry ( keys(%versions) )
1190 
        {
1191 
            next unless ( $versions{$entry}{name} eq $name  );
1192 
            next unless ( exists $versions{$entry}{Releases}{$ukHopsTip{$name}} );
1193 
 
1194 
            #
1195 
            #   Force this suffix to be the trunk
1196 
            #   Remove all others
1197 
            #
1198 
            foreach my $suffix ( keys %Projects )
1199 
            {
1200 
                delete $Projects{$suffix}{Trunk};
1201 
            }
1202 
            my $suffix = $versions{$entry}{suffix};
1203 
            $Projects{$suffix}{Trunk} = 1;
1204 
        }
1205 
    }
1206 
 
1207 
    #
1271 dpurdie 1208 
    #   Calculate best through-path for branches in the tree
1209 
    #   Attempt to keep that 'max' version on the mainline
1210 
    #   May be modified by -tip=nnnn
1211 
    #
1212 
    #   For each leaf (end point), walk backwards and mark each node with the
1213 
    #   max version see. If we get to a node which already has been marked then
1214 
    #   stop if our version is greater. We want the value to be the max version
1215 
    #   to a leaf
1216 
    #
1217 
    #   Account for 'suffix'. When suffix changes, then the 'max' version must
1218 
    #   be recalculated
1219 
    #
1220 
 
1221 
    Message ("Calculate Max Version");
1222 
    my $maxVersion;
1223 
    foreach my $entry ( @endPoints )
1224 
    {
1225 
        my $lastSuffix;
1226 
        my $forceTip;
1227 
        while ( $entry )
1228 
        {
1229 
            if (!defined($lastSuffix) || ($versions{$entry}{suffix} ne $lastSuffix) )
1230 
            {
1231 
                $maxVersion = '0';
1232 
                $visitId++;
1233 
                $forceTip = ( exists $tipVersions{$versions{$entry}{vname}} );
2429 dpurdie 1234 
                $forceTip = 1 if $versions{$entry}{ukTrunk};
1271 dpurdie 1235 
                delete $tipVersions{$versions{$entry}{vname}};
1236 
                $maxVersion = '999.999.999.999.zzz' if ( $forceTip );
1237 
                $lastSuffix = $versions{$entry}{suffix};
1238 
#print "---Tip Found\n" if $forceTip;
1239 
            }
1240 
 
1241 
            # Detect circular dependencies
1242 
            if ( ($versions{$entry}{visitId} || 0) == $visitId )
1243 
            {
1244 
                DebugDumpData ("Circular dependency: Versions", \%versions );
1245 
                Warning ("Circular dependency");
1246 
                last;
1247 
            }
1248 
            $versions{$entry}{visitId} = $visitId;
1249 
 
1250 
            my $thisVersion = $versions{$entry}{version} || '';
1251 
            if ( $thisVersion gt $maxVersion )
1252 
            {
1253 
                $maxVersion = $thisVersion;
1254 
            }
1255 
 
1256 
            if ( exists $versions{$entry}{maxVersion} )
1257 
            {
1258 
                if ( $versions{$entry}{maxVersion} gt $maxVersion )
1259 
                {
1260 
                    last;
1261 
                }
1262 
            }
1263 
 
1264 
            $versions{$entry}{maxVersion} = $maxVersion;
1265 
            $entry = $versions{$entry}{last};
1266 
        }
1267 
    }
1268 
 
1269 
 
1270 
    #
1271 
    #   Locate all instances where a package-version branches
1272 
    #   Determine the version that should be on the non-branching path
1273 
    #
1274 
    #   Reorder the 'next' list so that the first item is the non-branching
1275 
    #   path. This will be used in the data-insertion phase to simplify the
1276 
    #   processing.
1277 
    #
1278 
    Message ("Calculate package version branches");
1279 
    foreach my $entry ( sort {$a <=> $b} keys(%versions) )
1280 
    {
1281 
        calculateWalkOrder($entry);
1282 
    }
1283 
 
1284 
    #
1285 
    #   Mark Project Branch Tips as they will be in the Repository
1286 
    #   Find each project head and walk primary entry to the end.
1287 
    #
1288 
    foreach my $entry ( keys(%versions) )
1289 
    {
1290 
        #
1291 
        #   Root of each tree is 'new'
1292 
        #
1293 
        unless ( defined $versions{$entry}{last})
1294 
        {
1295 
            unless ( $versions{$entry}{badSingleton} )
1296 
            {
1297 
                $versions{$entry}{newSuffix} = 1;
1298 
            }
1299 
        }
1300 
 
1301 
        #
1302 
        #   Update stats
1303 
        #
1304 
        $badVcsCount++ if ( $versions{$entry}{badVcsTag} );
1305 
        $ProjectCount++ if ( $versions{$entry}{newSuffix} );
1306 
        next if ( $opt_flat );
1307 
 
1308 
        next unless ($versions{$entry}{newSuffix} );
1309 
#print "--- Project new Suffix $versions{$entry}{vname}\n";
1310 
 
1311 
 
1312 
        my $suffix = $versions{$entry}{suffix};
1313 
        $knownProjects{$suffix}{count}++;
1314 
 
1315 
        my $next = $versions{$entry}{next}[0];
1316 
        my $tip;
1317 
        while ( $next )
1318 
        {
1319 
            last if ( $suffix ne $versions{$next}{suffix} );
1320 
            $tip = $next unless (exists ($versions{$next}{DeadWood}) || $versions{$next}{badSingleton});
1321 
            $next = $versions{$next}{next}[0];
1322 
        }
1323 
 
1324 
        $versions{$tip}{Tip} = 1 if $tip;
1325 
    }
1326 
 
1327 
    unless ( $opt_flat )
1328 
    {
1329 
        my $finalTrees = scalar @startPoints;
1330 
        Warning ("Still have multiple trees: $finalTrees") unless ( $finalTrees == 1 );
1331 
    }
1332 
 
1333 
    #
1334 
    #   Display warnings about multiple
1335 
    #
1336 
    foreach ( sort keys %knownProjects )
1337 
    {
1338 
        my $count = $knownProjects{$_}{count} || 0;
1339 
        Warning ("Multiple Project Roots: $_ ($count)" )
1340 
            if ( $count > 1 );
1341 
    }
1342 
 
1343 
    #
1344 
    #   Display warnings about Bad Essential Packages
1345 
    #
1346 
    $allSvn = 1;
1347 
    foreach my $entry ( keys(%versions) )
1348 
    {
1349 
        $rippleCount++ if ( exists($versions{$entry}{isaRipple}) && $versions{$entry}{isaRipple} );
1350 
        $allSvn = 0 unless ( $versions{$entry}{isSvn} );
1351 
        next unless ( exists $versions{$entry}{Essential}  );
1352 
        next unless ( $versions{$entry}{badVcsTag}  );
1353 
        push @badEssentials, $entry;
1354 
        Warning ("BadVCS Essential: " . GetVname($entry))
1355 
    }
1356 
 
1357 
    #
1358 
    #   All done
1359 
    #
1272 dpurdie 1360 
    $processTotal = scalar keys %versions;
1361 
    Message("Retained entries: $processTotal" );
1271 dpurdie 1362 
    Message("Pruned entries: $pruneCount");
1363 
    Message("Deadwood entries: $trimCount");
1364 
    Message("Bad Singletons: $badSingletonCount");
1365 
    Message("Ripples: $rippleCount");
2429 dpurdie 1366 
    Message("Recent entries: $recentCount");
1271 dpurdie 1367 
}
1368 
 
1369 
sub calculateWalkOrder
1370 
{
1371 
    my ($entry) = @_;
1372 
    my @next = @{$versions{$entry}{next}};
1373 
    my $count = @next;
1374 
    my @ordered;
1375 
    my $main;
1376 
 
1377 
    if ( $count > 1 )
1378 
    {
1379 
        # Array to hash to simplify removal
1380 
        my %nexts = map { $_ => 1 } @next;
1381 
        foreach my $e ( @next )
1382 
        {
1383 
 
1384 
            #
1385 
            #   Locate branch points that are not a part of a new project
1386 
            #   These will not be preferred paths for walking
1387 
            #
1388 
            if ( !defined($versions{$e}{branchPoint}) && $versions{$entry}{suffix} ne $versions{$e}{suffix} )
1389 
            {
1390 
                unless ( exists $versions{$e}{DeadWood} || $versions{$e}{badSingleton}  )
1391 
                {
1392 
#print "--- Project Branch (1) $versions{$e}{vname}\n";
1393 
                    $versions{$e}{branchPoint} = 1;
1394 
                    $versions{$e}{newSuffix} = 1;
1395 
                }
1396 
            }
1397 
 
1398 
            #
1399 
            #   Remove those that already have a branch,
1400 
            #
1401 
            if ( $versions{$e}{branchPoint} || $versions{$e}{newSuffix} || $versions{$e}{DeadWood}  )
1402 
            {
1403 
                push @ordered, $e;
1404 
                delete $nexts{$e};
1405 
            }
1406 
        }
1407 
        #
1408 
        #   Select longest arm as the non-branching path
1409 
        #   Note: Reverse sort order
1410 
        #         Done so that 'newest' item is given preference
1411 
        #         to the main trunk in cases where all subtrees are
1412 
        #         the same length
1413 
        #
1414 
        my $maxData = '';
1415 
        my $countEntry;
1416 
        foreach my $e ( sort {$b <=> $a} keys %nexts )
1417 
        {
1418 
            if ( $versions{$e}{maxVersion} gt $maxData )
1419 
            {
1420 
                $maxData = $versions{$e}{maxVersion};
1421 
                $countEntry = $e;
1422 
            }
1423 
        }
1424 
        if ($countEntry)
1425 
        {
1426 
            $main = $countEntry;
1427 
            delete $nexts{$countEntry};
1428 
        }
1429 
 
1430 
        #
1431 
        #   Append the remaining
1432 
        #
1433 
        push @ordered, keys %nexts;
1434 
 
1435 
        #
1436 
        #   Re-order 'next' so that the main path is first
1437 
        #   Sort (non main) by number
1438 
        #
1439 
        @ordered = sort {$a <=> $b} @ordered;
1440 
        unshift @ordered, $main if ( $main );
1441 
        @{$versions{$entry}{next}} = @ordered;
1442 
 
1443 
        #
1444 
        #   Ensure all except the first are a branch point
1445 
        #   First may still be a branch point
1446 
        #
1447 
        shift @ordered;
1448 
        foreach my $e ( @ordered )
1449 
        {
1450 
            $versions{$e}{branchPoint} = 1;
1451 
        }
1452 
    }
1453 
}
1454 
 
1455 
#-------------------------------------------------------------------------------
1456 
# Function        : calcRippleGroups
1457 
#
1458 
# Description     : Locate and mark ripple groups
2429 dpurdie 1459 
#                   packages that are ripples of each other
1271 dpurdie 1460 
#                       Keep first version of each ripple. Must keep first
1461 
#                       Group ripples together so that they can be
1462 
#                       proccessed at the same time
1463 
#
1464 
# Inputs          :
1465 
#
1466 
# Returns         :
1467 
#
1468 
sub calcRippleGroups
1469 
{
1470 
    my %rippleVersions;
1471 
    foreach my $entry ( keys(%versions) )
1472 
    {
1473 
        my $ep = $versions{$entry};
1474 
        if ( defined $ep->{buildVersion} )
1475 
        {
1476 
            my $suffix = $ep->{suffix};
1477 
            my ($major, $minor, $patch, $build) = @{$ep->{buildVersion}};
1478 
#print "--- $major, $minor, $patch, $build, $suffix\n";
1479 
            $rippleVersions{$suffix}{"$major.$minor.$patch"}{count}++;
1480 
            my $rp = $rippleVersions{$suffix}{"$major.$minor.$patch"};
1481 
            $rp->{list}{$entry} = 1;
1482 
 
1483 
            next if ( $ep->{badVcsTag} );
1484 
            next if ( $ep->{locked} eq 'N');
1485 
            if (!defined ($rp->{min}) || $rp->{min} > $build )
1486 
            {
1487 
                $rp->{pvid} = $entry;
1488 
                $rp->{min} = $build;
1489 
            }
1490 
        }
1491 
    }
1492 
#            DebugDumpData("rippleVersions", \%rippleVersions );
1493 
 
1494 
    while ( my($suffix, $e1) = each %rippleVersions )
1495 
    {
1496 
        while ( my( $mmp, $e2) = each %{$e1} )
1497 
        {
1498 
            next unless ( exists  $e2->{pvid} );
1499 
            my $entry = $e2->{pvid};
1500 
            if ( !exists $versions{$entry} )
1501 
            {
1502 
                Error ("Internal: Expected entry not found: $entry, $mmp");
1503 
            }
1504 
 
1505 
            $versions{$entry}{keepLowestRipple} = 1;
1506 
#print "--- Keep Riple $versions{$entry}{vname}\n";
1507 
 
1508 
            #
1509 
            #   Update entry with list of associated ripples, removing lowest
1510 
            #
1511 
            delete $e2->{list}{$entry};
1512 
            my @rippleList = sort keys %{$e2->{list}};
1513 
            if ( @rippleList)
1514 
            {
1515 
#DebugDumpData("LIST: $entry", $e2->{list}, \@rippleList  );
1516 
                @{$versions{$entry}{rippleList}} = @rippleList;
1517 
            }
1518 
        }
1519 
    }
1520 
}
1521 
 
1522 
#-------------------------------------------------------------------------------
1523 
# Function        : processBranch
1524 
#
1525 
# Description     : Process one complete branch within the tree of versions
1526 
#                   May be called recursivly to walk the tree
1527 
#
1528 
# Inputs          : Array of package-version ID to process
1529 
#
1530 
# Returns         : Nothing
1531 
#
1532 
 
1533 
sub processBranch
1534 
{
1535 
    foreach my $entry ( @_ )
1536 
    {
1537 
        #
1538 
        #   Do we need to create a branch before we can process this package
1539 
        #
1540 
        if ( $versions{$entry}{newSuffix} || $versions{$entry}{branchPoint} )
1541 
        {
1542 
            newProject();
1543 
            $createBranch = 1;
1544 
            $createSuffix = 1 if $versions{$entry}{newSuffix};
1545 
        }
1546 
 
1547 
        newPackageVersion( $entry );
2429 dpurdie 1548 
        unless ( $globalError )
1549 
        {
1550 
            getSvnData();
1551 
            createImages();
1552 
        }
1553 
 
1271 dpurdie 1554 
no warnings "recursion";
1555 
        processBranch (@{$versions{$entry}{next}});
1556 
    }
1557 
}
1558 
 
1559 
#-------------------------------------------------------------------------------
1560 
# Function        : newPackageVersion
1561 
#
1562 
# Description     : Create a package version
1563 
#
1564 
# Inputs          : $entry              - Ref to entry being proccessed
1565 
#
1566 
# Returns         :
1567 
#
1568 
sub newPackageVersion
1569 
{
1570 
    my ($entry) = @_;
1571 
    my %data;
1572 
    my $flags = 'e';
1573 
    my $rv = 1;
1574 
    my $startTime = time();
1575 
    my $timestamp = localtime;
1576 
 
1577 
    $data{rmRef} = 'ERROR';
1578 
    $data{tag} = 'ERROR';
1579 
 
1580 
    #
1581 
    #   If its been processed then fake that its been done
1582 
    #   May have been a ripple that we processed
1583 
    #
1272 dpurdie 1584 
    return if ($versions{$entry}{Processed});
1585 
    $processCount++;
1271 dpurdie 1586 
    Message ("------------------------------------------------------------------" );
1272 dpurdie 1587 
    Message ("Package $processCount of $processTotal");
1588 
 
1271 dpurdie 1589 
    Message ("New package-version: " . GetVname($entry) . " Tag: " . $versions{$entry}{vcsTag} );
1590 
 
2429 dpurdie 1591 
    #
1592 
    #   Detect user abort
1593 
    #
1594 
    if ( -f $cwd . '/stopfile' )
1595 
    {
1596 
        $globalError = 1;
1597 
        Message ("Stop file located");
1598 
    }
1271 dpurdie 1599 
    if ( $opt_resume )
1600 
    {
1601 
        return
1602 
        unless ( $opt_resume eq $versions{$entry}{vcsTag} );
1603 
        $opt_resume = '';
1604 
    }
1605 
 
1606 
    #
1607 
    #   If we have a global error,then we pretend to process, but we
1608 
    #   report errors for the logging system
1609 
    #
2429 dpurdie 1610 
    if ( $globalError )
1271 dpurdie 1611 
    {
2429 dpurdie 1612 
        Message ("Global error prevents futher importation");
1613 
    }
1614 
    else
1615 
    {
1271 dpurdie 1616 
        #
1617 
        #   Call worker function
1618 
        #   It will exist on any error so that it can be logged
1619 
        #
1620 
        $rv = newPackageVersionBody( \%data, @_ );
1621 
        $globalError = 1 if ( $rv >= 10 );
1622 
    }
1623 
 
1624 
    #
1625 
    #   Highlight essential packages that failed to transfer
1626 
    #
1627 
    if ( $globalError ) {
1628 
        $flags = 'e';
1629 
    } elsif ( $rv && ( exists $versions{$entry}{Essential} ) ) {
1630 
        $flags = 'X';
1631 
    } elsif ( $rv ) {
1632 
        $flags = 'E';
1633 
    } else {
1634 
        $flags = 'G';
1635 
    }
1636 
 
1637 
    #
1638 
    #   Always log results to a file
1639 
    #   Flags:
1640 
    #       e - Error: Global Fatal causes other versions to be ignored
1641 
    #       X - Essential Package NOT proccessed
1642 
    #       E - Error processing package
1643 
    #       G - Good
1644 
    #
1645 
    my $duration = time() - $startTime;
1646 
    my $line = join(';',
1647 
            $flags,
1648 
            $entry,
1649 
            $packageNames,
1650 
            $versions{$entry}{vname},
1651 
            $data{rmRef},
1652 
            $data{tag},
1653 
            $timestamp,
1654 
            $duration,
1655 
            $data{errStr} || ''
1656 
            );
1657 
    logToFile( $cwd . '/importsummary.txt', ";$line;");
1658 
 
1659 
    #
1660 
    #   Sava data
1661 
    #
1272 dpurdie 1662 
    $data{errFlags} = $flags;
1663 
    $data{duration} = $duration;
1271 dpurdie 1664 
    $versions{$entry}{rmRef} = $data{rmRef};
1272 dpurdie 1665 
    delete $data{rmRef};
1666 
    delete $data{tag};
2429 dpurdie 1667 
    ##delete $data{ViewRoot};
1272 dpurdie 1668 
    $versions{$entry}{data} = \%data;
1271 dpurdie 1669 
 
1670 
    #
1671 
    #   Delete the created view
1672 
    #   Its just a directory, so delete it
1673 
    #
1674 
    if ( $data{ViewRoot} && -d $data{ViewRoot})
1675 
    {
2429 dpurdie 1676 
        if ( !$opt_reuse || ($rv && ($rv != 4 && $rv != 12 )) )
1677 
        {
1678 
            Message ("Delete View: $data{ViewRoot}");
1679 
            RmDirTree ($data{ViewRoot} );
1680 
        }
1681 
        else
1682 
        {
1683 
            Message ("Retaining View: $data{ViewRoot}");
1684 
        }
1685 
 
1271 dpurdie 1686 
    }
2429 dpurdie 1687 
    else
1688 
    {
2439 dpurdie 1689 
        Message ("No view to delete");
2429 dpurdie 1690 
    }
1271 dpurdie 1691 
 
1692 
 
1693 
    #
1694 
    #   If this version has any 'ripples' then process them while we have the
1695 
    #   main view. Note the ripple list may contain entries that do not
1696 
    #   exist - they will have been pruned.
1697 
    #
2429 dpurdie 1698 
if(1) {
1271 dpurdie 1699 
    foreach my $rentry ( @{$versions{$entry}{rippleList}} )
1700 
    {
1701 
        next unless( exists $versions{$rentry} );
1702 
 
1703 
        if ($versions{$rentry}{Processed})
1704 
        {
1705 
            Warning ("Ripple Processed before main entry");
1706 
            $versions{$rentry}{rippleProcessed} = 1;
1707 
        }
1708 
 
1709 
        Message ("Proccessing associated Ripple: " . GetVname($rentry));
1710 
        newPackageVersion($rentry);
1711 
    }
1712 
}
2429 dpurdie 1713 
}
1271 dpurdie 1714 
 
1715 
#-------------------------------------------------------------------------------
1716 
# Function        : newPackageVersionBody
1717 
#
1718 
# Description     : Perform the bulk of the work in creating a new PackageVersion
1719 
#                   Designed to return on error and have error processing
1720 
#                   performed by caller
1721 
#
1722 
# Inputs          : $data               - Shared data
1723 
#                   $entry              - Package entry to process
1724 
#
1725 
# Returns         : Error Code
1726 
#                         0 - All is well
1727 
#                       <10 - Recoverable error
1728 
#                       >10 - Fatal error
1729 
#
1730 
sub newPackageVersionBody
1731 
{
1732 
    my ($data, $entry) = @_;
1733 
    my $rv;
1734 
    my $cc_label;
1735 
    my $cc_path;
2429 dpurdie 1736 
    my $cc_path_original;
1271 dpurdie 1737 
 
1738 
    #
1739 
    #   Init Data
1740 
    #
1741 
    $data->{rmRef} = 'ERROR';
1742 
    $data->{tag} = '';
1743 
    $data->{ViewRoot} = undef;
1744 
    $data->{ViewPath} = undef;
1745 
    $data->{errStr} = '';
1746 
    $versions{$entry}{Processed} = 1;
1747 
 
1748 
 
1749 
    SystemConfig ('ExitOnError' => 0);
1750 
 
1751 
    push @processOrder, $entry;
1752 
    return 0 if ( $opt_test );
1753 
 
1754 
#   Keep DeadWood. May be a WIP
1755 
#    if ( exists $versions{$entry}{DeadWood} && $versions{$entry}{DeadWood} )
1756 
#    {
1757 
#        $data->{errStr} = 'Package is DeadWood';
1758 
#        return 3;
1759 
#    }
1760 
 
1761 
    #
1762 
    #   Determine version information
1763 
    #
1764 
    $data->{tag} = $versions{$entry}{vcsTag} || '';
1765 
    if ( $versions{$entry}{badVcsTag} )
1766 
    {
1767 
        Warning ("Error: Bad VcsTag for: " . GetVname($entry),
1768 
                 "Tag: $data->{tag}" );
1769 
        $data->{errStr} = 'VCS Tag Marked as Bad';
1770 
        return 1;
1771 
    }
1772 
 
1773 
 
1774 
    $data->{tag} =~ m~^(.+?)::(.*?)(::(.+))?$~;
1775 
    $cc_label = $4;
1776 
    $cc_path = $2;
1777 
    $cc_path = '/' . $cc_path;
1778 
    $cc_path =~ tr~\\/~/~s;
2429 dpurdie 1779 
    $cc_path_original = $cc_path;
1271 dpurdie 1780 
 
1781 
    #
1782 
    #   Correct well known path mistakes
1783 
    #
2429 dpurdie 1784 
    $cc_path =~ s~/build.pl$~~i;
1785 
    $cc_path =~ s~/src$~~i;
1786 
    $cc_path =~ s~/cpp$~~i;
1787 
    $cc_path =~ s~/MASS_Dev/Infra/~/MASS_Dev_Infra/~i;
1788 
    $cc_path =~ s~/MASS_Dev/Tools/~/MASS_Dev_Tools/~i;
1271 dpurdie 1789 
    $cc_path =~ s~/MASS_Dev/Bus/~/MASS_Dev_Bus/~i;
1790 
    $cc_path =~ s~/MASS_Dev_Bus/Cbp/~/MASS_Dev_Bus/CBP/~i;
1791 
    $cc_path =~ s~/MREF_Package/ergpostmongui$~/MREF_Package/ergpostmongui~i;
2429 dpurdie 1792 
    $cc_path =~ s~/MREF_../MREF_Package/~/MREF_Package/~i;
1793 
    $cc_path =~ s~/MREF_Package/mass_ergocdp/~/MREF_Package/ergocdp/~i;
1794 
    $cc_path =~ s~/MASS_Dev_Bus/CBP/systemCD.ejb~/MASS_Dev_Bus/CBP/systemCD/ejb~i;
1795 
    $cc_path =~ s~/MASS_Dev_Bus/Financial/cpp/paymentmanager~/MASS_Dev_Bus/Financial/cpp/paymentmanager~i;
1796 
    $cc_path =~ s~/MASS_Dev_Bus/WebServices~/MASS_Dev_Bus/WebServices~i;
1797 
    $cc_path =~ s~/MASS_Dev_Bus/CBP/nullAdapter~//MASS_Dev_Bus/CBP/nullAdaptor~i;
1271 dpurdie 1798 
 
2429 dpurdie 1799 
    $cc_path = '/MASS_Dev_Bus' if ( $cc_path =~ m~/MASS_Dev_Bus/ImageCapture(/|$)~i );
1800 
    $cc_path = '/MASS_Dev_Bus/CBP/enquiry' if ( $versions{$entry}{name} eq 'EJBEnqPxyConnector');
1801 
    $cc_path = '/MASS_Dev_Bus/CBP/enquiry' if ( $versions{$entry}{name} eq 'proxyif4j');
1802 
    $cc_path = '/MASS_Dev_Bus' if ( $versions{$entry}{name} eq 'ImageCaptureTomcatDeployment');
1803 
    $cc_path = '/MASS_Dev_Bus/WebServices/MassWS' if ( $versions{$entry}{name} eq 'MassWebServicesImpl');
1271 dpurdie 1804 
 
2429 dpurdie 1805 
    if (   $versions{$entry}{name} =~ m/^ERGagency$/i
1806 
        || $versions{$entry}{name} =~ m/^ERGavm$/i
1807 
        || $versions{$entry}{name} =~ m/^ERGboi$/i
1808 
        || $versions{$entry}{name} =~ m/^ERGcallcenter$/i
1809 
        || $versions{$entry}{name} =~ m/^ERGcardholder$/i
1810 
        || $versions{$entry}{name} =~ m/^ERGcdaimports$/i
1811 
        || $versions{$entry}{name} =~ m/^ERGcda$/i
1812 
        || $versions{$entry}{name} =~ m/^ERGcscedit$/i
1813 
        || $versions{$entry}{name} =~ m/^ERGcs$/i
1814 
        || $versions{$entry}{name} =~ m/^ERGofs$/i
1815 
        || $versions{$entry}{name} =~ m/^ERGols$/i
1816 
        || $versions{$entry}{name} =~ m/^ERGtpf$/i
1817 
        || $versions{$entry}{name} =~ m/^ERGorasys$/i
1818 
        || $versions{$entry}{name} =~ m/^ERGoracs$/i
1819 
        || $versions{$entry}{name} =~ m/^ERGpxyif$/i
1820 
        || $versions{$entry}{name} =~ m/^ERGtp5upg$/i
1821 
        || $versions{$entry}{name} =~ m/^ERGinstitutional$/i
1822 
        || $versions{$entry}{name} =~ m/^ERGinfra$/i
1823 
        || $versions{$entry}{name} =~ m/^ERGcrrpts$/i
1824 
        || $versions{$entry}{name} =~ m/^ERGmiddle$/i
1825 
        || $versions{$entry}{name} =~ m/^ERGmiddleapi$/i
1826 
        || $versions{$entry}{name} =~ m/^ERGwebapi$/i
1827 
        || $versions{$entry}{name} =~ m/^ERGwebtestui$/i
1828 
        || $versions{$entry}{name} =~ m/^ERGwebesbui$/i
1829 
        || $versions{$entry}{name} =~ m/^ERGwspiv$/i
1830 
        || $versions{$entry}{name} =~ m/^ERGwscst$/i
1831 
        || $versions{$entry}{name} =~ m/^sposMUG$/i
1832 
        || $versions{$entry}{name} =~ m/^ERGfinman$/i
1833 
        || $versions{$entry}{name} =~ m/^ERGkm$/i
1834 
        || $versions{$entry}{name} =~ m/^ERGxml$/i
1835 
        || $versions{$entry}{name} =~ m/^ERGoradacw$/i
1836 
        || $versions{$entry}{name} =~ m/^ERGtru$/i
1837 
        )
1271 dpurdie 1838 
    {
2429 dpurdie 1839 
        $cc_path = '/MREF_Package';
1271 dpurdie 1840 
    }
1841 
 
2429 dpurdie 1842 
    if (   $versions{$entry}{name} =~ m/^tp5000_MUG$/i )
1271 dpurdie 1843 
    {
2429 dpurdie 1844 
        if ( $versions{$entry}{version} =~ m~vtk$~ )
1271 dpurdie 1845 
        {
2429 dpurdie 1846 
            $cc_path = '/MREF_Package';
1271 dpurdie 1847 
        }
1848 
    }
1849 
 
2429 dpurdie 1850 
    if ( $cc_path_original ne $cc_path )
1851 
    {
1852 
            Message ("Package: $versions{$entry}{name}. Forcing CC path to: $cc_path" );
1853 
    }
1854 
 
1855 
#print "--- Path: $cc_path, Label: $cc_label\n";
1271 dpurdie 1856 
 
1857 
    #
2429 dpurdie 1858 
    #   Create CC view
1859 
    #   Import into Subversion View
1860 
    #
1861 
    $rv = extractFilesFromClearCase( $data, $cc_path, $cc_label );
1862 
    return $rv if ( $rv );
1863 
 
1864 
    #
1272 dpurdie 1865 
    #   Developers have been slack
1866 
    #       Sometime the mark the source path as 'GMTPE2005'
1867 
    #       Sometimes as 'GMTPE2005/Package/Fred/Jill/Harry'
1868 
    #
1869 
    #   Attempt to suck up empty directories below the specified
1870 
    #   source path
1871 
    #
1872 
    unless ( $opt_preserveProjectBase )
1873 
    {
1874 
        #
1875 
        #   Look in ViewPath
1876 
        #   If it contains only ONE directory then we can suck it up
1877 
        #
1878 
        my $testDir = findDirWithStuff( $data->{ViewPath} );
2429 dpurdie 1879 
 
1272 dpurdie 1880 
        unless ( $data->{ViewPath} eq $testDir  )
1881 
        {
1882 
            Message ("Adjust Base Dir: $testDir");
1883 
            $data->{adjustedPath} = $data->{ViewPath};
1884 
            $data->{ViewPath} = $testDir;
1885 
        }
1886 
    }
2439 dpurdie 1887 
 
1888 
    #
1889 
    #   Some really ugly packages make use of a Jats feature called 'SetProjectBase'
1890 
    #   Detect such packages as we will need to handle them differently
1891 
    #   Can't really handle it on the fly
1892 
    #   All we can do is detect it and report it - at the moment
1893 
    #
1894 
    if (detectProjectBaseUsage($data, $cc_path) )
1895 
    {
1896 
        unless ( $opt_ignoreProjectBaseErrors )
1897 
        {
1898 
            $data->{BadProjectBase}++;
1899 
            $data->{errStr} = 'Bad usage of ProjectBase detected';
1900 
            return 4;           # Lets see what the others look like too
1901 
#            return 14;
1902 
        }
1903 
    }
2429 dpurdie 1904 
 
1905 
    #
2439 dpurdie 1906 
    #   Some really really ugly packgaes make use of the MakeProject directive
1907 
    #   and then use an 'include.txt file to access paths all over the VOB
1908 
    #   The problem is with lines like
1909 
    #           /I ..\..\..\..\..\..\DPG_SWCode\projects\seattle\ddu\component\DTIApp\dsi\inc
1910 
    #   Two problems:
1911 
    #       Vob Name is not a part of the migration
1912 
    #       If we 'SuckUp' empty directories then this may break
1913 
    #       the pathing.
1914 
    #   All we can do is detect it and report it - at the moment
1915 
    #
1916 
    if (detectMakeProjectUsage($data, $cc_path) )
1917 
    {
1918 
        unless ( $opt_ignoreMakeProjectErrors )
1919 
        {
1920 
            $data->{BadMakeProject}++;
1921 
            $data->{errStr} = 'Use of MakeProject detected';
1922 
            return 4;           # Lets see what the others look like too
1923 
#            return 14;
1924 
        }
1925 
    }
1926 
 
1927 
    #
2429 dpurdie 1928 
    #   Some packages have filenames that are need to be converted
1929 
    #
2439 dpurdie 1930 
    if ( $mustConvertFileNames  )
2429 dpurdie 1931 
    {
1932 
        $rv = system ( '/home/dpurdie/svn/tools/convmv-1.15/convmv',
1933 
                 '-fiso-8859-1',
1934 
                 '-tutf8',
1935 
                 '-r',
1936 
                 '--notest',
1937 
                 $data->{ViewPath} );
1938 
 
1939 
        if ( $rv )
1940 
        {
1941 
            $data->{errStr} = 'Failed to convert filenames to UTF8';
1942 
            return 14;
1943 
        }
2439 dpurdie 1944 
 
1945 
        #
1946 
        #   Check to see if our ViewPath has been changed
1947 
        #   If so, then try to fix it
1948 
        #
1949 
        unless ( -d $data->{ViewPath} )
1950 
        {
1951 
            Message ("Correct UTF-8 change to ViewPath");
1952 
            $data->{ViewPath} = encode('UTF-8', $data->{ViewPath}, Encode::FB_DEFAULT);
1953 
            Warning ("Correct UTF-8 change to ViewPath - FAILED") unless ( -d $data->{ViewPath} );
1954 
        }
2429 dpurdie 1955 
    }
1272 dpurdie 1956 
 
1957 
    #
1271 dpurdie 1958 
    #   Have a CC view
1959 
    #   Now we can create the SVN package and branching point before we
1960 
    #   import the CC data into SVN
1961 
    #
1962 
    my @args;
1963 
 
1964 
    #
1965 
    #   Calculate args for functions
1966 
    #
1967 
    my $author = $versions{$entry}{created_id};
1968 
    if ( $author )
1969 
    {
1970 
        push @args, '-author', $author;
1971 
    }
1972 
    my $created = $versions{$entry}{created};
1973 
    if ( $created )
1974 
    {
1975 
        $created =~ s~ ~T~;
1976 
        $created .= '00000Z';
1977 
        push @args, '-date', $created;
1978 
    }
1979 
 
1980 
    my $log = $versions{$entry}{comment};
1981 
    if ( $log )
1982 
    {
1983 
        push @args, '-log', $log;
1984 
    }
1985 
 
1986 
    #
1987 
    #   Create package skeleton if needed
1988 
    #
1989 
    $rv = createPackage( $author, $created);
1990 
    if ( $rv )
1991 
    {
1992 
        $data->{errStr} = 'Failed to create Package';
1993 
        return 10;
1994 
    }
1995 
 
1996 
    #
1997 
    #   Calculate the label for the target package
1998 
    #   Use format <packageName>_<PackageVersion>
1999 
    #   Need to handle WIPs too.
2000 
    #
2001 
    my $import_label = saneLabel($entry);
2002 
 
2003 
    #
2004 
    #   May need to create the branchpoint
2005 
    #   The process is delayed until its needed so avoid creating unneeded
2006 
    #   branch points
2007 
    #
2008 
    if ( $createBranch )
2009 
    {
2010 
        $rv = createBranchPoint ($entry, $author, $created);
2011 
        $createBranch = 0;
2012 
        $createSuffix = 0;
2013 
        if ( $rv )
2014 
        {
2015 
            $data->{errStr} = 'Failed to create Branch Point';
2016 
            return 11;
2017 
        }
2018 
    }
2019 
    push @args, "-branch=$currentBranchName" if ( defined $currentBranchName );
2020 
 
2021 
    my $datafile = "importdata.$import_label.properties";
2022 
    $rv = JatsToolPrint ( 'jats_svn', 'import', '-reuse' ,
2023 
                    "-package=$svnRepo/$packageNames",
2024 
                    "-dir=$data->{ViewPath}",
2025 
                    "-label=$import_label",
2026 
                    "-datafile=$datafile",
2027 
                    @args,
2028 
                     );
2029 
 
2030 
    if ( $rv )
2031 
    {
2032 
        $data->{errStr} = 'Failed to import to SVN';
2033 
        return 12;
2034 
    }
2035 
 
2429 dpurdie 2036 
    $versions{$entry}{TagCreated} = 1;
2037 
    $firstVersionCreated = $entry unless ( $firstVersionCreated );
2038 
 
1271 dpurdie 2039 
    #
2040 
    #   Read in the Rm Reference
2041 
    #   Retain entries in a global file
2042 
    #
2043 
    if ( -f $datafile  )
2044 
    {
2045 
        my $rmData = JatsProperties::New($datafile);
2046 
        $data->{rmRef} = 'SVN::' . $rmData->getProperty('subversion.tag');
2047 
    }
2048 
 
2049 
    unless ( $data->{rmRef}  )
2050 
    {
2051 
        $data->{errStr} = 'Failed to determine Rm Reference';
2052 
        return 13;
2053 
    }
2054 
 
2429 dpurdie 2055 
######################## Deleted ###############################################
2056 
#
2057 
#
2058 
#    #
2059 
#    #   Add supplemental tags if this version is in a 'Release'
2060 
#    #   But only for some packages - else looks like a mess
2061 
#    #   Just a solution for the ITSO guys
2062 
#    #
2063 
#    foreach my $rtag_id ( keys %{$versions{$entry}{Releases}}  )
2064 
#    {
2065 
#        next unless ( $svnRepo =~ m~/ITSO_TRACS(/|$)~);
2066 
#
2067 
#        my $prog_id = $versions{$entry}{Releases}{$rtag_id}{proj_id};
2068 
#        Message ("Adding Release Tag:$prog_id:$rtag_id");
2069 
#
2070 
#        my $rtext = 'Release_' . saneString($versions{$entry}{Releases}{$rtag_id}{rname});
2071 
#        my @comment;
2072 
#        push @comment, "Tagged by ClearCase to Subversion import";
2073 
#        push @comment, "Project:$prog_id:$versions{$entry}{Releases}{$rtag_id}{pname}";
2074 
#        push @comment, "Release:$rtag_id:$versions{$entry}{Releases}{$rtag_id}{rname}";
2075 
#
2076 
#        $data->{ReleaseTag}{$prog_id}{$rtag_id}{name} = $rtext;
2077 
#
2078 
#        $rv = JatsToolPrint ( 'jats_svnlabel' ,
2079 
#                    '-comment', encode('UTF-8', join("\n", @comment), Encode::FB_DEFAULT),
2080 
#                    $data->{rmRef},
2081 
#                    '-clone',
2082 
#                    $rtext,
2083 
##                    @args,
2084 
#                    '-author=buildadm',
2085 
#                     );
2086 
#        $data->{ReleaseTag}{$prog_id}{$rtag_id}{eState} = $rv;
2087 
#        $data->{ReleaseTag}{tCount}++;
2088 
#
2089 
#        if ( $rv )
2090 
#        {
2091 
#            $data->{ReleaseTag}{eCount}++;
2092 
#            Warning("Failed to add Release Tag: $rtext");
2093 
#        }
2094 
#    }
2095 
#
2096 
######################## Deleted ###############################################
2097 
 
1271 dpurdie 2098 
    Message ("RM Ref: $data->{rmRef}");
2099 
    unlink $datafile;
2100 
 
2101 
    #
2102 
    #   All is good
2103 
    #
2104 
    $data->{errStr} = '';
2105 
    return 0;
2106 
}
2107 
 
2108 
 
2109 
#-------------------------------------------------------------------------------
2110 
# Function        : newProject
2111 
#
2112 
# Description     : Start a new project within a package
2113 
#
2114 
# Inputs          :
2115 
#
2116 
# Returns         :
2117 
#
2118 
sub newProject
2119 
{
2120 
#    Message ("---- New Project");
2121 
    $createSuffix = 0;
2122 
 
2123 
    #
2124 
    #   New project
2125 
    #   Kill the running import directory
2126 
    #
2127 
    RmDirTree ('SvnImportDir');
2128 
}
2129 
 
2130 
#-------------------------------------------------------------------------------
2131 
# Function        : newPackage
2132 
#
2133 
# Description     : Start processing a new package
2134 
#
2135 
# Inputs          :
2136 
#
2137 
# Returns         :
2138 
#
2139 
my $createPackageDone;
2140 
sub newPackage
2141 
{
2142 
#    Message( "---- New Package");
2143 
 
2144 
    #
2145 
    #   Create a package specific log file
2146 
    #
2147 
    $logSummary = $packageNames . ".summary.log";
2148 
    unlink $logSummary;
2149 
    Message( "PackageName: $packageNames");
2150 
    $createPackageDone = 1;
2151 
    $createBranch = 0;
2152 
    $createSuffix = 0;
2153 
 
2154 
    #
2155 
    #   First entry being created
2156 
    #   Prime the work area
2157 
    #
2158 
    RmDirTree ('SvnImportDir');
2159 
}
2160 
 
2161 
#-------------------------------------------------------------------------------
2162 
# Function        : createPackage
2163 
#
2164 
# Description     : Create a new Package in SVN
2165 
#                   Called before any serious SVN operation to ensure that the
2166 
#                   package has been created. Don't create a package until
2167 
#                   we expect to put something into it.
2168 
#
2169 
#                   Will only create a package once
2170 
 
2171 
#
2172 
# Inputs          : $author         - Who done it
2173 
#                   $date           - When
2174 
#
2175 
# Returns         :
2176 
#
2177 
sub createPackage
2178 
{
2179 
    my ($author, $date) = @_;
2180 
    my @opts;
2181 
    push (@opts, '-date', $date) if ( $date );
2182 
    push (@opts, '-author', $author) if ( $author );
2183 
    #
2184 
    #   Only do once
2185 
    #
2186 
    return unless ( $createPackageDone );
2187 
    $createPackageDone = 0;
2188 
 
1272 dpurdie 2189 
    #
2190 
    #   Real import
2191 
    #       Do not Delete package if it exists
2192 
    #       Package must NOT exist
2193 
    #
1271 dpurdie 2194 
    Message ("Creating new SVN package: $packageNames");
1272 dpurdie 2195 
    if ( $opt_delete )
2196 
    {
2197 
        Message ("Delete existing version of package: $packageNames");
2198 
        JatsToolPrint ( 'jats_svn', 'delete-package', '-noerror',  "$svnRepo/$packageNames" );
2199 
    }
2200 
    JatsToolPrint ( 'jats_svn', 'create', "$svnRepo/$packageNames", '-new', @opts );
1271 dpurdie 2201 
}
2202 
 
2203 
 
2204 
#-------------------------------------------------------------------------------
2205 
# Function        : createBranchPoint
2206 
#
2207 
# Description     : Create a branch point for the current work
2208 
#                   Perform the calculation to determine the details of
2209 
#                   the branch point. The work will only be done when its
2210 
#                   needed. This will avoid the creation of branchpoints
2211 
#                   that are not used.
2212 
#
2213 
# Inputs          : $entry                  Entry being processed
2214 
#                   $author         - Who done it
2215 
#                   $date           - When
2216 
#
2217 
# Returns         :
2218 
#
2219 
sub createBranchPoint
2220 
{
2221 
    my ($entry, $author, $date) = @_;
2222 
    my $forceNewProject;
2223 
 
2224 
#    Message ("---- Create Branch Point");
2225 
 
2226 
    #
2227 
    #   Find previous good tag
2228 
    #   We are walking a tree so something should have been created, but
2229 
    #   the one we want may have had an error
2230 
    #
2231 
    #   Walk backwards looking for one that has been created
2232 
    #
2233 
    my $last = $versions{$entry}{last};
2234 
    while ( $last )
2235 
    {
2236 
        unless ( $versions{$last}{TagCreated} )
2237 
        {
2238 
            $last = $versions{$last}{last};
2239 
        }
2240 
        else
2241 
        {
2242 
            last;
2243 
        }
2244 
    }
2245 
 
2246 
    #
2247 
    #   If we have walked back to the base of the tree
2248 
    #   If we transferred any software at all, then use the first
2249 
    #   version as the base for this disconnected version
2250 
    #
2251 
    #   Otherwise we create a new, and empty, view
2252 
    #
2253 
    unless ( $last )
2254 
    {
2255 
        if ( $firstVersionCreated )
2256 
        {
2257 
            Warning ("Cannot find previous version to branch. Use first version");
2258 
            $last = $firstVersionCreated;
2259 
        }
2260 
        else
2261 
        {
2262 
            Warning ("Forcing First instance of a Project");
2263 
            $forceNewProject = 1;
2264 
        }
2265 
    }
2266 
 
2267 
    #
2268 
    #   Determine source name
2269 
    #   This MUST have been created before we can branch
2270 
    #
2271 
    my $src_label;
2272 
    $src_label = saneLabel($last) if $last;
2273 
 
2274 
    #
2275 
    #   Create target name
2276 
    #
2277 
    my $tgt_label;
2278 
    if ( $forceNewProject || $versions{$entry}{newSuffix} || $createSuffix || !defined $src_label )
2279 
    {
2280 
        #
2281 
        #   Create target name based on project
2282 
        #
2283 
        return if ( $singleProject );
2284 
 
2285 
        my $suffix = $versions{$entry}{suffix};
2286 
        if ( $suffix )
2287 
        {
2288 
            Error ("Unknown Project: $suffix") unless ( defined $Projects{$suffix} );
2289 
 
2290 
            #
2291 
            #   If this project can be considered to be a truck, then 'claim' the
2292 
            #   truck for the first created element.
2293 
            #
2294 
            if ( $Projects{$suffix}{Trunk} )
2295 
            {
2296 
                # This project can use the trunk, if it has not been allocated.
2297 
                $ProjectTrunk = $suffix unless ( defined $ProjectTrunk );
2298 
 
2299 
                #
2300 
                #   If this package has multiple instances of the potential
2301 
                #   trunk, then don't place either of them on the trunk as it
2302 
                #   may cause confusion
2303 
                #
2304 
                if ($knownProjects{$suffix}{count} < 2 )
2305 
                {
2306 
                    if ( $suffix eq $ProjectTrunk )
2307 
                    {
2308 
                        return unless $currentBranchName;
2309 
                    }
2310 
                }
2311 
            }
2312 
 
2313 
            $tgt_label = $Projects{$suffix}{Name};
2314 
            $tgt_label = $versions{$entry}{name} . '_' . $tgt_label if ($multiPackages);
2315 
            if ( !exists $ProjectsBaseCreated{$tgt_label}  )
2316 
            {
2317 
                $ProjectsBaseCreated{$tgt_label} = 1;
2318 
            }
2319 
            else
2320 
            {
2321 
                #   Project Base Already taken
2322 
                #   Have disjoint starting points
2323 
                $tgt_label .= '.' . $ProjectsBaseCreated{$tgt_label} ++;
2324 
            }
2325 
        }
2326 
        else
2327 
        {
2328 
            #
2329 
            #   No suffix in use
2330 
            #
2331 
            #   Currently not handled
2332 
            #   May have to force the use of the trunk
2333 
            #
2334 
            Error ("INTERNAL ERROR: No suffix present");
2335 
        }
2336 
    }
2337 
    else
2338 
    {
2339 
        $tgt_label = saneLabel($entry, $src_label . '_for_');
2340 
    }
2341 
 
2342 
    #
2343 
    #   Save branch name for use when populating sandbox
2344 
    #
2345 
    $currentBranchName = $tgt_label;
2346 
 
2347 
    #
2348 
    #   Perform the branch
2349 
    #
2350 
    if ( defined $src_label )
2351 
    {
2429 dpurdie 2352 
        #
2353 
        #   The 'clone' operation will backtrack the branch point
2354 
        #   to the source of the label. This will make the output version
2355 
        #   tree much prettier
2356 
        #
1271 dpurdie 2357 
        my @opts;
2358 
        push (@opts, '-date', $date) if ( $date );
2359 
        push (@opts, '-author', $author) if ( $author );
2360 
 
2361 
        JatsToolPrint ( 'jats_svnlabel',
2362 
                        '-packagebase', "$svnRepo/$packageNames",
2363 
                        'tags/' . $src_label,
2364 
                        '-branch',
2365 
                        '-clone', $tgt_label,
2366 
                        @opts
2367 
                      );
2368 
    }
2369 
}
2370 
 
2371 
 
2372 
#-------------------------------------------------------------------------------
2373 
# Function        : endPackage
2374 
#
2375 
# Description     : End of package processing
2376 
#                   Clean up and display problems
2377 
#
2378 
# Inputs          :
2379 
#
2380 
# Returns         :
2381 
#
2382 
sub endPackage
2383 
{
2429 dpurdie 2384 
    Message ("-- Import Summary ------------------------------------------------" );
1271 dpurdie 2385 
    RmDirTree ('SvnImportDir');
2386 
 
2387 
    #
2388 
    #   Display versions that did get captured
2389 
    #
2390 
    foreach my $entry ( @processOrder )
2391 
    {
2392 
        $versions{$entry}{Scanned} = 1;
2393 
        next unless ( $versions{$entry}{TagCreated} );
2394 
        Warning ("Processed: " . GetVname($entry) . ' :: ' . $versions{$entry}{rmRef} || $versions{$entry}{errStr} || '???' );
2395 
    }
2396 
 
2397 
    #
2398 
    #   Display versions that did not get created
2399 
    #
2400 
    foreach my $entry ( @processOrder )
2401 
    {
2402 
        $versions{$entry}{Scanned} = 1;
2403 
        next if ( $versions{$entry}{TagCreated} );
2429 dpurdie 2404 
        my $reason = $versions{$entry}{data}{errStr} || '';
2405 
        my $tag = $versions{$entry}{vcsTag}|| 'No Tag';
2406 
        Warning ("Not Processed: " . GetVname($entry) . ':' . $tag . ' : ' . $reason );
1271 dpurdie 2407 
    }
2408 
 
2409 
    foreach my $entry ( keys(%versions) )
2410 
    {
2411 
        next if ( $versions{$entry}{Scanned} );
2412 
        Warning ("(E) INTERNAL ERROR. Package Not Processed: " . GetVname($entry) );
2413 
    }
2414 
 
2429 dpurdie 2415 
    Message ("Packages Relabled: $packageReLabelCount") if ( $packageReLabelCount );
1271 dpurdie 2416 
    Message ("All Done");
2417 
}
2418 
 
2419 
#-------------------------------------------------------------------------------
2429 dpurdie 2420 
# Function        : extractFilesFromClearCase
2421 
#
2422 
# Description     : Extract files from ClearCase
2423 
#                   May take a while as we handle nasty errors
2424 
#
2425 
# Inputs          : $data           - Hash of good stuff from newPackageVersionBody
2426 
#                   $cc_path
2427 
#                   $cc_label
2428 
#
2429 
# Returns         : exit code
2430 
#                   Sets up
2431 
#                       $data->{errStr}
2432 
#                       $data->{errCode}
2433 
#                   As per newPackageVersionBody
2434 
#
2435 
sub extractFilesFromClearCase
2436 
{
2437 
    my ($data, $cc_path, $cc_label) = @_;
2438 
    my $tryCount = 0;
2439 
    my $rv = 99;
2440 
 
2441 
    $data->{ViewRoot} = $opt_name ? $opt_name : "$cc_label";
2442 
    $data->{ViewPath} =  $data->{ViewRoot} . $cc_path;
2443 
 
2444 
    if ( $opt_preserveProjectBase )
2445 
    {
2446 
        my $cc_vob = $cc_path;
2447 
        $cc_vob =~ s~^/~~;
2448 
        $cc_vob =~ s~/.*~~;
2449 
        $data->{ViewPath} =  $data->{ViewRoot} . '/' . $cc_vob;
2450 
        Message ("Preserving Project Base");
2451 
    }
2452 
    $data->{ViewPath} =~  tr~/~/~s;
2453 
 
2454 
    if ( $opt_reuse && -d $data->{ViewPath}  )
2455 
    {
2456 
        Message ("Reusing view: $cc_label");
2457 
        return 0;
2458 
    }
2459 
 
2460 
    while ( $rv == 99 ) {
2461 
        my @args;
2462 
        push (@args, '-view', $opt_name ) if ( defined $opt_name );
2463 
        $rv = JatsToolPrint ( 'jats_ccrelease', '-extractfiles', '-root=.' , '-noprefix',
2464 
                    "-label=$cc_label" ,
2465 
                    "-path=$cc_path",
2466 
                    @args
2467 
                    );
2468 
 
2469 
        if ( $rv == 10 ) {
2470 
 
2471 
            #
2472 
            #   No files found
2473 
            #   If this is the first time then try really hard to find them
2474 
            #
2475 
            unless ( $tryCount++ )
2476 
            {
2477 
                if ( $opt_relabel )
2478 
                {
2479 
                    $packageReLabelCount++;
2480 
                    $rv = JatsToolPrint('cc2svn_labeldirs',
2481 
                                            '-vob', $cc_path,
2482 
                                            $cc_label,
2483 
                                            );
2484 
                    $data->{DirsLabled} = 100 + $rv;
2485 
                }
2486 
 
2487 
                #
2488 
                #   Second attempt - massage the users path
2489 
                #   We should have labled up to the VOB root so lets
2490 
                #   just use the VOB and not the path
2491 
                #
2492 
                #   If we are not relabeling then we can still do this
2493 
                #   in an attempt to fix user stupidity
2494 
                #
2495 
                $cc_path =~ s~^/~~;
2496 
                $cc_path =~ s~/.*~~;
2497 
                $cc_path = '/' . $cc_path;
2498 
                $data->{ViewPath} =  $data->{ViewRoot} . $cc_path;
2499 
                redo;
2500 
            }
2501 
 
2502 
            $data->{errStr}  = 'No Files in the extracted view';
2503 
            $data->{errCode} = '0';
2504 
            return 2;
2505 
        }
2506 
        elsif ( $rv == 11 ) {
2507 
            $data->{errStr} = 'Label not found';
2508 
            $data->{errCode} = 'L';
2509 
            return 2;
2510 
        }
2511 
 
2512 
        unless ( -d $data->{ViewPath}  )
2513 
        {
2514 
            $data->{errStr} = 'Failed to extract files from CC';
2515 
            return 2;
2516 
        }
2517 
 
2518 
        #
2519 
        #   Looks good
2520 
        #
2521 
        return 0;
2522 
    };
2523 
 
2524 
    $data->{errStr}  = 'No Files in the extracted view after labeling dirs';
2525 
    $data->{errCode} = '0';
2526 
    return 2;
2527 
 
2528 
}
2529 
 
2530 
#-------------------------------------------------------------------------------
2439 dpurdie 2531 
# Function        : detectMakeProjectUsage
2532 
#
2533 
# Description     : etect and report usage of the MakeProject directive
2534 
#
2535 
# Inputs          : $data               - Ref to a hash of bits
2536 
#                   $cc_path            - Packages cc_path
2537 
#
2538 
# Returns         : true    - Bad usage (Really good usage not detected)
2539 
#                   false   - Good usage detected
2540 
#
2541 
sub detectMakeProjectUsage
2542 
{
2543 
    my ($data, $cc_path) = @_;
2544 
    my $retval = 0;
2545 
    my $eSuf = $opt_ignoreMakeProjectErrors ? '' : 'Error';
2546 
 
2547 
    #
2548 
    #   Find makefile.pl
2549 
    #
2550 
    Message ("Locate JATS makefiles");
2551 
    my $usesMakeProject = 0;
2552 
    my $badIncludeFile = 0;
2553 
 
2554 
    my $search = JatsLocateFiles->new("--Recurse=1",
2555 
                                       "--FilterIn=makefile.pl",
2556 
                                       );
2557 
    my @makefiles = $search->search($data->{ViewRoot});
2558 
    foreach my $file ( @makefiles )
2559 
    {
2560 
#print "---Reading: $workDir/$data->{ViewRoot}/$file\n";
2561 
        if ( open( my $fh, '<', "$data->{ViewRoot}/$file" ) )
2562 
        {
2563 
            my $eof = 0;
2564 
            my $line = '';
2565 
            until ( $eof )
2566 
            {
2567 
                my $in = <$fh>;
2568 
                unless ( defined $in )
2569 
                {
2570 
                    $eof = 1;
2571 
                }
2572 
                else
2573 
                {
2574 
                $in =~ s~\s+$~~;
2575 
                $in =~ s~^\s+~~;
2576 
                $in =~ s~^#.*$~~;
2577 
                $in =~ s~\s*[^\$]#.*$~~;
2578 
                $line .= ' ' if ( $line );
2579 
                $line .= $in;
2580 
                $line =~ s~\s+~ ~g;
2581 
#print "====== '$line'\n";
2582 
                redo unless ( $line =~ m~;$~  );
2583 
                }
2584 
#print "---- $line\n";
2585 
                if ( $line =~ m~^MakeProject~ )
2586 
                {
2587 
                    $usesMakeProject++;
2588 
                    $data->{UsesMakeProject}++;
2589 
                    Warning ("Package uses MakeProject:",
2590 
                             "Line: " . $line,
2591 
                             "Root: " . "$data->{ViewRoot}",
2592 
                             "File: " . "$data->{ViewRoot}/$file",
2593 
                            );
2594 
 
2595 
                    #
2596 
                    #   Extract out the project name
2597 
                    #
2598 
                    my @myArgs;
2599 
                    my $myProjectDir;
2600 
                    my $myProject = "$data->{ViewRoot}/$file";
2601 
                    $myProject =~ s~/[^/]+$~~;
2602 
                    $line =~ s~MakeProject~push \@myArgs,~;
2603 
                    eval $line;
2604 
                    Error("Line did not compiler: $line", "Err: $@" ) if ($@);
2605 
                    shift @myArgs;
2606 
                    foreach ( @myArgs )
2607 
                    {
2608 
                        next if ( m~^--~ );
2609 
                        $myProject .= '/' . $_;
2610 
                        $myProjectDir = $myProject;
2611 
                        $myProjectDir =~ s~/[^/]+$~~;
2612 
                        last;
2613 
                    }
2614 
                    Error ("No project Found") unless ( defined $myProjectDir);
2615 
                    if ( -f "$myProjectDir/include.txt" )
2616 
                    {
2617 
                        Warning ("Co-located 'include.txt' file also found");
2618 
                    }
2619 
 
2620 
                    # The only problem is if the include.txt file
2621 
                    # escapes from the VOB - or even uses the vob root
2622 
                    #
2623 
                    # Examine the include file
2624 
                    # Expect it to look like
2625 
                    #   /I Path
2626 
                    #
2627 
 
2628 
                    #
2629 
                    #   Determine safe level
2630 
                    #   Relative to the include file
2631 
                    #
2632 
                    my $depthPath = $myProjectDir;
2633 
                    my $depth = 0;
2634 
                    Error ("Expect this to work") unless ( $depthPath =~ s~^$data->{ViewRoot}/~~ );
2635 
                    foreach ( split('/', $depthPath) )
2636 
                    {
2637 
                        if ( $_ eq '..' ) {
2638 
                            $depth--;
2639 
                        } else {
2640 
                            $depth++;
2641 
                        }
2642 
                    }
2643 
#print "Depth: $depth, $depthPath\n";
2644 
 
2645 
                    if ( open( my $if, '<', "$myProjectDir/include.txt" ) )
2646 
                    {
2647 
                        while ( <$if> )
2648 
                        {
2649 
                            s~\s+$~~;
2650 
                            s~^\s+~~;
2651 
                            next unless ( $_ );
2652 
                            if ( m~/I\s+(.*)~ )
2653 
                            {
2654 
                                my $path = $1;
2655 
                                $path =~ tr~\\/~/~s;
2656 
                                $path =~ s~\\~/~g;
2657 
#print "Examine: $path\n";
2658 
                                my $minLevel = 0;
2659 
                                my $level = 0;
2660 
                                foreach ( split('/', $path) )
2661 
                                {
2662 
                                    if ( $_ eq '..' )
2663 
                                    {
2664 
                                        $level--;
2665 
                                        $minLevel = $level if ($level < $minLevel);
2666 
                                    }
2667 
                                    else
2668 
                                    {
2669 
                                        $level++;
2670 
                                    }
2671 
                                }
2672 
#print "Min: $minLevel, $level, ($depth + $minLevel)\n";
2673 
                                if ( $depth + $minLevel <= 0)
2674 
                                {
2675 
                                    $badIncludeFile++;
2676 
                                    Warning ("Included path escapes package:",
2677 
                                             "Line: " . $_,
2678 
                                             "File: " . "$myProjectDir/include.txt",
2679 
                                            );
2680 
                                    last;
2681 
                                }
2682 
                            }
2683 
                        }
2684 
                        close $if;
2685 
                    }
2686 
 
2687 
                }
2688 
                $line = '';
2689 
            }
2690 
            close $fh;
2691 
        }
2692 
        else
2693 
        {
2694 
            Warning ("MakeProject$eSuf - Cannot open makefile: $file");
2695 
            $retval = 1;
2696 
        }
2697 
    }
2698 
 
2699 
    #
2700 
    #   Used
2701 
    #   May be improved latter
2702 
    #
2703 
    if ( $usesMakeProject && $badIncludeFile)
2704 
    {
2705 
        Warning ("MakeProject$eSuf - Problem detected");
2706 
        $retval = 1;
2707 
    }
2708 
 
2709 
    #
2710 
    #   Until we have more faith in the detection algorithm
2711 
    #
2712 
    if ( $usesMakeProject )
2713 
    {
2714 
        Warning ("MakeProject$eSuf - Makeproject used. Must check manually");
2715 
        $retval = 1;
2716 
    }
2717 
 
2718 
    return $retval;
2719 
}
2720 
 
2721 
#-------------------------------------------------------------------------------
1271 dpurdie 2722 
# Function        : detectProjectBaseUsage
2723 
#
2724 
# Description     : Detect and report usage of the SetProjectBase directive
2725 
#
2726 
# Inputs          : $data               - Ref to a hash of bits
2727 
#                   $cc_path            - Packages cc_path
2728 
#
2729 
# Returns         : true    - Bad usage (Really good usage not detected)
2730 
#                   false   - Good usage detected
2731 
#
2732 
sub detectProjectBaseUsage
2733 
{
2734 
    my ($data, $cc_path) = @_;
2735 
    my $retval = 0;
2736 
    my $eSuf = $opt_ignoreProjectBaseErrors ? '' : 'Error';
2737 
 
2738 
    #
2739 
    #   Find makefile.pl
2740 
    #
2741 
    Message ("Locate JATS makefiles");
2742 
    my $usesProjectBase = 0;
2743 
    my $definesProjectBase = 0;
2744 
    my $definitionError = 0;
2745 
 
2746 
    my $search = JatsLocateFiles->new("--Recurse=1",
2747 
                                       "--FilterIn=makefile.pl",
2748 
                                       );
2749 
    my @makefiles = $search->search($data->{ViewRoot});
2750 
    foreach my $file ( @makefiles )
2751 
    {
2752 
        if ( open( my $fh, '<', "$data->{ViewRoot}/$file" ) )
2753 
        {
2754 
            while ( <$fh> )
2755 
            {
2756 
                s~\s+$~~;
2757 
                s~^\s+~~;
2758 
                next if ( m~^#~ );
2759 
 
2760 
                if ( m~\$ProjectBase~ )
2761 
                {
2762 
                    $usesProjectBase++;
2763 
                    Message ("Project Base Use: $_");
2764 
                    $data->{UsesProjectBase}++;
2765 
                }
2766 
 
2767 
                if ( m~^SetProjectBase~ )
2768 
                {
2769 
                    $definesProjectBase++;
2770 
                    $data->{DefinesProjectBase}++;
2429 dpurdie 2771 
                    Warning ("Package initialises SetProjectBase:",
1271 dpurdie 2772 
                             "Line: " . $_,
2773 
                             "Root: " . "$data->{ViewRoot}",
2774 
                             "File: " . "$data->{ViewRoot}/$file",
2775 
                            );
2776 
 
2777 
                    # The only problem is if the user attempts to escape
2778 
                    # from the root of the view.
2779 
                    #
2780 
                    # Examine the depth of the makefile with the directive
2781 
                    # Examine the depth of the view base
2782 
                    #
2783 
                    #
2784 
                    # Locate the build.pl file
2785 
                    # This is the basis for for the directive
2786 
                    #
2787 
                    my $blevel;
2788 
                    my @bpaths = split ('/', $file );
2789 
                    while ( @bpaths )
2790 
                    {
2791 
                        $bpaths[-1] = 'build.pl';
2792 
                        my $bfile = join '/', @bpaths ;
2793 
                        if ( -f "$data->{ViewRoot}/$bfile" )
2794 
                        {
2795 
                            $blevel = scalar @bpaths;
2796 
                            last;
2797 
                        }
2798 
                        pop @bpaths;
2799 
                    }
2800 
                    unless (defined $blevel)
2801 
                    {
2802 
                        Warning ("SetProjectBase$eSuf calculation failed - can't find build.pl");
2429 dpurdie 2803 
#                        $retval = 1;
2804 
                         $definitionError++;
1271 dpurdie 2805 
                    }
2806 
                    else
2807 
                    {
2808 
                        #
2809 
                        #   Determine the depth of the view root
2810 
                        #   This is given by cc_path, but cc_path has a leading /
2811 
                        #
2812 
                        my @cpaths = split ('/', $cc_path );
2813 
                        my $clevel = (scalar @cpaths) - 1;
2814 
                        my $max_up = $blevel - $clevel - 1;
2815 
 
2816 
                        m~--Up=(\d+)~i;
2817 
                        my $ulevel = $1;
2818 
                        if ( defined $ulevel )
2819 
                        {
2820 
                            my @paths = split ('/', $file );
2821 
                            my $plevel = scalar @paths;
2822 
 
2823 
#print "--- blevel: $blevel\n";
2824 
#print "--- bpaths: @bpaths\n";
2825 
#print "--- ulevel: $ulevel\n";
2826 
#print "--- paths: @paths\n";
2827 
#print "--- plevel: $plevel\n";
2828 
#print "--- cpaths: @cpaths\n";
2829 
#print "--- clevel: $clevel\n";
2830 
#print "--- max_up: $max_up\n";
2831 
 
2832 
                            if ( $ulevel > $max_up )
2833 
                            {
2834 
                                Warning ("SetProjectBase escapes view. MaxUp: $max_up, Up: $ulevel");
2835 
                                $definitionError++;
2836 
                            }
2837 
                        }
2838 
                        else
2839 
                        {
2840 
                            $retval = 1;
2841 
                            Warning ("SetProjectBase$eSuf MAY escape view - can't detect level")
2842 
                        }
2843 
                    }
2844 
                }
2845 
            }
2846 
            close $fh;
2847 
        }
2848 
        else
2849 
        {
2850 
            Warning ("SetProjectBase$eSuf - Cannot open makefile: $file");
2851 
            $retval = 1;
2852 
        }
2853 
    }
2854 
 
2855 
    #
2856 
    #   Detect defined, but not used
2857 
    #
2858 
    if ( $usesProjectBase && ! $definesProjectBase )
2859 
    {
2860 
        Warning ("SetProjectBase - Uses ProjectBase without defining it");
2861 
    }
2862 
 
2863 
    if ( ! $usesProjectBase && $definesProjectBase )
2864 
    {
2865 
        Warning ("SetProjectBase - Defines ProjectBase without using it");
2866 
    }
2867 
 
2868 
    if ( $usesProjectBase && $definesProjectBase && $definitionError )
2869 
    {
2870 
        Warning ("SetProjectBase$eSuf - Problem detected");
2871 
        $retval = 1;
2872 
    }
2873 
    return $retval;
2874 
}
2875 
 
1272 dpurdie 2876 
#-------------------------------------------------------------------------------
2877 
# Function        : findDirWithStuff
2878 
#
2879 
# Description     : Find a directory that contains more than just another subdir
2429 dpurdie 2880 
#                   Note: don't use 'glob' it doesn't work if the name has a space in it.
1272 dpurdie 2881 
#
2882 
# Inputs          : $base               - Start of the scan
2883 
#
2884 
# Returns         : Path to dir with more than just a single dir in it
2885 
#
2886 
sub findDirWithStuff
2887 
{
2888 
    my ($base) = @_;
1271 dpurdie 2889 
 
1272 dpurdie 2890 
    while ( $base )
2891 
    {
2892 
    my $fileCount = 0;
2893 
    my $dirCount = 0;
2429 dpurdie 2894 
    my $firstDir;
1272 dpurdie 2895 
 
2429 dpurdie 2896 
    opendir (my $dh, $base ) || Error ("Cannot opendir $base. $!");
2897 
    my @list =readdir $dh;
2898 
    closedir $dh;
1272 dpurdie 2899 
    foreach ( @list )
2900 
    {
2901 
        next if ( $_ eq '.' );
2902 
        next if ( $_ eq '..' );
2429 dpurdie 2903 
 
2904 
        $_ = $base . '/' . $_;
1272 dpurdie 2905 
        if ( -d $_ )
2906 
        {
2907 
            $dirCount++;
2429 dpurdie 2908 
            $firstDir = $_ unless ( defined $firstDir );
2909 
            return $base
2910 
                if ( $dirCount > 1  )
1272 dpurdie 2911 
        }
2429 dpurdie 2912 
        elsif ( -e $_ )
1272 dpurdie 2913 
        {
2914 
            return $base;
2915 
        }
2429 dpurdie 2916 
 
2917 
        # else its probably a dead symlink
1272 dpurdie 2918 
    }
2429 dpurdie 2919 
 
2920 
    return $base
2921 
        unless ( $dirCount == 1  );
2922 
    $base = $firstDir;
1272 dpurdie 2923 
    }
2924 
}
2925 
 
1271 dpurdie 2926 
#-------------------------------------------------------------------------------
2927 
# Function        : JatsToolPrint
2928 
#
2929 
# Description     : Print and Execuate a JatsTool command
2930 
#
2931 
# Inputs          :
2932 
#
2933 
# Returns         :
2934 
#
2935 
 
2936 
sub JatsToolPrint
2937 
{
2938 
    Information ("Command: @_");
2939 
    JatsTool @_;
2940 
}
2941 
 
2942 
sub GetVname
2943 
{
2944 
    my ($entry) = @_;
2945 
    my $me = 'NONE';
2946 
    if ( $entry )
2947 
        {
2948 
        $me = $versions{$entry}{vname};
2949 
        unless ( $me )
2950 
        {
2951 
            $me = 'Unknown-' . $entry;
2952 
        }
2953 
    }
2954 
    return $me;
2955 
}
2956 
 
2429 dpurdie 2957 
#-------------------------------------------------------------------------------
2958 
# Function        : saneLabel
2959 
#
2960 
# Description     : Generate a sane version label
2961 
#                   Handle suplicates (due to character squishing)
2962 
#                   Cache results for repeatability
2963 
#
2964 
# Inputs          : $entry          - Version info
2965 
#                   $pkgname        - Alternate pkgname (branching)
2966 
#
2967 
# Returns         : Sane string
2968 
#
1271 dpurdie 2969 
sub saneLabel
2970 
{
2971 
    my ($entry, $pkgname) = @_;
2972 
    my $me;
2429 dpurdie 2973 
    $me = $versions{$entry}{vname};
2974 
    $pkgname = $versions{$entry}{name} unless ( defined $pkgname );
1271 dpurdie 2975 
 
2429 dpurdie 2976 
    #
2977 
    #   If we have calculated it, then reuse it.
2978 
    #
2979 
    if ( exists $versions{$entry}{saneLabel}{$pkgname} )
1271 dpurdie 2980 
    {
2429 dpurdie 2981 
        return $versions{$entry}{saneLabel}{$pkgname};
1271 dpurdie 2982 
    }
2983 
 
2429 dpurdie 2984 
 
1271 dpurdie 2985 
    Error ("Package does have a version string: pvid: $entry")
2986 
        unless ( defined $me );
2987 
 
2988 
    #
2989 
    #   Convert Wip format (xxxx) into a string that can be used for a label
2990 
    #
2991 
    if ( $me =~ m~^(.*)\((.*)\)(.*)$~ )
2992 
    {
2993 
        $me = $1 . '_' . $2 . '_' . $3 . '.WIP';
2994 
        $me =~ s~_\.~.~;
2995 
        $me =~ s~^_~~;
2996 
    }
2997 
 
2998 
    #
2999 
    #   Allow for WIPS
3000 
    #   Get rid of multiple '_'
3001 
    #   Replace space with -
3002 
    #
3003 
    $me = $pkgname . '_' . $me;
3004 
    $me =~ tr~ ~-~s;
3005 
    $me =~ tr~-~-~s;
3006 
    $me =~ tr~_~_~s;
3007 
 
2429 dpurdie 3008 
    #
3009 
    #   Due to some sillyness ( package version starting with _ )
3010 
    #   we may get duplicates. Detect and allocate different numbers
3011 
    #
3012 
    if ( exists $saneLabels{$me} )
3013 
    {
3014 
        $saneLabels{$me}++;
3015 
        $me = $me . '.' . $saneLabels{$me};
3016 
        Message ("Duplicate SaneLabel resolved as: $me");
3017 
    }
3018 
    else
3019 
    {
3020 
        $saneLabels{$me} = 0;
3021 
    }
3022 
 
3023 
    #
3024 
    #   Cache value
3025 
    #
3026 
    $versions{$entry}{saneLabel}{$pkgname} = $me;
1271 dpurdie 3027 
    return $me;
3028 
}
3029 
 
2429 dpurdie 3030 
sub saneString
3031 
{
3032 
    my ($string) = @_;
3033 
    #
3034 
    #   Get rid of multiple '_'
3035 
    #   Replace space with -
3036 
    #
3037 
    $string =~ s~\W~_~g;
3038 
    $string =~ tr~ ~_~s;
3039 
    $string =~ tr~_-~-~s;
3040 
    $string =~ tr~-_~-~s;
3041 
    $string =~ tr~-~-~s;
3042 
    $string =~ tr~_~_~s;
3043 
    $string =~ s~-$~~;
3044 
    $string =~ s~_$~~;
1271 dpurdie 3045 
 
2429 dpurdie 3046 
    return $string;
3047 
}
3048 
 
3049 
 
1271 dpurdie 3050 
exit 0;
3051 
 
3052 
 
3053 
#-------------------------------------------------------------------------------
3054 
# Function        : GetPkgIdByName
3055 
#
3056 
# Description     :
3057 
#
3058 
# Inputs          : pkg_name
3059 
#
3060 
# Returns         : pkg_id
3061 
#
3062 
sub GetPkgIdByName
3063 
{
3064 
    my ( $pkg_name ) = @_;
3065 
    my (@row);
3066 
    my $pv_id;
3067 
    my $pkg_id;
3068 
 
3069 
    #
3070 
    #   Establish a connection to Release Manager
3071 
    #
3072 
    connectRM(\$RM_DB) unless ( $RM_DB );
3073 
 
3074 
    #
3075 
    #   Extract data from Release Manager
3076 
    #
3077 
    my $m_sqlstr = "SELECT pkg.PKG_NAME, pkg.PKG_ID" .
3078 
                   " FROM RELEASE_MANAGER.PACKAGES pkg" .
3079 
                   " WHERE pkg.PKG_NAME = \'$pkg_name\'";
3080 
 
3081 
    my $sth = $RM_DB->prepare($m_sqlstr);
3082 
    if ( defined($sth) )
3083 
    {
3084 
        if ( $sth->execute( ) )
3085 
        {
3086 
            if ( $sth->rows )
3087 
            {
3088 
                while ( @row = $sth->fetchrow_array )
3089 
                {
3090 
                    Verbose( "DATA: " . join(',', @row) );
3091 
                    $pkg_id = $row[1] || 0;
3092 
                    last;
3093 
                }
3094 
            }
3095 
            else
3096 
            {
3097 
                Error ("GetPkgIdByName:No Data for package: $pkg_name");
3098 
            }
3099 
            $sth->finish();
3100 
        }
3101 
    }
3102 
    else
3103 
    {
3104 
        Error("GetPkgIdByName:Prepare failure" );
3105 
    }
3106 
 
3107 
    return $pkg_id;
3108 
}
3109 
 
3110 
#-------------------------------------------------------------------------------
3111 
# Function        : GetData_by_pkg_id
3112 
#
3113 
# Description     :
3114 
#
3115 
# Inputs          : pv_id
3116 
#
3117 
# Returns         :
3118 
#
3119 
sub GetData_by_pkg_id
3120 
{
3121 
    my ( $pkg_id, $packageName ) = @_;
3122 
    my (@row);
3123 
 
3124 
    #
3125 
    #   Establish a connection to Release Manager
3126 
    #
3127 
    Message ("Extract package versions from Release Manager: $packageName");
3128 
    connectRM(\$RM_DB) unless ( $RM_DB );
3129 
 
3130 
    #
3131 
    #   Extract data from Release Manager
3132 
    #
2429 dpurdie 3133 
    my $m_sqlstr = "SELECT " .
3134 
                       "pkg.PKG_NAME, " .                                       # row[0]
3135 
                       "pv.PKG_VERSION, " .                                     # row[1]
3136 
                       "pkg.PKG_ID, " .                                         # row[2]
3137 
                       "pv.PV_ID, " .                                           # row[3]
3138 
                       "pv.LAST_PV_ID, " .                                      # row[4]
3139 
                       "pv.MODIFIED_STAMP, " .                                  # row[5]
3140 
                       "release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), " .  # row[6]
3141 
                       "amu.USER_NAME, " .                                      # row[7]
3142 
                       "pv.COMMENTS, " .                                        # row[8]
3143 
                       "pv.DLOCKED, " .                                         # row[9]
3144 
                       "pv.CREATOR_ID, ".                                       # row[10]
3145 
                       "pv.BUILD_TYPE ".                                        # row[11]
3146 
                   " FROM " .
3147 
                        "RELEASE_MANAGER.PACKAGES pkg, " .
3148 
                        "RELEASE_MANAGER.PACKAGE_VERSIONS pv, " .
3149 
                        "ACCESS_MANAGER.USERS amu" .
3150 
                   " WHERE " .
3151 
                        "pv.PKG_ID = \'$pkg_id\' " .
3152 
                        "AND pkg.PKG_ID = pv.PKG_ID " .
3153 
                        "AND amu.USER_ID (+) = pv.CREATOR_ID";
3154 
 
1271 dpurdie 3155 
    my $sth = $RM_DB->prepare($m_sqlstr);
3156 
    if ( defined($sth) )
3157 
    {
3158 
        if ( $sth->execute( ) )
3159 
        {
3160 
            if ( $sth->rows )
3161 
            {
3162 
                while ( @row = $sth->fetchrow_array )
3163 
                {
3164 
                    Verbose( "DATA: " . join(',', @row) );
3165 
                    my $pkg_name = $row[0] || 'Unknown';
3166 
                    my $pkg_ver = $row[1] || 'Unknown';
3167 
                       $pkg_ver =~ s~\s+$~~;
3168 
                       $pkg_ver =~ s~^\s+~~;
3169 
                    my $pv_id = $row[3] || 'Unknown';
3170 
                    my $last_pv_id = $row[4];
3171 
                    my $created =  $row[5] || 'Unknown';
3172 
                    my $vcstag =  $row[6] || 'Unknown';
3173 
 
3174 
                    my $created_id =  $row[7] || ($row[10] ? "Userid_$row[10]" :'Unknown');
3175 
                    my $comment =  $row[8] || '';
3176 
                    my $locked =  $row[9] || 'N';
2429 dpurdie 3177 
                    my $manual = $row[11] || 'M';
1271 dpurdie 3178 
 
3179 
                    #
3180 
                    #   Some developers have a 'special' package version
3181 
                    #   We really need to ignore them
3182 
                    #
3183 
                    next if ( $pkg_ver eq '23.23.23.ssw' );
3184 
 
3185 
                    #
3186 
                    #   Add data to the hash
3187 
                    #       Remove entries that address themselves
3188 
                    #
3189 
                    push (@{$versions{$last_pv_id}{next}}, $pv_id) unless ($pv_id == $last_pv_id || $last_pv_id == 0) ;
3190 
                    $versions{$pv_id}{name} = $pkg_name;
3191 
                    $versions{$pv_id}{pvid} = $pv_id;
3192 
                    $versions{$pv_id}{vname} = $pkg_ver;
3193 
                    $versions{$pv_id}{vcsTag} = $vcstag;
3194 
                    $versions{$pv_id}{created} = $created;
3195 
                    $versions{$pv_id}{created_id} = $created_id;
3196 
                    $versions{$pv_id}{comment} = $comment;
3197 
                    $versions{$pv_id}{locked} = $locked;
3198 
                    $versions{$pv_id}{TimeStamp} = str2time( $created );
3199 
                    $versions{$pv_id}{Age} = ($now - $versions{$pv_id}{TimeStamp}) / (60 * 60 * 24);
3200 
                    $versions{$pv_id}{TooOld} = 1 if ( $opt_age && $opt_age <= $versions{$pv_id}{Age} );
2429 dpurdie 3201 
                    $versions{$pv_id}{BuildType} = $manual;
1271 dpurdie 3202 
                    examineVcsTag($pv_id);
3203 
 
3204 
                    #
3205 
                    #   Process version number
3206 
                    #
3207 
                    my ($suffix, $version, $isaR, $isaWip, $buildVersion ) = massageVersion($pkg_ver, $pkg_name);
3208 
 
3209 
                    $versions{$pv_id}{version} = $version;
3210 
                    $versions{$pv_id}{buildVersion} = $buildVersion;
3211 
                    $versions{$pv_id}{isaWip} = 1 if ( $isaWip );
3212 
 
3213 
                    #
2429 dpurdie 3214 
                    #   New methof for detecting a ripple
3215 
                    #       Don't look at the version number
3216 
                    #       Use RM data
3217 
                    #       Inlude the comment - there are some cases where the comment
3218 
                    #       appears to have been user modified.
3219 
                    #
3220 
#                    $versions{$pv_id}{isaRipple} = 1 if ( $isaR );
3221 
#                    $versions{$pv_id}{isaRipple} = 1 if ( uc($manual) eq 'Y' );
3222 
                    $versions{$pv_id}{isaRipple} = ( $comment =~ m~^Rippled Build~i && ( uc($manual) eq 'Y' ));
3223 
 
3224 
                    #
1271 dpurdie 3225 
                    #   Process suffix
3226 
                    #
3227 
                    $suffix = 'Unknown' unless ( $suffix );
3228 
                    $suffix = lc ($suffix);
3229 
                    $versions{$pv_id}{suffix} = $suffix;
3230 
                    push @{$suffixes{$suffix}}, $pv_id;
3231 
 
3232 
#                    print "$pkg_name, $pkg_ver, $pv_id, $last_pv_id, $locked, $created, $created_id, $suffix\n";
3233 
                }
3234 
            }
3235 
            else
3236 
            {
3237 
                Error ("GetData_by_pkg_id: No Data: $m_sqlstr");
3238 
            }
3239 
            $sth->finish();
3240 
        }
3241 
        else
3242 
        {
3243 
                Error ("GetData_by_pkg_id: Execute: $m_sqlstr");
3244 
        }
3245 
    }
3246 
    else
3247 
    {
3248 
        Error("GetData_by_pkg_id:Prepare failure" );
3249 
    }
3250 
}
3251 
 
3252 
#-------------------------------------------------------------------------------
3253 
# Function        : massageVersion
3254 
#
3255 
# Description     : Process a version number and return usful bits
3256 
#
3257 
# Inputs          : Version Number
3258 
#                   Package Name - debug only
3259 
#
3260 
# Returns         : An array
3261 
#                       suffix
3262 
#                       multipart version string useful for text comparisons
3263 
#
3264 
sub massageVersion
3265 
{
3266 
    my ($version, $name) = @_;
3267 
    my ($major, $minor, $patch, $build, $suffix);
3268 
    my $result;
3269 
    my $buildVersion;
3270 
    my $isaRipple;
3271 
    my $isaWIP;
3272 
    $build = 0;
3273 
 
3274 
#print "--- $name, $version\n";
3275 
    $version =~ s~^_~~;
3276 
    $version =~ s~^${name}_~~;
3277 
 
3278 
    #
3279 
    #   xxxxxxxxx.nnnn.cots
3280 
    #
3281 
    if ( $version =~ m~(.*)\.cots$~ ) {
3282 
        my $cots_base = $1;
3283 
        $suffix = '.cots';
3284 
        if ( $version =~ m~(.*?)\.([0-9]{4})\.cots$~ )
3285 
        {
3286 
            $result = $1 . sprintf (".%4.4d", $2) . $suffix;
3287 
        }
3288 
        else
3289 
        {
3290 
            $result = $cots_base . '.0000.cots';
3291 
        }
3292 
    }
3293 
    #
3294 
    #   Convert version into full form for comparisions
3295 
    #       nnn.nnn.nnn.[p]nnn.xxx
3296 
    #       nnn.nnn.nnn.[p]nnn-xxx
3297 
    #       nnn.nnn.nnn-[p]nnn.xxx
3298 
    #       nnn.nnn.nnn-[p]nnn-xxx
3299 
    #       nnn.nnn.nnn[p]nnn-xxx
3300 
    #   Don't flag as ripples - they are patches
3301 
    #
3302 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-.p][p]?(\d+)([-.](.*))?$~ ) {
3303 
        $major = $1;
3304 
        $minor = $2;
3305 
        $patch = $3;
3306 
        $build = $4;
3307 
        $suffix = defined $6 ? ".$6" : '';
3308 
        $isaRipple = 0;
3309 
    }
3310 
    #
3311 
    #       nn.nnn.nnnnn.xxx
3312 
    #       nn.nnn.nnnnn-xxx
3313 
    #       nnn.nnn.nnnx.xxx
3314 
    #   Don't flag as ripples - they are patches
3315 
    #
3316 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)\w?([-.](.*))?$~ ) {
3317 
        $major = $1;
3318 
        $minor = $2;
3319 
        $patch = $3;
3320 
        if ( length( $patch) >= 4 )
3321 
        {
3322 
            $build = substr( $patch, -3 ,3);
3323 
            $patch = substr( $patch,  0 ,length($patch)-3);
3324 
        }
3325 
        $suffix = defined $5 ? ".$5" : '';
3326 
    }
3327 
 
3328 
    #
3329 
    #       nnn.nnn.nnn
3330 
    #       nnn.nnn-nnn
3331 
    #       nnn.nnn_nnn
3332 
    #
3333 
    elsif ( $version =~ m~^(\d+)\.(\d+)[-._](\d+)$~ ) {
3334 
        $major = $1;
3335 
        $minor = $2;
3336 
        $patch = $3;
3337 
        $suffix = '';
3338 
    }
3339 
 
3340 
    #
3341 
    #       nnn.nnn.nnn.nnn
3342 
    #       nnn.nnn.nnn-nnn
3343 
    #       nnn.nnn.nnn_nnn
3344 
    #
3345 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-._](\d+)$~ ) {
3346 
        $major = $1;
3347 
        $minor = $2;
3348 
        $patch = $3;
3349 
        $build = $4;
3350 
        $suffix = '';
3351 
        $isaRipple = 0;
3352 
    }
3353 
 
3354 
 
3355 
    #
3356 
    #       nnn.nnn
3357 
    #
3358 
    elsif ( $version =~ m~^(\d+)\.(\d+)$~ ) {
3359 
        $major = $1;
3360 
        $minor = $2;
3361 
        $patch = 0;
3362 
        $suffix = '';
3363 
    }
3364 
    #
3365 
    #       nnn.nnn.xxx
3366 
    #
3367 
    elsif ( $version =~ m~^(\d+)\.(\d+)(\.\w+)$~ ) {
3368 
        $major = $1;
3369 
        $minor = $2;
3370 
        $patch = 0;
3371 
        $suffix = $3;
3372 
    }
3373 
 
3374 
    #
3375 
    #       nnn.nnn.nnnz
3376 
    #
3377 
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)([a-z])$~ ) {
3378 
        $major = $1;
3379 
        $minor = $2;
3380 
        $patch = $3;
3381 
        $build = ord($4) - ord('a');
3382 
        $suffix = '.cots';
3383 
        $isaRipple = 0;
3384 
    }
3385 
    #
3386 
    #       ???REV=???
3387 
    #
3388 
    elsif ( $version =~ m~REV=~ ) {
3389 
        $suffix = '.cots';
3390 
        $result = $version . '.0000.cots';
3391 
    }
3392 
 
3393 
    #
3394 
    #   Wip Packages
3395 
    #   (nnnnnn).xxx
3396 
    #   Should be essential, but want to sort very low
3397 
    #
3398 
    elsif ($version =~ m~\((.*)\)(\..*)?~) {
3399 
        $suffix = $2 || '';
3400 
        $result = "000.000.000.000$suffix";
3401 
        $isaWIP = 1;
3402 
    }
3403 
 
3404 
    #
3405 
    #   !current
3406 
    #
3407 
    elsif ($version eq '!current' || $version eq 'current_$USER' || $version eq 'current' || $version eq 'beta' || $version eq 'latest' || $version eq 'beta.cr' || $version eq 'CREATE') {
3408 
        $suffix = '';
3409 
        $result = "000.000.000.000$suffix";
3410 
        $isaWIP = 1;
3411 
    }
3412 
 
3413 
    #
3414 
    #   Also WIP: FINRUN.103649.BEI.WIP
3415 
    elsif ($version =~ m~(\.[a-zA-Z]+)\.WIP$~) {
3416 
        $suffix = lc($1);
3417 
        $result = "000.000.000.000$suffix";
3418 
        $isaWIP = 1;
3419 
    }
3420 
 
3421 
    #
3422 
    #   Also ERGOFSSLS190100_015
3423 
    #   Don't flag as a ripple
3424 
    elsif ($version =~ m~^ERG[A-Z]+(\d\d)(\d\d)(\d\d)[-_](\d+)(\.\w+)?$~) {
3425 
        $major = $1;
3426 
        $minor = $2;
3427 
        $patch = $3;
3428 
        $build = $4;
3429 
        $suffix = $5 || '.sls';
3430 
        $isaRipple = 0;
3431 
    }
3432 
 
3433 
    #
3434 
    #   Stuff we don't yet handle
3435 
    #
3436 
    else  {
3437 
        Warning ("Unknown version number: $name,$version");
3438 
        $version =~ m~(\.\w+)$~;
3439 
        $suffix = $1 || '';
3440 
        $result = $version;
3441 
    }
3442 
 
3443 
    $isaRipple = ($build > 0) unless defined $isaRipple;
3444 
    unless ( $result )
3445 
    {
3446 
        # Major and minor of 99.99 are normally funy versions
3447 
        # Don't make important desicions on them
3448 
        #
3449 
        if ( $major == 99 && $minor == 99 )
3450 
        {
3451 
            $major = 0;
3452 
            $minor = 0;
3453 
            $patch = 0;
3454 
        }
3455 
 
3456 
        $result = sprintf("%3.3d.%3.3d.%3.3d.%3.3d%s", $major,$minor,$patch,$build,$suffix || '.0000');
3457 
        $buildVersion = [ $major, $minor, $patch, $build ];
3458 
    }
3459 
 
3460 
    $suffix = lc( $suffix );
3461 
    if ( exists $suffixFixup{$suffix} )
3462 
    {
3463 
        $suffix = $suffixFixup{$suffix} ;
3464 
    }
3465 
 
3466 
    return ($suffix, $result, $isaRipple, $isaWIP, $buildVersion );
3467 
}
3468 
 
3469 
#-------------------------------------------------------------------------------
3470 
# Function        : vcsCleanup
3471 
#
3472 
# Description     : Cleanup and rewrite a vcstag
3473 
#
3474 
#                   DUPLICATED IN:
3475 
#                       - cc2svn_procdata
3476 
#                       - cc2svn_importpackage
3477 
#
3478 
# Inputs          : vcstag
3479 
#
3480 
# Returns         : Cleaned up vcs tag
3481 
#
3482 
sub vcsCleanup
3483 
{
3484 
    my ($tag) = @_;
3485 
    $tag =~ tr~\\/~/~;
3486 
    if ( $tag =~ m~^CC::~ )
3487 
    {
2429 dpurdie 3488 
        $tag =~ s~CC::load\s+~CC::~;                # Load rule
3489 
        $tag =~ s~CC::\s+~CC::~;                    # Leading white space
3490 
        $tag =~ s~CC::[A-Za-z]\:/~CC::/~;           # Leading driver letter
3491 
        $tag =~ s~CC::/+~CC::/~;                    # Multiple initial /'s
3492 
        $tag =~ s~/build.pl::~::~i;
3493 
        $tag =~ s~/src::~::~i;
1271 dpurdie 3494 
        $tag =~ s~MASS_Dev_Bus/Cbp/~MASS_Dev_Bus/CBP/~i;
3495 
        $tag =~ s~MASS_Dev_Bus~MASS_Dev_Bus~i;
3496 
        $tag =~ s~/MASS_Dev/Infra~MASS_Dev_Infra~i;
3497 
        $tag =~ s~/MASS_Dev/Bus/web~/MASS_Dev_Bus/web~i;
3498 
 
3499 
        $tag =~ s~/Vastraffik/~/Vasttrafik/~;
3500 
        $tag =~ s~/MREF_Package/ergpostmongui$~/MREF_Package/ergpostmongui~i;
3501 
        $tag =~ s~DPC_SWCode/~DPG_SWCode/~i;
3502 
    }
3503 
    return $tag;
3504 
}
3505 
 
3506 
#-------------------------------------------------------------------------------
3507 
# Function        : examineVcsTag
3508 
#
3509 
# Description     : Examine a VCS Tag and determine if it looks like rubbish
3510 
#                   Give it a clean
3511 
#
3512 
# Inputs          : $entry
3513 
#
3514 
# Returns         : Will add Data to the $entry
3515 
#
3516 
sub examineVcsTag
3517 
{
3518 
    my ($entry) = @_;
3519 
    my $bad = 0;
3520 
 
3521 
    $versions{$entry}{vcsTag} = vcsCleanup($versions{$entry}{vcsTag});
3522 
    my $vcstag = $versions{$entry}{vcsTag};
3523 
 
3524 
    if ( $vcstag =~ m~^SVN::~ ) {
3525 
        $versions{$entry}{isSvn} = 1;
3526 
 
3527 
    } elsif ( $vcstag =~ m~^CC::(.*?)(::(.+))?$~ ) {
3528 
        my $path = $1  || '';
3529 
        my $label = $2 || '';
3530 
        $bad = 1 unless ( $label );
3531 
        $bad = 1 if ( $label =~ m~^N/A$~i || $label  =~ m~^na$~i );
3532 
 
3533 
        $bad = 1 unless ( $path );
3534 
        $bad = 1 if ( $path =~ m~^N/A$~i || $path  =~ m~^na$~i );
3535 
        $bad = 1 if ( $path =~ m~^/dpkg_archive~ || $path  =~ m~^dpkg_archive~ );
3536 
        $bad = 1 if ( $path =~ m~^/devl/~ || $path  =~ m~^devl/~ );
3537 
        $bad = 1 if ( $path =~ m~^CVS~ );
3538 
        $bad = 1 if ( $path =~ m~^http:~i );
3539 
        $bad = 1 if ( $path =~ m~^[A-Za-z]\:~ );
3540 
        $bad = 1 if ( $path =~ m~^//~ );
3541 
        $bad = 1 if ( $path =~ m~^/*none~i );
3542 
        $bad = 1 if ( $path =~ m~^/*NoWhere~i );
3543 
        $bad = 1 if ( $path =~ m~^-$~i );
3544 
        $bad = 1 if ( $path =~ m~^cvsserver:~ );
3545 
        $bad = 1 if ( $path =~ m~,\s*module:~ );
3546 
#        $bad = 1 unless ( $path =~ m~^/~ );
3547 
    }
3548 
    else
3549 
    {
3550 
        $bad = 1;
3551 
    }
3552 
    $versions{$entry}{badVcsTag} = 1 if ( $bad );
3553 
}
3554 
 
3555 
#-------------------------------------------------------------------------------
3556 
# Function        : logToFile
3557 
#
3558 
# Description     : Log some data to a named file
3559 
#                   Use file locking to allow multiple process to log
3560 
#
3561 
# Inputs          : $filename           - Name of file to log
3562 
#                   ...                 - Data to log
3563 
#
3564 
# Returns         : Nothing
3565 
#
3566 
sub logToFile
3567 
{
3568 
    my ($file, @data) = @_;
3569 
 
3570 
    open  (LOGFILE, '>>', $file);
3571 
    flock (LOGFILE, LOCK_EX);
3572 
    print  LOGFILE "@data\n";
3573 
    flock (LOGFILE, LOCK_UN);
3574 
    close (LOGFILE);
3575 
}
3576 
 
3577 
#-------------------------------------------------------------------------------
3578 
# Function        : createImages
3579 
#
3580 
# Description     : Create nice images of the RM version tree
3581 
#
3582 
# Inputs          :
3583 
#
3584 
# Returns         :
3585 
#
3586 
sub createImages
3587 
{
3588 
 
3589 
    my $filebase = "${packageNames}";
2429 dpurdie 3590 
    open (FH, '>', $cwd . "/$filebase.dot" ) or die "Cannot open output";
1271 dpurdie 3591 
    print FH "digraph \"${packageNames}\" {\n";
3592 
    #print FH "rankdir=LR;\n";
3593 
    print FH "node[fontsize=16];\n";
3594 
    print FH "node[target=_graphviz];\n";
3595 
#    print FH "subgraph cluster_A {\n";
3596 
#    print FH "node[fontsize=12];\n";
3597 
 
3598 
    {
3599 
        my @text;
3600 
        push @text, $packageNames;
3601 
        push @text, 'HyperLinked to Release Manager';
3602 
        push @text, 'Created:' . localtime();
3603 
        push @text, '|';
3604 
 
3605 
        push @text, 'Total RM versions: ' . $totalVersions;
3606 
        push @text, 'Essential Entries: ' . scalar @EssentialPackages;
3607 
        push @text, 'Initial trees: ' . $initialTrees;
3608 
 
1272 dpurdie 3609 
        push @text, 'Number of Entries: ' . $processTotal;
1271 dpurdie 3610 
        push @text, 'Type : ' . $packageType;
3611 
        push @text, 'All versions in Subversion' if ( $allSvn );
3612 
 
3613 
        push @text, '|';
3614 
        push @text, 'Total Project Branches: ' . $ProjectCount;
3615 
        foreach ( sort keys %knownProjects )
3616 
        {
3617 
            my $count = $knownProjects{$_}{count} || 0;
3618 
            if ( $count )
3619 
            {
3620 
                my $text = 'Project Branch: ' . $_;
3621 
                $text .= " (" . $count . ")" if ( $count > 1 );
3622 
                push @text, $text;
3623 
            }
3624 
        }
3625 
 
3626 
        push @text, '|';
3627 
        push @text, 'Bad VCS : ' . $badVcsCount;
3628 
        push @text, 'Bad Singletions : ' . $badSingletonCount;
3629 
        push @text, 'Deadwood entries : ' . $trimCount;
3630 
        push @text, 'Walking Mode : Flat' if ($opt_flat);
3631 
        push @text, 'Pruned Mode : ' . $pruneModeString;
3632 
        push @text, 'Pruned entries : ' . $pruneCount;
2429 dpurdie 3633 
        push @text, 'Recent entries : ' . $recentCount;
1271 dpurdie 3634 
 
3635 
        if ( @unknownProjects )
3636 
        {
3637 
            push @text, '|';
3638 
            push @text, 'Unknown Projects';
3639 
            push @text, 'Unknown Project: ' . $_ foreach (sort @unknownProjects );
3640 
        }
3641 
 
3642 
        #
3643 
        #   Multiple Paths
3644 
        #
3645 
        if ( scalar @multiplePaths > 1 )
3646 
        {
3647 
            push @text, '|';
3648 
            push @text, 'Multiple Paths';
3649 
            push @text, @multiplePaths;
3650 
        }
3651 
 
3652 
        #
3653 
        #   Bad essentials
3654 
        #
3655 
        if ( @badEssentials  )
3656 
        {
3657 
            push @text, '|';
3658 
            push @text, 'Bad Essential Versions';
3659 
            push @text, GetVname($_) foreach ( @badEssentials );
3660 
        }
3661 
 
3662 
        #
3663 
        #   Subversion Data
3664 
        #
3665 
        if ( %svnData )
3666 
        {
3667 
            push @text, '|';
3668 
            push @text, 'Subversion';
3669 
            push @text, 'Trunk used' if exists $svnData{branches}{trunk} ;
3670 
            push @text, 'Labels: ' . scalar keys %{$svnData{tags}} ;
3671 
            push @text, 'Branches: ' . scalar keys %{$svnData{branches}} ;
2429 dpurdie 3672 
            push @text, 'Relabled Packages : ' . $packageReLabelCount;
1271 dpurdie 3673 
        }
3674 
 
3675 
        push @text, '';
3676 
        my $text = join '\l', @text;
3677 
        $text =~ s~\|\\l~|~g;
3678 
 
3679 
        my @attributes;
3680 
        push @attributes, "shape=record";
3681 
        push @attributes, "label=\"{$text}\"";
3682 
        push @attributes, "tooltip=\"$packageNames\"";
3683 
        push (@attributes, "URL=\"" . $GBE_RM_URL . "/view_by_version.asp?pkg_id=$first_pkg_id" . "\"" )if $first_pkg_id;
3684 
        push @attributes, "color=red";
3685 
        my $attr = join( ' ', @attributes);
3686 
 
3687 
        my $tld_done = 'TitleBlock';
3688 
        print FH "$tld_done [$attr]\n";
3689 
    }
3690 
 
3691 
    #
3692 
    #   Generate Legend
3693 
    #
3694 
    {
3695 
        my @text;
3696 
        push @text, 'Legend';
3697 
        push @text, '|';
3698 
        push @text, 'Node Content';
3699 
        push @text, 'Package Version';
3700 
#        push @text, 'Release Manager Ref (pvid)';
3701 
        push @text, 'Creation Date: yyyy-mm-dd';
3702 
        push @text, '(Coded information)';
3703 
        push @text, '|{Code';
3704 
        push @text, '|{N: Not Locked';
3705 
        push @text, 'b: Bad Singleton';
3706 
        push @text, 'd: A dependency';
3707 
        push @text, 'B: Bad VCS Tag';
3708 
        push @text, 'D: DeadWood';
3709 
        push @text, 'e: Essential BOM Version';
3710 
        push @text, 'E: Essential Release Version';
2429 dpurdie 3711 
        push @text, 'F: Package directories labled';
1271 dpurdie 3712 
        push @text, 'G: Glued into Version Tree';
2429 dpurdie 3713 
        push @text, 'L: Label not in VOB';
3714 
        push @text, 'r: Recent version';
3715 
        push @text, 'R: Ripple';
1271 dpurdie 3716 
        push @text, 'S: Splitpoint';
3717 
        push @text, 't: Glued into Project Tree';
3718 
        push @text, 'T: Tip version';
3719 
        push @text, 'V: In SVN';
3720 
        push @text, '+: In Subversion';
2429 dpurdie 3721 
        push @text, '0: Zero files extracted';
1271 dpurdie 3722 
        push @text, '}}';
3723 
 
3724 
        push @text, '|';
3725 
        push @text, 'Outline';
3726 
        push @text, 'Red: Dead or Bad VCS Tag';
3727 
        push @text, 'Orange: Project Branch Root';
3728 
        push @text, 'Green: Ripple Build Version';
3729 
        push @text, 'Blue: Essential Version';
3730 
        push @text, 'Darkmagenta: Entry Glued into tree';
3731 
        push @text, 'Magenta: Entry added to project tree';
2429 dpurdie 3732 
        push @text, 'DeepPink: Label not in VOB';
3733 
        push @text, 'DarkViolet: Zero files extracted';
1271 dpurdie 3734 
 
3735 
 
3736 
        push @text, '|';
3737 
        push @text, 'Fill';
3738 
        push @text, 'PowderBlue: Essential Version';
3739 
        push @text, 'Red: Bad Essential Version';
3740 
        push @text, 'Light Green: Migrated to SVN';
3741 
#        push @text, 'Red: Entry Glued into tree';
3742 
#        push @text, 'Green: Entry added to project tree';
3743 
 
3744 
        push @text, '|';
3745 
        push @text, 'Shape';
3746 
        push @text, 'Oval: Normal Package Version';
3747 
        push @text, 'Invhouse: Project Branch Root';
3748 
        push @text, 'Octagon: Branch Point';
3749 
        push @text, 'Box: Bad Single version with no history';
3750 
        push @text, 'Doublecircle: Tip of a Project Branch';
3751 
 
3752 
        push @text, '';
3753 
        my $text = join '\l', @text;
3754 
        $text =~ s~\|\\l~|~g;
3755 
        $text =~ s~\}\\l~}~g;
3756 
 
3757 
        my @attributes;
3758 
        push @attributes, "shape=record";
3759 
        push @attributes, "label=\"{$text}\"";
3760 
        push @attributes, "color=red";
3761 
        my $attr = join( ' ', @attributes);
3762 
 
3763 
        my $tld_done = 'LegendBlock';
3764 
        print FH "$tld_done [$attr]\n";
3765 
    }
3766 
 
3767 
#    print FH "\n}\n";
3768 
    print FH "TitleBlock -> LegendBlock [style=invis]\n";
3769 
 
3770 
    sub genLabelText
3771 
    {
3772 
        my ($entry) = @_;
3773 
        my @label;
3774 
        push @label, $versions{$entry}{name} if ( $multiPackages );
3775 
        push @label, $versions{$entry}{vname};
3776 
#        push @label, $entry;       # Add PVID
3777 
        push @label, substr( $versions{$entry}{created}, 0, 10); #  2008-02-19
3778 
#        push @label, 'V=' . $versions{$entry}{maxVersion};
3779 
#        push @label, 'B=' . $versions{$entry}{svnBranchTip} if ( exists $versions{$entry}{svnBranchTip} );
3780 
 
3781 
        my $reason = '';
3782 
        if (exists $versions{$entry}{Essential})
3783 
        {
3784 
            $reason = 'E';
3785 
            if (exists $versions{$entry}{Reason})
3786 
            {
3787 
                if ( $versions{$entry}{Reason} =~ m~bom~ )
3788 
                {
3789 
                    $reason = 'e';
3790 
                }
3791 
                if ( $versions{$entry}{Reason} =~ m~Depend~ )
3792 
                {
3793 
                    $reason .= 'd';
3794 
                }
3795 
            }
3796 
        }
3797 
 
3798 
        my $stateText = '';
3799 
        $stateText .= 'N' if ($versions{$entry}{locked} eq 'N');
3800 
        $stateText .= 'b' if (exists $versions{$entry}{badSingleton});
3801 
        $stateText .= 'B' if (exists $versions{$entry}{badVcsTag});
3802 
        $stateText .= 'G' if (exists $versions{$entry}{GluedIn});
3803 
        $stateText .= 't' if (exists $versions{$entry}{MakeTree});
3804 
#        $stateText .= 'E' if (exists $versions{$entry}{Essential});
3805 
        $stateText .= $reason if ( $reason );
3806 
        $stateText .= 'D' if (exists $versions{$entry}{DeadWood});
2429 dpurdie 3807 
        $stateText .= 'R' if ( $versions{$entry}{isaRipple} );
3808 
        $stateText .= 'r' if (exists $versions{$entry}{keepRecent} && $versions{$entry}{keepRecent} );
1271 dpurdie 3809 
        $stateText .= 'S' if (exists $versions{$entry}{EssentialSplitPoint} && $versions{$entry}{EssentialSplitPoint} > 1 );
3810 
        $stateText .= 'T' if (exists $versions{$entry}{Tip} );
3811 
        $stateText .= 'V' if (exists $versions{$entry}{isSvn} );
3812 
        $stateText .= '+' if (exists $versions{$entry}{svnVersion} );
2429 dpurdie 3813 
        $stateText .= '0' if (exists $versions{$entry}{data}{errCode} && $versions{$entry}{data}{errCode} eq '0');
3814 
        $stateText .= 'L' if (exists $versions{$entry}{data}{errCode} && $versions{$entry}{data}{errCode} eq 'L');
3815 
        $stateText .= 'F' if ($versions{$entry}{data}{DirsLabled});
3816 
 
3817 
 
1271 dpurdie 3818 
#        $stateText .= 's' if (exists $versions{$entry}{branchPoint} );
3819 
#        $stateText .= ' T='. $versions{$entry}{threadId} if (exists $versions{$entry}{threadId});
3820 
#        $stateText .= ' EssentalPath' if (exists $versions{$entry}{EssentialPath});
3821 
#        $stateText .= ' Count='. $versions{$entry}{EssentialSplitPoint} if (exists $versions{$entry}{EssentialSplitPoint});
3822 
#        $stateText .= ' M='. $versions{$entry}{maxVersion} if (exists $versions{$entry}{maxVersion});
3823 
 
2429 dpurdie 3824 
        push @label, "(${stateText})" if ( length($stateText) );
1271 dpurdie 3825 
 
2429 dpurdie 3826 
##       Insert Release Names
3827 
        foreach my $rtag_id ( keys %{$versions{$entry}{Releases}}  ) {
3828 
            next unless ( exists $ukHopsReleases{$rtag_id} );
3829 
            push @label, "Release: $versions{$entry}{Releases}{$rtag_id}{rname}";
3830 
        }
3831 
 
1271 dpurdie 3832 
        return join ('\n', @label );
3833 
    }
3834 
 
3835 
    sub genAttributes
3836 
    {
3837 
        my ($entry) = @_;
3838 
        my @attributes;
3839 
        push @attributes, 'label="' . genLabelText($entry) . '"';
3840 
        unless ( $opt_fileList )
3841 
        {
3842 
            push @attributes, 'URL="' . dotUrl($entry) . '"';
3843 
            push @attributes, 'tooltip="' . "Goto: $versions{$entry}{vname}, PVID=$entry" ,'"';
3844 
        }
3845 
        {
3846 
            push @attributes, 'URL="' . "Dummy" . '"';
3847 
            push @attributes, 'tooltip="' . "Original Label: $versions{$entry}{realLabel}" ,'"';
3848 
        }
3849 
        my $shape;
3850 
            $shape = 'box' if ($versions{$entry}{badSingleton});
3851 
            $shape = 'octagon'  if ($versions{$entry}{branchPoint});
3852 
            $shape = 'invhouse' if ($versions{$entry}{newSuffix});
3853 
            $shape = 'doublecircle' if ($versions{$entry}{Tip});
3854 
 
3855 
 
3856 
        push @attributes, 'shape=' . $shape if ( $shape );
3857 
 
3858 
        my $color;
3859 
        my $fill;
3860 
           $color = 'color=green style=bold' if ( $versions{$entry}{isaRipple} );
3861 
           $color = 'color=orange style=bold' if ( $versions{$entry}{newSuffix} );
3862 
           $color = 'color=red style=bold' if ( $versions{$entry}{DeadWood} || $versions{$entry}{badVcsTag} );
3863 
           $color = 'color=blue style=bold' if ( $versions{$entry}{Essential} );
3864 
           $color = 'color=darkmagenta style=bold' if ( $versions{$entry}{GluedIn} );
3865 
           $color = 'color=magenta style=bold' if ( $versions{$entry}{MakeTree} );
2429 dpurdie 3866 
           $color = 'color=DeepPink style=bold' if (exists $versions{$entry}{data}{errCode} && $versions{$entry}{data}{errCode} eq 'L');
3867 
           $color = 'color=DarkViolet style=bold' if (exists $versions{$entry}{data}{errCode} && $versions{$entry}{data}{errCode} eq '0');
1271 dpurdie 3868 
 
3869 
           $fill = 'style=filled fillcolor=powderblue' if ( $versions{$entry}{Essential} );
3870 
           $fill = 'style=filled fillcolor=red' if ( $versions{$entry}{Essential} && $versions{$entry}{badVcsTag} );
3871 
           $fill = 'style=filled fillcolor="#99FF99"' if ( exists $versions{$entry}{svnVersion} );
3872 
 
3873 
 
3874 
        push @attributes, $color if ( $color );
3875 
        push @attributes, $fill if ( $fill );
3876 
 
3877 
        return '[' . join( ' ', @attributes) . ']';
3878 
    }
3879 
 
3880 
    sub genArrowAttributes
3881 
    {
3882 
        my ($not_first, $entry) = @_;
3883 
        my @attributes;
3884 
 
3885 
        push @attributes, 'arrowhead=empty' if ( $not_first );
3886 
        push ( @attributes, 'label="' . $versions{$entry}{svnBranchTip} .'"' ) if ( exists $versions{$entry}{svnBranchTip} );
3887 
 
3888 
        return ('[' . join( ' ', @attributes) . ']') if ( @attributes ) ;
3889 
        return '';
3890 
    }
3891 
 
3892 
    #
3893 
    #   Flat
3894 
    #
3895 
    if ( $opt_flat )
3896 
    {
3897 
        my $last = 0;
3898 
        foreach my $entry (@flatOrder )
3899 
        {
3900 
            if ( $last )
3901 
            {
3902 
                my $me = dotTag($last);
3903 
 
3904 
                print FH pentry($me)  ,' -> ', pentry(dotTag($entry)), genArrowAttributes(0, $entry) ,";\n";
3905 
                print FH pentry($me)  ,genAttributes($last) . ";\n";
3906 
            }
3907 
            $last = $entry;
3908 
        }
3909 
        print FH pentry(dotTag($last))  ,genAttributes($last) . ";\n";
3910 
 
3911 
    }
3912 
    else
3913 
    {
3914 
        foreach my $entry ( sort {$a <=> $b} keys(%versions) )
3915 
        {
3916 
            my $me = dotTag($entry);
3917 
            my @versions = @{ $versions{$entry}{next}};
3918 
            my $ii = 0;
3919 
            foreach ( @versions )
3920 
            {
3921 
                print FH pentry($me)  ," -> ",pentry(dotTag($_)), genArrowAttributes($ii++, $_), ";\n";
3922 
            }
3923 
 
3924 
            print FH pentry($me)  ,genAttributes($entry) . ";\n";
3925 
        }
3926 
    }
3927 
 
3928 
    print FH "\n};\n";
3929 
    close FH;
3930 
 
3931 
    #
3932 
    #   Convert DOT to a SVG
3933 
    #
3934 
    unless ( $UNIX )
3935 
    {
3936 
    print "Generating graphical images\n";
3937 
#    system( "dot $filebase.dot -Tjpg -o$filebase.jpg" );  # -v
3938 
    system( "dot $filebase.dot -Tsvg -o$filebase.svg" );  # -v
3939 
#    unlink("$filebase.dot");
3940 
 
3941 
    #
3942 
    #   Display a list of terminal packages
3943 
    #   These are packages that are not used by any other package
3944 
    #
3945 
    print "\n";
3946 
#    print "Generated: $filebase.dot\n";
3947 
#    print "Generated: $filebase.jpg\n";
3948 
    print "Generated: $filebase.svg\n";
3949 
    }
3950 
    else
3951 
    {
3952 
        print "Generated: $filebase.dot\n";
3953 
    }
3954 
}
3955 
 
3956 
sub dotTag
3957 
{
3958 
    my ($entry) = @_;
3959 
 
3960 
    my $label = '';
3961 
    if ( $versions{$entry}{realLabel} )
3962 
    {
3963 
        $label .= $versions{$entry}{realLabel};
3964 
    }
3965 
    else
3966 
    {
3967 
        $label .= $versions{$entry}{name} if $multiPackages;
3968 
        $label .= $versions{$entry}{vname};
3969 
    }
3970 
    $label =~ s~[-() ]~_~g;
3971 
    return $label;
3972 
}
3973 
 
3974 
sub dotUrl
3975 
{
3976 
    my ($entry) = @_;
3977 
 
3978 
    my $pv_base = $GBE_RM_URL . "/fixed_issues.asp?pv_id=$entry";
3979 
}
3980 
 
3981 
#-------------------------------------------------------------------------------
3982 
# Function        : pentry
3983 
#
3984 
# Description     : Generate an entry list as text
3985 
#                   Replace "." with "_" since DOT doesn't like .'s
3986 
#                   Seperate the arguments
3987 
#
3988 
# Inputs          : @_          - An array of entries to process
3989 
#
3990 
# Returns         : A string
3991 
#
3992 
sub pentry
3993 
{
3994 
    my ($data) = @_;
3995 
    $data =~ s~\.~_~g;
3996 
    $result = '"' . $data . '"' ;
3997 
    return $result;
3998 
}
3999 
 
4000 
#-------------------------------------------------------------------------------
4001 
# Function        : getVobMapping
4002 
#
4003 
# Description     : Read in Package to Repository Mapping
4004 
#
4005 
# Inputs          :
4006 
#
4007 
# Returns         : Populates %VobMapping
4008 
#                             Mapping of PackageName to RepoName[/Subdir]
4009 
#
4010 
our %ScmRepoMap;
4011 
sub getVobMapping
4012 
{
4013 
    Message ("Read in Vob Mapping");
4014 
 
4015 
    my $fname = 'cc2svn.repo.dat';
4016 
    Error "Cannot locate $fname" unless ( -f $fname );
4017 
    require $fname;
4018 
 
4019 
    Error "Data in $fname is not valid\n"
4020 
        unless ( keys(%ScmRepoMap) >= 0 );
4021 
 
4022 
    $opt_vobMap = $ScmRepoMap{$packageNames}{repo}
4023 
        if (exists $ScmRepoMap{$packageNames});
4024 
 
4025 
    #
4026 
    #   Free the memory
4027 
    #
4028 
    %ScmRepoMap = ();
4029 
 
4030 
    #
4031 
    #   Calculate Target Repo
4032 
    #
4033 
    Warning ("No VOB Mapping found")
4034 
        unless ($opt_vobMap);
4035 
    Error("No repository specified. ie -repo=DevTools or -repo=COTS")
4036 
        unless ( $opt_repo || $opt_vobMap );
2439 dpurdie 4037 
    my $r1 = ($opt_repo || '') . '/' . ($opt_vobMap || '') . '/' . ($opt_repoSubdir || '') ;
4038 
    $r1 =~ s~//~/~g;
1271 dpurdie 4039 
    $r1 =~ s~^/~~;
4040 
    $r1 =~ s~/$~~;
4041 
    $svnRepo = $opt_repo_base . $r1;
4042 
 
4043 
    Verbose( "Repo URL: $svnRepo");
4044 
}
4045 
 
4046 
 
4047 
#-------------------------------------------------------------------------------
4048 
# Function        : getEssenialPackageVersions
4049 
#
4050 
# Description     : Determine the 'Essental' Package Versions
4051 
#                   Read the data in from an external file
4052 
#
4053 
# Inputs          :
4054 
#
4055 
# Returns         : Populates @EssentialPackages
4056 
#
4057 
 
4058 
our %ScmReleases;
4059 
our %ScmPackages;
4060 
our %ScmSuffixes;
4061 
sub getEssenialPackageVersions
4062 
{
4063 
    Message ("Read in Essential Package Versions");
4064 
 
4065 
    my $fname = 'cc2svn.raw.txt';
4066 
    Error "Cannot locate $fname" unless ( -f $fname );
4067 
    require $fname;
4068 
 
4069 
    Error "Data in $fname is not valid\n"
4070 
        unless ( keys(%ScmReleases) >= 0 );
4071 
 
4072 
#    DebugDumpData("ScmReleases", \%ScmReleases );
4073 
#    DebugDumpData("ScmPackages", \%ScmPackages );
4074 
#    DebugDumpData("ScmSuffixes", \%ScmSuffixes );
4075 
 
4076 
    #
4077 
    #   Create a list of essential packages
4078 
    #   Retain packages-versions used in this program
4079 
    #
4080 
    foreach ( keys %ScmPackages )
4081 
    {
4082 
        next unless ( exists  $pkg_ids{ $ScmPackages{$_}{pkgid} } );
4083 
        push @EssentialPackages, $_;
4084 
        Error ("Essential Package Version not in extracted Release Manager Data: $_")
4085 
            unless ( exists $versions{$_} );
4086 
        $versions{$_}{Essential} = 1;
4087 
        $versions{$_}{Reason} = $ScmPackages{$_}{Reason};
2429 dpurdie 4088 
 
4089 
        # Retain which RM Release this package-version is the tip
4090 
        # Release of
4091 
        foreach my $rtag_id ( @{$ScmPackages{$_}{'release'}} )
4092 
        {
4093 
            $versions{$_}{Releases}{$rtag_id}{rname}   = $ScmReleases{$rtag_id}{name};
4094 
            $versions{$_}{Releases}{$rtag_id}{pname}   = $ScmReleases{$rtag_id}{pName};
4095 
            $versions{$_}{Releases}{$rtag_id}{proj_id} = $ScmReleases{$rtag_id}{proj_id};
4096 
        }
4097 
 
4098 
        #print "ESSENTIAL: $versions{$_}{name} $versions{$_}{vname}\n";
1271 dpurdie 4099 
    }
4100 
 
4101 
    #
4102 
    #   Free memory
4103 
    #
4104 
    %ScmReleases = ();
4105 
    %ScmPackages = ();
4106 
    %ScmSuffixes = ();
4107 
 
4108 
#    DebugDumpData("Essential", \@EssentialPackages );
4109 
    Message ("Essential Versions: " . scalar @EssentialPackages );
4110 
}
4111 
 
4112 
#-------------------------------------------------------------------------------
4113 
# Function        : ReportPathVariance
4114 
#
4115 
# Description     : Report variance in paths used by the versions
4116 
#
4117 
# Inputs          :
4118 
#
4119 
# Returns         :
4120 
#
4121 
my %VobPaths;
4122 
sub ReportPathVariance
4123 
{
4124 
    Message ("Detect Multiple Paths");
4125 
    foreach my $entry ( keys(%versions) )
4126 
    {
4127 
        my $e = $versions{$entry};
4128 
        next if ( isSet ($e, 'DeadWood' ) );
4129 
        next if ( isSet ($e, 'badVcsTag') );
4130 
        next if ( isSet ($e, 'isSvn') );
4131 
        my $tag = $e->{vcsTag};
4132 
        next unless ( $tag );
4133 
 
4134 
        $tag =~ m~^(.+?)::(.*?)(::(.+))?$~;
4135 
        my $vcsType = $1;
4136 
        my $cc_label = $4;
4137 
        my $cc_path = $2;
4138 
        $cc_path = '/' . $cc_path;
4139 
        $cc_path =~ tr~\\/~/~s;
4140 
 
4141 
        $VobPaths{$cc_path}++;
4142 
    }
4143 
 
4144 
    @multiplePaths = sort keys %VobPaths;
4145 
    if ( scalar @multiplePaths > 1 )
4146 
    {
4147 
        Warning ("Multiple Paths:" . $_ ) foreach (@multiplePaths);
4148 
    }
4149 
}
4150 
 
4151 
sub isSet
4152 
{
4153 
    my ($base, $element) = @_;
4154 
    return 0 unless ( exists $base->{$element} );
4155 
    return $base->{$element};
4156 
}
4157 
 
4158 
 
4159 
#-------------------------------------------------------------------------------
4160 
# Function        : recurseList
4161 
#
4162 
# Description     : Return a list of all element below a given head element
4163 
#
4164 
# Inputs          : $head               - Head element
4165 
#
4166 
# Returns         : A list, not in any particular order
4167 
#
4168 
 
4169 
our @recurseList;
4170 
sub recurseList
4171 
{
4172 
    @recurseList = ();
4173 
    recurseListBody (@_);
4174 
    return @recurseList;
4175 
}
4176 
sub recurseListBody
4177 
{
4178 
    foreach my $entry ( @_ )
4179 
    {
4180 
        push @recurseList, $entry;
4181 
no warnings "recursion";
4182 
        recurseListBody (@{$versions{$entry}{next}});
4183 
    }
4184 
}
4185 
 
4186 
#-------------------------------------------------------------------------------
4187 
# Function        : getSvnData
4188 
#
4189 
# Description     : Read the SVN tree and see what we have
4190 
#
4191 
# Inputs          :
4192 
#
4193 
# Returns         :
4194 
#
4195 
my @svnDataItems;
4196 
sub getSvnData
4197 
{
4198 
    Message ("Examine Subversion Tree");
4199 
 
4200 
    #
4201 
    #   Re-init data
4202 
    #
4203 
    @svnDataItems = ();
4204 
    %svnData = ();
4205 
 
4206 
    #
4207 
    #   Create an SVN session
4208 
    #
4209 
    return unless ( $svnRepo );
4210 
    my $svn = NewSessionByUrl ( "$svnRepo/$packageNames" );
4211 
    return unless ( $svn );
4212 
 
4213 
    #
4214 
    #   extract data
4215 
    #
4216 
#    DebugDumpData("SVN", $svn );
4217 
    $svn->SvnCmd ( 'log', '-v', '--xml', '--stop-on-copy', $svn->Full()
4218 
                    , { 'credentials' => 1,
4219 
                        'process' => \&ProcessSvnLog,
4220 
                         }
4221 
                        );
4222 
 
4223 
    #
4224 
    #   Process data
4225 
    foreach my $entry ( @svnDataItems )
4226 
    {
4227 
        my $name;
4228 
        my $isaBranch;
4229 
        my $target = $entry->{target};
4230 
        if ( $target =~ m~/tags/(.*)~ ) {
4231 
            $name = $1;
4232 
            $svnData{tags}{$name} = 1;
4233 
        } elsif ( $target =~ m~/branches/(.*)~ )  {
4234 
            $name = $1;
4235 
    #        $branches{$1} = 1;
4236 
        } else {
4237 
            $svnData{nonTag}{$target} = 1;
4238 
        }
4239 
 
4240 
        my $fromBranch;
4241 
        if ( $entry->{fromPath} =~ m~/trunk$~  ) {
4242 
            $fromBranch = 'trunk';
4243 
        } elsif ( $entry->{fromPath} =~ m~/branches/(.*)~ ) {
4244 
            $fromBranch = $1;
4245 
        }
4246 
 
2429 dpurdie 4247 
        # largest Rev number on branch
4248 
        if ( exists $svnData{max}{$fromBranch} )
1271 dpurdie 4249 
        {
2429 dpurdie 4250 
            if ( $svnData{max}{$fromBranch}{rev} <  $entry->{fromRev} )
1271 dpurdie 4251 
            {
2429 dpurdie 4252 
                $svnData{max}{$fromBranch}{rev} =  $entry->{fromRev};
4253 
                $svnData{max}{$fromBranch}{name} = $name;
1271 dpurdie 4254 
            }
4255 
        }
2429 dpurdie 4256 
        else
4257 
        {
4258 
            $svnData{max}{$fromBranch}{rev} =  $entry->{fromRev};
4259 
            $svnData{max}{$fromBranch}{name} = $name;
4260 
        }
1271 dpurdie 4261 
    }
2429 dpurdie 4262 
 
4263 
    foreach my $branch ( keys %{$svnData{max}} )
4264 
    {
4265 
        $svnData{tips}{$svnData{max}{$branch}{name}} = $branch;
4266 
    }
4267 
#    DebugDumpData("svnDataItems", \@svnDataItems);
1271 dpurdie 4268 
#    DebugDumpData("SvnData", \%svnData);
4269 
 
2429 dpurdie 4270 
 
1271 dpurdie 4271 
    foreach my $entry ( keys(%versions) )
4272 
    {
4273 
        my $import_label = saneLabel($entry);
4274 
        delete $versions{$entry}{svnVersion};
4275 
        delete $versions{$entry}{svnBranchTip};
4276 
 
4277 
        if ( exists $svnData{tags}{$import_label} )
4278 
        {
4279 
            $versions{$entry}{svnVersion} = 1;
4280 
        }
4281 
 
4282 
        if ( exists $svnData{tips}{$import_label} )
4283 
        {
4284 
            $versions{$entry}{svnBranchTip} = $svnData{tips}{$import_label};
4285 
        }
4286 
    }
4287 
 
2429 dpurdie 4288 
    Message ( 'Trunk used: ' . (exists $svnData{'max'}{trunk} ? 'Yes' : 'No') );
1271 dpurdie 4289 
    Message ( 'Labels    : ' . scalar keys %{$svnData{tags}} );
2429 dpurdie 4290 
    Message ( 'Branches  : ' . scalar keys %{$svnData{'max'}} );
1271 dpurdie 4291 
}
4292 
 
4293 
#-------------------------------------------------------------------------------
4294 
# Function        : ProcessSvnLog
4295 
#
4296 
# Description     :
4297 
#                   Parse
4298 
#                       <logentry
4299 
#                          revision="24272">
4300 
#                       <author>bivey</author>
4301 
#                       <date>2005-07-25T15:45:35.000000Z</date>
4302 
#                       <paths>
4303 
#                       <path
4304 
#                          prop-mods="false"
4305 
#                          text-mods="false"
4306 
#                          kind="dir"
4307 
#                          copyfrom-path="/enqdef/branches/Stockholm"
4308 
#                          copyfrom-rev="24271"
4309 
#                          action="A">/enqdef/tags/enqdef_24.0.1.sls</path>
4310 
#                       </paths>
4311 
#                       <msg>COTS/enqdef: Tagged by Jats Svn Import</msg>
4312 
#                       </logentry>
4313 
#
4314 
# Inputs          :
4315 
#
4316 
# Returns         :
4317 
#
4318 
my $entryData;
4319 
sub  ProcessSvnLog
4320 
{
4321 
    my ($self, $line ) = @_;
4322 
#print "----- $line\n";
4323 
    if ( $line =~ m~^<logentry~ ) {
4324 
        $entryData = ();
4325 
 
4326 
    } elsif ( $line =~ m~^\s+revision="(\d+)"~ ) {
4327 
        $entryData->{Rev} = $1;
4328 
 
4329 
    } elsif ( $line =~ m~^\s+copyfrom-path="(.*)"~ ) {
4330 
        $entryData->{fromPath} = $1;
4331 
 
4332 
    } elsif ( $line =~ m~^\s+copyfrom-rev="(\d+)"~ ) {
4333 
        $entryData->{fromRev} = $1;
4334 
 
4335 
    } elsif ( $line =~ m~\s+action=.*?>(.*)</path~ ) {
4336 
        $entryData->{target} = $1;
4337 
 
4338 
    } elsif ( $line =~ m~</logentry~ ) {
4339 
        if ( exists $entryData->{fromPath} )
4340 
        {
4341 
#            DebugDumpData("Data", $entryData);
4342 
            push @svnDataItems, $entryData;
4343 
        }
4344 
    }
4345 
 
4346 
    #
4347 
    #   Return 0 to keep on going
4348 
    return 0;
4349 
}
4350 
 
4351 
#-------------------------------------------------------------------------------
4352 
# Function        : saveData
4353 
#
4354 
# Description     : Save essential data
4355 
#
4356 
# Inputs          :
4357 
#
4358 
# Returns         :
4359 
#
4360 
sub saveData
4361 
{
4362 
    my $file = $cwd . "/${packageNames}.data";
4363 
 
4364 
    Message ("Create: $file");
4365 
    my $fh = ConfigurationFile::New( $file );
4366 
 
4367 
    $fh->DumpData(
4368 
        "\n# ScmVersions.\n#\n",
4369 
        "ScmVersions", \%versions );
4370 
 
4371 
    #
4372 
    #   Close out the file
4373 
    #
4374 
    $fh->Close();
4375 
}
4376 
#-------------------------------------------------------------------------------
4377 
# Function        : GetData_by_filelist
4378 
#
4379 
# Description     : Read in source data from a file
4380 
#
4381 
# Inputs          : FileName
4382 
#                   Format is 2002-03-05T17:13:50+08 rmussell MASS_DATAMAN_D1.0.0
4383 
#
4384 
# Returns         :
4385 
#
4386 
sub GetData_by_filelist
4387 
{
4388 
    my ($fname) = @_;
4389 
    my $pv_id = 0;
4390 
#print "GetData_by_filelist\n";
4391 
 
4392 
    open (my $fh, '<', $fname ) || Error ("Cannot open Filelist");
4393 
    while ( <$fh> )
4394 
    {
4395 
        next if ( m~^\s*\#~ );
4396 
        my @data = split( /\s+/, $_);
4397 
#print "@data\n";
4398 
        if ( @data == 3 )
4399 
        {
4400 
            $data[2] =~ m~^(.*)_(.*)~;
4401 
            my $pkg_name = $1;
4402 
            my $pkg_ver = $2;
4403 
            $pkg_ver =~ s~^[a-zA-Z]\.*~~;
4404 
print "$data[2] : $pkg_name, $pkg_ver\n";
4405 
 
2429 dpurdie 4406 
#           Expecting Clearcase format:
4407 
#               2011-08-30T13:49:21+08
4408 
#               2010-11-16T03:24:34Z
1271 dpurdie 4409 
#           Need 'YYYY-MM-DDTHH:MM:SS.M'
4410 
            my $cdate = $data[0];
4411 
            $cdate =~ s~ ~T~;
4412 
            $cdate =~ s~\+.*~~;
2429 dpurdie 4413 
            $cdate =~ s~Z+.*~~;
1271 dpurdie 4414 
            $cdate .= '.00';
4415 
 
4416 
            $pv_id++;
4417 
#            $versions{$pv_id}{fileListEntry} = $_;
4418 
            $versions{$pv_id}{name} = $pkg_name;
4419 
            $versions{$pv_id}{pvid} = $pv_id;
4420 
            $versions{$pv_id}{vname} = $pkg_ver;
4421 
            $versions{$pv_id}{vcsTag} = "CC::/MASS_Dataman::$data[2]";
4422 
            $versions{$pv_id}{created} = $cdate;
4423 
            $versions{$pv_id}{created_id} = $data[1];
4424 
            $versions{$pv_id}{realLabel} = $data[2];
4425 
            $versions{$pv_id}{comment} = "Label Import: $data[2]";
4426 
            $versions{$pv_id}{locked} = 'Y';
4427 
            $versions{$pv_id}{TimeStamp} = str2time( $versions{$pv_id}{created} );
4428 
            $versions{$pv_id}{Age} = ($now - $versions{$pv_id}{TimeStamp}) / (60 * 60 * 24);
4429 
            $versions{$pv_id}{TooOld} = 1 if ( $opt_age && $opt_age <= $versions{$pv_id}{Age} );
4430 
            examineVcsTag($pv_id);
4431 
 
4432 
            #
4433 
            #   Process version number
4434 
            #
4435 
            my ($suffix, $version, $isaR, $isaWip, $buildVersion ) = massageVersion($pkg_ver, $pkg_name);
4436 
 
4437 
            $versions{$pv_id}{version} = $version;
4438 
            $versions{$pv_id}{buildVersion} = $buildVersion;
4439 
            $versions{$pv_id}{isaRipple} = 1 if ( $isaR );
4440 
            $versions{$pv_id}{isaWip} = 1 if ( $isaWip );
4441 
 
4442 
            #
4443 
            #   Process suffix
4444 
            #
4445 
            $suffix = 'Unknown' unless ( $suffix );
4446 
            $suffix = lc ($suffix);
4447 
            $versions{$pv_id}{suffix} = $suffix;
4448 
            push @{$suffixes{$suffix}}, $pv_id;
4449 
 
4450 
#DebugDumpData("PKG ", $versions{$pv_id} );
4451 
 
4452 
        }
4453 
    }
4454 
    close $fh;
4455 
}
4456 
 
4457 
 
4458 
#-------------------------------------------------------------------------------
4459 
#   Documentation
4460 
#
4461 
 
4462 
=pod
4463 
 
4464 
=for htmltoc    SYSUTIL::cc2svn::
4465 
 
4466 
=head1 NAME
4467 
 
4468 
cc2svn_gendata - CC2SVN tool to import an entire package into SVN
4469 
 
4470 
=head1 SYNOPSIS
4471 
 
4472 
  jats cc2svn_importpackage [options] package_name
4473 
 
4474 
 Options:
4475 
    -help              - brief help message
4476 
    -help -help        - Detailed help message
4477 
    -man               - Full documentation
4478 
    -repository=name   - Specify target repository
4479 
    -[no]flat          - Do not create project tree. Def: -noflat
4480 
    -prunemode=mode    - Mode: none, ripple, retain, severe, Def=ripple
4481 
    -retain=N          - Specify retain count for pruning. Def=2
4482 
    -[no]test          - Do not create packages. Def:-notest
4483 
    -[no]reuse         - Keep and reuse ClearCase views
4484 
    -age=nnDays        - Only keep recent package
4485 
    -dump[=n]          - Dump raw data. N=0,1,2
4486 
    -images[=n]        - Create SVG of version tree. N=0,1,2
4487 
    -name=aaa          - Alternate output package name. Test Only
4488 
    -[no]log           - Write output to log file. Def: -nolog
4489 
    -[no]postimage     - Create image after transger: Def: -post
4490 
    -workdir=path      - Use for temp storage (def:/work)
1272 dpurdie 4491 
    -delete            - Delete SVN package before test
2429 dpurdie 4492 
    -[no]relabel       - Attempt to relabel dirs in packages that don't extract
4493 
    -filelist=path     - Use named list of files
1271 dpurdie 4494 
 
4495 
=head1 OPTIONS
4496 
 
4497 
=over 8
4498 
 
4499 
=item B<-help>
4500 
 
4501 
Print a brief help message and exits.
4502 
 
4503 
=item B<-help -help>
4504 
 
4505 
Print a detailed help message with an explanation for each option.
4506 
 
4507 
=item B<-man>
4508 
 
4509 
Prints the manual page and exits.
4510 
 
4511 
=item B<-prunemode=mode>
4512 
 
4513 
This option control the manner in which excess versions will be pruned. Valid
4514 
modes are:
4515 
 
4516 
=over 8
4517 
 
4518 
=item   none
4519 
 
4520 
No pruning will be performed
4521 
 
4522 
=item   ripple
4523 
 
4524 
Non-Essential packages that are ripple builds will be removed.
4525 
 
4526 
=item   retain
4527 
 
4528 
Versions that preceed an Essential version will be retained.
4529 
 
4530 
=item   severe
4531 
 
4532 
Only Essential Versions, and Branching points will be retained.
4533 
 
4534 
=back
4535 
 
4536 
=back
4537 
 
4538 
=head1 DESCRIPTION
4539 
 
4540 
This program is a tool used in the conversion of ClearCase VOBS to subversion.
4541 
It will take a complete package and all relevent versions from ClearCase and
4542 
insert them into subversion in a sessible manner. It will attempt to retain
4543 
file change order and history.
4544 
 
4545 
It will:
4546 
 
4547 
=over 8
4548 
 
4549 
=item *
4550 
 
4551 
Read in the Essential Package Version list.
4552 
 
4553 
=item *
4554 
 
4555 
Extract, from Release Manager, all known versions of the specified package.
4556 
 
4557 
=item *
4558 
 
4559 
It will attempt to determine the type of package: COTS, TOOL, CORE, PROJECT
4560 
and alter the processing accordingly.
4561 
 
4562 
=item *
4563 
 
4564 
It will create a version dependency tree and determine 'new' project branch
4565 
points. It will remove (prune) versions that are excess to requirements.
4566 
 
4567 
=item *
4568 
 
4569 
It will extract source from ClearCase and insert it into SVN, creating
4570 
branches and tags as it goes.
4571 
 
4572 
=back
4573 
 
4574 
The program can also be used to create a SVG image of the version dependency
4575 
tree. This does not work on Linux; only Windows with 'dot' installed.
4576 
 
4577 
=cut
4578