Subversion Repositories DevTools

Rev

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

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