Subversion Repositories DevTools

Rev

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