Subversion Repositories DevTools

Rev

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

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