Subversion Repositories DevTools

Rev

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