Subversion Repositories DevTools

Rev

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