Subversion Repositories DevTools

Rev

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

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