WebSVN – DevTools – Blame – /core_devl/branches/dpurdie_devl/TOOLS/LOCAL/cc2svn_importpackage.pl

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

Subversion Repositories DevTools

(root)/core_devl/branches/dpurdie_devl/TOOLS/LOCAL/cc2svn_importpackage.pl – Rev 3890