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

Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/LOCAL/cc2svn_importpackage.pl – Rev 3559