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

Subversion Repositories DevTools

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