Rev 4086 | Blame | Compare with Previous | Last modification | View Log | RSS feed
######################################################################### Copyright (C) 1998-2012 Vix Technology, All rights reserved## Module name : cc2svn_importpackage.pl# Module type : Makefile system# Compiler(s) : Perl# Environment(s): jats## Description : Get package information for a package name specified on the# command line.## Determine the package id# Locate all packages that have the same package name# Determine essential packages# Prune uneeded packages## Pump it into SVN## Project Based Pumping, creating branches as needed##......................................................................#require 5.006_001;use strict;use warnings;use JatsError;use JatsRmApi;use FileUtils;use JatsSystem;use HTTP::Date;use JatsProperties;use JatsEnv;use ConfigurationFile;use JatsSvn qw(:All);use JatsLocateFiles;use JatsBuildFiles;use Encode;#use Data::Dumper;use Fcntl ':flock'; # import LOCK_* constantsuse Cwd;use DBI;use Getopt::Long;use Pod::Usage; # required for help supportuse Encode;## Options#my $opt_help = 0;my $opt_manual = 0;my $opt_verbose = 0;my $opt_repo_base = 'AUPERASVN01/';my $opt_repo = '';my $opt_repoSubdir = '';my $opt_flat;my $opt_test;my $opt_reuse = 0;my $opt_age;my $opt_dump = 0;my $opt_images = 0;my $opt_retaincount = 2;my $opt_pruneModeString;my $opt_listTags;my $opt_name;my $opt_log = 0;my @opt_tip;my $opt_postimage = 1;my $opt_workDir = '/work';my $opt_vobMap;my $opt_preserveProjectBase;my $opt_ignoreProjectBaseErrors;my $opt_ignoreMakeProjectErrors;my $opt_ignoreBuildFileClashes;my $opt_forceProjectBase;my @opt_limitProjectBase;my @opt_selectProjectBase;my @opt_mergePaths;my $opt_ignoreBadPaths;my $opt_delete;my $opt_recentAge = 14; # Daysmy $opt_relabel = 0;my $opt_protected;my $opt_useSvn = 1;my $opt_testRmDatabase;my $opt_extractFromSvn;my $opt_AllowMuliplePaths = 1; #29-Nov-2012my $opt_resume;my $opt_processRipples = 1;my $opt_mergePackages;my @opt_deleteFiles;my $opt_useTestRepo;my $opt_saveCompressed;my $opt_skipBuildNameCheck;my $opt_deleteLinks;my $count_BadPaths = 0;my $opt_IgnoreBadSourcePath;my $opt_forceSuck;my $opt_noVCS;my $opt_onlyOneBranch = 0;################################################################################# List of Projects Suffixes and Branch Names to be used within SVN## Name - Name of branch for the project# Trunk - Can be a trunk project# First one seen will be placed on the trunk# Others will create project branches#my $ProjectTrunk;my %ProjectsBaseCreated;my %Projects = ('.sea' => { Name => 'Seattle' },'.coct' => { Name => 'CapeTown' },'.sls' => { Name => 'Stockholm' },'.syd' => { Name => 'Sydney' },'.vtk' => { Name => 'Vasttrafik' },'.bei' => { Name => 'Beijing' },'.bkk' => { Name => 'Bangkok' },'.ndl' => { Name => 'NewDelhi' },'.nzs' => { Name => 'NewZealandStageCoach' },'.wdc' => { Name => 'Washington' },'.oso' => { Name => 'Oslo' },'.lvs' => { Name => 'LasVegas' },'.mlc' => { Name => 'BeijingMlc' },'.sfo' => { Name => 'SanFrancisco' },'.sg' => { Name => 'Singapore' },'.gmp' => { Name => 'GmpteProject' },'.ssw' => { Name => 'UkStageCoach' },'.uk' => { Name => 'UkProject' },'.pmb' => { Name => 'Pietermaritzburg' },'.vps' => { Name => 'VixPayments' },'.ncc' => { Name => 'NSWClubCard' },'.rm' => { Name => 'Rome' },'.vss' => { Name => 'SmartSite' },'.ssts' => { Name => 'SydneySchoolbus' },'unknown' => { Name => 'UnknownProject' },'brussels' => { Name => 'Brussels' },'.ebr' => { Name => 'eBrio' , Trunk => 1 },'.mas' => { Name => 'Mass' , Trunk => 1 },'.cr' => { Name => 'Core' , Trunk => 1 },'.cots' => { Name => 'Cots' , Trunk => 1 },'.tool' => { Name => 'Tools' , Trunk => 1 },'perth' => { Name => 'Perth' , Trunk => 1 },);my %suffixFixup = ('.sf' => '.sfo','.vt' => '.vtk','.lv' => '.lvs','.was' => '.wdc','.uk.1' => '.uk','.ssts.demo' => '.ssts','.u244.syd' => '.syd','.pxxx.sea' => '.sea','.pxxx.syd' => '.syd','.pxxx.sydddd' => '.syd','.oslo' => '.oso','.osl' => '.oso','.0x3' => '.cr','.0x4' => '.cr','.0x5' => '.cr','.0x13' => '.cr',);my %specialPackages = ('core_devl' => ',all,protected,','daf_utils_mos' => ',flat,','mos_packager' => ',all,','cfmgr-cfmgr' => ',flat,','daf_utils_button_st' => ',flat,','ReleaseName' => ',flat,','reports' => ',utf8,','cda_imports' => ',utf8,','cdxforms' => ',utf8,','db_cda' => ',utf8,','Dataman' => ',utf8,','CommandServer' => ',IgnoreMakeProject,','TDSExporterControl' => ',IgnoreMakeProject,','cdagui' => ',IgnoreMakeProject,','daf_bvt' => ',IgnoreMakeProject,', # Look OK'daf_dll' => ',IgnoreMakeProject,', # MakeProject not in used makefile'PFTPi' => ',IgnoreMakeProject,', # Looks OK'PFTPu' => ',IgnoreMakeProject,', # Looks OK'WinCEBlocker' => ',IgnoreMakeProject,', # Looks OK'WinCEDeviceAutoInject' => ',IgnoreMakeProject,', # Looks OK'WinCEReboot' => ',IgnoreMakeProject,', # Looks OK'ftp' => ',SetProjectBase,','ddu_app_manager' => ',SetProjectBase,IgnoreMakeProject,','ddu_afc' => ',SetProjectBase,IgnoreMakeProject,','ddu_dog' => ',SetProjectBase,IgnoreMakeProject,ForceProjectBase=/DPG_SWCode/projects/seattle/ddu,','ddu_management' => ',SetProjectBase,IgnoreMakeProject,ForceProjectBase=/DPG_SWCode,','ddu_fim' => ',IgnoreMakeProject,','ddu_mccain' => ',SetProjectBase,IgnoreMakeProject,ForceProjectBase=/DPG_SWCode/projects/seattle/ddu,','ddu_mon' => ',SetProjectBase,IgnoreMakeProject,ForceProjectBase=/DPG_SWCode/projects/seattle,','ddu_rcu' => ',SetProjectBase,IgnoreMakeProject,ForceProjectBase=/DPG_SWCode,','ddu_status_logging' => ',SetProjectBase,IgnoreMakeProject,ForceProjectBase=/DPG_SWCode/projects/seattle,','ddu_logging_lib' => ',SetProjectBase,ForceProjectBase=/DPG_SWCode/projects/seattle/ddu,','verifone' => ',ForceProjectBase=/DPG_SWCode/products/verifone,','dm_devcdfile' => 'AllowMultiPath','daf_ct_mcr_unified' => 'AllowMultiPath','cst-rms-db' => 'AllowMultiPath','daf_common' => 'IgnoreProjectBase','devcd' => 'AllowMultiPath','daf_dll' => 'AllowMultiPath,IgnoreMakeProject', # MakeProject not in used makefile'daf_transap_proxyman_edf' => 'AllowMultiPath,IgnoreProjectBase','devrelease' => 'AllowMultiPath','dm_devrelease' => 'AllowMultiPath','dm_rtswis' => 'AllowMultiPath','dm_devcd' => 'AllowMultiPath','dm_documentation' => 'AllowMultiPath,IgnoreBadPath','dm_eventhdr' => 'AllowMultiPath','dm_javaenums' => 'AllowMultiPath','dm_solidbasetypes' => 'AllowMultiPath','dm_swismetadata' => 'AllowMultiPath','dm_cuttables' => 'AllowMultiPath','dm_devudapi' => 'AllowMultiPath','buscdapi' => 'AllowMultiPath','daf_bvt' => 'AllowMultiPath,IgnoreMakeProject,', # Look OK'daf_cd_transap' => 'AllowMultiPath,IgnoreBadPath,IgnoreProjectBase','cdref' => 'AllowMultiPath','dm_sysbasetypes' => 'AllowMultiPath','dm_sysswis' => 'AllowMultiPath','dm_syscd' => 'AllowMultiPath','dm_udtypes' => 'AllowMultiPath','dm_systemcdtables' => 'AllowMultiPath','dm_utils' => 'AllowMultiPath','dm_udxml' => 'AllowMultiPath','HCP5000_resources' => 'AllowMultiPath','massrtswis' => 'AllowMultiPath','pcp5000' => 'AllowMultiPath,ForceProjectBase=/DPG_SWCode','PFTPi' => 'AllowMultiPath,IgnoreMakeProject,ForceProjectBase=/DPG_SWCode', # Looks OK'PFTPu' => 'AllowMultiPath,IgnoreMakeProject,ForceProjectBase=/DPG_SWCode', # Looks OK'WinCEBlocker' => ',IgnoreMakeProject,', # Looks OK'WinCEDeviceAutoInject' => ',IgnoreMakeProject,', # Looks OK'WinCEReboot' => ',IgnoreMakeProject,', # Looks OK'rsmaint' => 'AllowMultiPath','sysbasetypes' => 'AllowMultiPath','syscd' => 'AllowMultiPath','sysswis' => 'AllowMultiPath','udserialiser' => 'AllowMultiPath','systemcdtables' => 'AllowMultiPath','udxml' => 'AllowMultiPath','ERGoracs' => 'AllowMultiPath','daf_cd_desfireparams' => 'AllowMultiPath','daf_ct_mag_virtual' => 'AllowMultiPath','daf_br_applets' => 'AllowMultiPath','daf_paper_variables' => 'AllowMultiPath','daf_transap_api' => 'AllowMultiPath,ForceProjectBase=/DPG_SWBase/transap','daf_br_applets' => 'AllowMultiPath,IgnoreProjectBase', # Not used'daf_udlib_api' => 'AllowMultiPath,ForceProjectBase=/DPG_SWBase/ud','daf_ct_mcr_14443' => 'LimitProjectBase=/DPG_SWBase/ct','daftestcd_sales' => 'AllowMultiPath,ForceProjectBase=/ProjectCD/seattle','daftestcd_vanpool' => 'AllowMultiPath,ForceProjectBase=/ProjectCD','daf_transap_edf' => 'AllowMultiPath,IgnoreProjectBase','daf_transap_extensions' => 'AllowMultiPath','daf_transap_proxyman_rkf_mag' => 'AllowMultiPath','daf_utils_appupgrade' => 'AllowMultiPath','dc5000' => 'AllowMultiPath,IgnoreMakeProject,ForceProjectBase=/DPG_SWCode','uiconv' => 'AllowMultiPath','daf_ct_api' => 'AllowMultiPath','ocpsupport' => 'AllowMultiPath,IgnoreMakeProject', # MakeProject Tested on at least one'emv_cs_test_ingenico' => 'AllowMultiPath,IgnoreMakeProject', # MakeProject Tested on at least one'deviceicons' => 'AllowMultiPath,LimitProjectBase=/DPG_SWBase/resources:/DPG_SWCode/resources','pcv_final_wce' => 'IgnoreMakeProject', # MakeProject Tested on at least one'pcv_wce' => 'IgnoreMakeProject', # MakeProject Tested on at least one'WinCEDeviceUpgrade' => 'IgnoreMakeProject', # MakeProject Tested on at least one'scil' => 'LimitProjectBase=/DPG_SWCode/projects/seattle/tvm','daf_br_compiler_support' => 'ForceProjectBase=/DPG_SWBase/daf_br_compiler/support','daf_br_th' => 'IgnoreBadPath,all,IgnoreMakeProject', # MakeProject Tested. Bad Paths not used'linux_kernel_bcp4600' => 'ForceProjectBase=/LMOS/linux/kernel','linux_kernel_viper' => 'ForceProjectBase=/LMOS/linux/kernel','linux_kernel_cobra' => 'ForceProjectBase=/LMOS/linux/kernel','LinuxDrivers' => 'flatTime,processRipples,LimitProjectBase=/LMOS/linux/drivers'.',mergePaths=modules:bcp4600:cobra:eb5600:etx86:tp5600:viper','flashCopier' => 'flatTime,LimitProjectBase=/LMOS/tools/flashCopier'.',mergePaths=+:src:pcp5700:eb5600:tp5600','u-boot' => 'flatTime,LimitProjectBase=/LMOS/linux/bootstrap/u-boot'.',mergePaths=+:src:u-boot:u-boot-hk','dams_gen1' => 'flatTime,LimitProjectBase=/LMOS/apps/dams'.',mergePaths=+:tp5600:eb5600:pcp5700:core:doc'.',processRipples','linux_day0fs_gen1' => 'flatTime,LimitProjectBase=/LMOS/linux/filesystems/day0-fs'.',mergePaths=+:tp5600:eb5600:pcp5700:etx86:common'.',processRipples','linux_kernel_gen1' => 'flatTime,mergePaths=,processRipples,LimitProjectBase=/LMOS/linux/kernel','serpent' => 'flatTime,processRipples,LimitProjectBase=/LMOS/linux/kernel'.',mergePaths=serpent-common:common:cobra:viper','rt3070' => 'flatVersion','TRACS' => 'IgnoreMakeProject,DeleteFiles=*.plg', # not tested'qtobeapp' => 'Trunk=.uk','br_applets' => 'flatTime,LimitProjectBase=/ProjectCD/seattle'.',mergePaths=++:build/**:Sales/**:FarePayment/**:KCM/**:unit_test/**:VP/**:WSF/**'.',processRipples','CDAdministration' => 'RetainCompressed,IgnoreMakeProject,SelectProjectBase=MASS_Dev_Infra/DeviceCDManagement/cpp/CDAdministrator:MASS_Dev_Infra/CDAdministrator:MASS_Dev_Infra/CDAdministrator_vt:MASS_Dev_Infra/Cda/java:MASS_Dev_Infra/CDA:MASS_Dev_Infra','obme' => ',IgnoreMakeProject,','apportionment' => 'SkipBuildFileCheck','almgr' => 'SkipBuildFileCheck,SelectProjectBase=MASS_Dev_Bus/CBP/al/almgr/cpp:MASS_Dev_Bus/CBP/al/almgr:MASS_Dev_Bus/CBP/al:MASS_Dev_Bus/CBP','cvm' => 'SelectProjectBase=MASS_Dev_Bus/CBP/cvm/cpp:MASS_Dev_Bus/CBP/cvm','esvrapi' => 'SelectProjectBase=MASS_Dev_Bus/CBP/enquiry/esvrapi/cpp:MASS_Dev_Bus/CBP/enquiry/esvrapi','Validation' => 'SelectProjectBase=MASS_Dev_Bus/CBP/validation/validation/cpp:MASS_Dev_Bus/CBP/validation/validation','txnfilter' => 'DeleteLinks,SelectProjectBase=MASS_Dev_Bus/CBP/txnfilter/txnfilter:MASS_Dev_Bus/CBP/txnfilter/cpp:MASS_Dev_Bus/CBP/txnfilter','card' => 'SelectProjectBase=MASS_Dev_Bus/Card/cpp:MASS_Dev_Bus/Card','cbps' => 'SelectProjectBase=MASS_Dev_Bus/CBP/cbps/cpp:MASS_Dev_Bus/CBP/cbps:MASS_Dev_Bus/CBP','issuercommon' => 'SelectProjectBase=MASS_Dev_Bus/Issuer/issuerCommon/cpp:MASS_Dev_Bus/Issuer/issuerCommon','ivp' => 'SelectProjectBase=MASS_Dev_Bus/CBP/ivp/ivp/cpp:MASS_Dev_Bus/CBP/ivp/ivp:MASS_Dev_Bus/CBP/ivp:MASS_Dev_Bus/CBP','daf_transap_mag' => 'SelectProjectBase=DPG_SWBase/transap/proxy/mag:DPG_SWBase/transap/proxy','daf_transap_proxyman' => 'SelectProjectBase=DPG_SWBase/transap/proxymanager','daf_transap_rkf' => 'SkipBuildFileCheck','daf_cd_common' => 'IgnoreProjectBase','altp' => 'SelectProjectBase=MASS_Dev_Bus/CBP/al/altp/cpp:MASS_Dev_Bus/CBP/al/altp','cfm' => 'SelectProjectBase=MASS_Dev_Bus/CBP/cfm/cpp:MASS_Dev_Bus/CBP/cfm','enqdef' => 'SelectProjectBase=MASS_Dev_Bus/CBP/enquiry/enqdef','expstat' => 'SelectProjectBase=MASS_Dev_Bus/CBP/expstat/cpp:MASS_Dev_Bus/CBP/expstat','olsenqxdr' => 'SelectProjectBase=MASS_Dev_Bus/CBP/enquiry/olsenqxdr/cpp:MASS_Dev_Bus/CBP/enquiry/olsenqxdr','olseod' => 'SelectProjectBase=MASS_Dev_Bus/CBP/olseod/olseod/cpp:MASS_Dev_Bus/CBP/olseod/olseod:MASS_Dev_Bus/CBP/olseod','streamer' => 'SelectProjectBase=MASS_Dev_Bus/CBP/streamer/cpp:MASS_Dev_Bus/CBP/streamer','tgen' => 'SelectProjectBase=MASS_Dev_Bus/CBP/tgen/cpp:MASS_Dev_Bus/CBP/tgen','daf_transap_ultralight'=> 'flatTime,processRipples,mergePaths=++',# 'daf_cardshark' => 'flatTime,processRipples,mergePaths=++','emv_raw_cs' => 'flatTime,processRipples,SelectProjectBase=DPG_SWBase/emv_cs/emv_raw_cs/cpf:DPG_SWBase/emv_cs/emv_raw_cs'.',mergePaths=++:linux/**:win32/**','OpManCronJob' => 'SkipBuildFileCheck','issuertest' => 'SelectProjectBase=MASS_Dev_Bus/Issuer/test/IssuerTest:MASS_Dev_Bus/Issuer/test/cpp:MASS_Dev_Bus/Card/test/cpp:MASS_Dev_Bus/Card/test/cpp','obits_simulator' => 'IgnoreMakeProject','application' => 'IgnoreMakeProject,SelectProjectBase=MASS_Dev_Bus/Application','FinCommon' => 'SkipBuildFileCheck,SelectProjectBase=MASS_Dev_Bus/Financial','FinRun' => 'SkipBuildFileCheck,SelectProjectBase=MASS_Dev_Bus/Financial','olstxnstream' => 'SelectProjectBase=MASS_Dev_Infra/core_olstxnstream','product' => 'SkipBuildFileCheck,SelectProjectBase=MASS_Dev_Bus/Product','oracen-bei-patch' => 'RetainCompressed','oracen-patch' => 'RetainCompressed','pcv' => 'IgnoreMakeProject','summarisation' => 'SkipBuildFileCheck','AVMApplicationEngine' => 'IgnoreMakeProject','ESL' => 'IgnoreMakeProject','daf_br_oar' => 'IgnoreProjectBase', # Look OK'daf_br' => 'RetainCompressed,IgnoreProjectBase,IgnoreMakeProject,SelectProjectBase=DPG_SWBase/daf_br:DPG_SWBase/br', # Look OK'daf_dti' => 'IgnoreProjectBase,SelectProjectBase=DPG_SWBase/dti;DPG_SWBase','OcpGui' => 'IgnoreMakeProject','ssu5000' => 'ForceProjectBase=/DPG_SWCode','obftp' => 'IgnoreMakeProject,IgnoreProjectBase,ForceProjectBase=/DPG_SWCode','saftp' => 'IgnoreProjectBase,ForceProjectBase=/DPG_SWCode','PFTPp' => 'IgnoreMakeProject,ForceProjectBase=/DPG_SWCode', # Need to test'ocp5000' => 'ForceProjectBase=/DPG_SWCode,RetainCompressed,IgnoreMakeProject', # Need to test'SPOS' => 'ForceProjectBase=/DPG_SWCode','gak6000' => 'ForceProjectBase=/DPG_SWCode,IgnoreProjectBase','gak5000' => 'ForceProjectBase=/DPG_SWCode,IgnoreProjectBase,IgnoreBadPath','hcp5000' => 'IgnoreMakeProject,ForceProjectBase=/DPG_SWCode,RetainCompressed,IgnoreBadSourcePath','agents_unit' => 'IgnoreProjectBase,ForceProjectBase=/DPG_SWCode','tp5000' => 'noVCS,IgnoreProjectBase,ForceProjectBase=/DPG_SWCode','vcp5000' => 'IgnoreProjectBase,ForceProjectBase=/DPG_SWCode','MetrixOra' => 'Trunk=.sea,ForceSuck,ForceProjectBase=/MASS_Dev_Bus,IgnoreBadSourcePath,NoProcessRipples',# 'oracs' => 'ForceSuck,ForceProjectBase=/MASS_Dev_Bus,IgnoreBadSourcePath,NoProcessRipples,SelectProjectBase=MASS_Dev_Bus/web/patches/oracs:MASS_Dev_Bus/web/patches:MASS_Dev_Bus/web','oradacw' => 'ForceSuck,ForceProjectBase=/MASS_Dev_Bus,IgnoreBadSourcePath,NoProcessRipples,SelectProjectBase=MASS_Dev_Bus/web/patches/oradacw:MASS_Dev_Bus/web/patches:MASS_Dev_Bus/web','orabocw' => 'ForceSuck,ForceProjectBase=/MASS_Dev_Bus,IgnoreBadSourcePath,NoProcessRipples,SelectProjectBase=MASS_Dev_Bus/web/patches/orabocw:MASS_Dev_Bus/web/patches:MASS_Dev_Bus/web','boi-issuer' => 'OnlyOneBranch=.vtk,noVCS','oracs' => 'SetProjectBase,IgnoreBadSourcePath,NoProcessRipples,mergePaths=++:Model/*','icl' => 'IgnoreProjectBase,','itso' => 'IgnoreProjectBase,',# 'daf_osa_mos' => 'IgnoreProjectBase,','daf_utils_mos' => 'IgnoreProjectBase,','itso_ud' => 'IgnoreProjectBase,',# 'mos_api' => 'IgnoreProjectBase,',# 'mos_fonts' => 'IgnoreProjectBase,',# 'sntp' => 'IgnoreProjectBase,',# 'time_it' => 'IgnoreProjectBase,',);my %mergePathExtended = ('linux_kernel_gen1' => {'linux_kernel_eb5600_2.6.21.1.0.cots' => '+:TP5600:EB5600:ETX86:common:packager.sflash:www.kernel.org:packager.grub','linux_kernel_tp5600_2.6.21.1.0.cots' => '+:tp5600:eb5600:etx86:bcp4600:common:packager.sflash:www.kernel.org:packager.grub',},'serpent' => {'linux_kernel_viper_2.6.24.6.0000.cots' => 'common:viper','linux_kernel_viper_2.6.24.6.1000.cots' => 'serpent-common:cobra:viper',},);my %packageRippleControl = ('linux_drivers_etx86' => 'major','linux_drivers_eb5600' => 'major','linux_drivers_tp5600' => 'major',);my %notCots = ('isl' => 1,);my %ukHopsReleases = ('6222' => { name => 'MainLine', 'trunk' => 1 },'14503' => { name => 'Hops3' },'21864' => { name => 'Hops3.6' },'22303' => { name => 'Hops3.7' },'17223' => { name => 'Hops4' },# '19743' => {name => 'ITSO.2.1.4-MainlineOBE_Validator'},# '11743' => {name => 'ITSO.2.1.3-MainlineOBE_Validator'},# '21384' => {name => 'OBE2.1.3-GoAheadRelease-R4'},# '23243' => {name => 'OBE2.1.3-GoAheadRelease-R4.5'},# '23843' => {name => 'Validator.2.1.3-UKlive'},# '15663' => {name => 'Validator.2.1.3-LegacyVersion_SSW_LMR'},# '25183' => {name => 'ITSO.2.1.4-Validator-cmnITSO.V2src'},# '24303' => {name => 'OBME_PSION-MAINLINE-ITSO.2.1.4'},# '13143' => {name => 'OBME_PSION-MAINLINE-ITSO.2.1.2'},# '24443' => {name => 'OBME_PSION-MAINLINE-ITSO.2.1.2-hot-fix'},# '16023' => {name => 'OBME_PSION-TransportScotlandDLL'},);# The following packages will have the version in the specified release forced to be on the trunk# A trunk will be forced and the version will be on it.# May only work if the version in the release is also a TIPmy %ukHopsTip = ('ItsoMessaging' => '6222','MessageProcessor' => '6222','StrongNameKey' => '6222',);################################################################################# Global data#my $VERSION = "1.0.0";my $RM_DB;my $last_pv_id;my %pkg_ids;my $first_pkg_id;my %versions;my %suffixes;my @processOrder;my @startPoints;my @allStartPoints;my @endPoints;my $now = time();my $logSummary;my $firstVersionCreated;my @EssentialPackages;my $createBranch;my $createSuffix;my $currentBranchName;my $singleProject;my $pruneCount = 0;my $trimCount = 0;my $badVcsCount = 0;my $ProjectCount = 0;my $totalVersions = 0;my $initialTrees = 0;my $globalError;my @unknownProjects;my %knownProjects;my $badSingletonCount = 0;my @flatOrder;my $flatMode = 0;my $pruneMode;my $pruneModeString;my $threadId = 0;my $threadCount;my %tipVersions;my $allSvn;my @multiplePaths;my @badEssentials;my %svnData;my $cwd;my $mustConvertFileNames;my $workDir;my $packageNames;my @packageNames;my $multiPackages = -1;my $visitId = 0;my $noTransfer;my $rippleCount = 0;my $svnRepo;my $processCount = 0;my $processTotal = 0;my $recentCount = 0;my $packageReLabelCount = 0;my %saneLabels;my $adjustedPath = 0;my $forceImportFlush = 0;my %restoreData;our $GBE_RM_URL;my $UNIX = $ENV{'GBE_UNIX'};my $result = GetOptions ('help+' => \$opt_help, # flag, multiple use allowed'manual:3' => \$opt_help,'verbose:+' => \$opt_verbose, # Versose'repository:s' => \$opt_repo, # Name of repository'rbase:s' => \$opt_repo_base, # Base of the repo'flat!' => \$opt_flat, # Flat structure'test!' => \$opt_test, # Test operations'reuse:1' => \$opt_reuse, # Reuse ClearCase views 0:None, 1=Retain, 2=Use+Delete'age:i' => \$opt_age, # Only recent versions'dump:1' => \$opt_dump, # Dump Data'images:1' => \$opt_images, # Create DOT images'retain:i' => \$opt_retaincount, # Retain N packages'pruneMode:s' => \$opt_pruneModeString,'listtags:i' => \$opt_listTags,'name:s' => \$opt_name, # Alternate output'tip:s' => \@opt_tip, # Force tip version(s)'log!' => \$opt_log,'delete!' => \$opt_delete,'postimage!' => \$opt_postimage,'workdir:s' => \$opt_workDir,'relabel!' => \$opt_relabel,'svn!' => \$opt_useSvn,'testRmDatabase' => \$opt_testRmDatabase,'resume' => \$opt_resume,'mergePackages:s' => \$opt_mergePackages,'subdir:s' => \$opt_repoSubdir, # Subdir within repo'fromSvn!' => \$opt_extractFromSvn,'testRepo!' => \$opt_useTestRepo,'novcs' => \$opt_noVCS,);## Process help and manual options#pod2usage(-verbose => 0, -message => "Version: $VERSION") if ($opt_help == 1 || ! $result);pod2usage(-verbose => 1) if ($opt_help == 2 );pod2usage(-verbose => 2) if ($opt_manual || ($opt_help > 2));## Configure the error reporting process now that we have the user options#SystemConfig ('ExitOnError' => 1);ErrorConfig( 'name' =>'CC2SVN_IMPORT','verbose' => $opt_verbose,);Error("Workdir does not exist" ) unless ( -d $opt_workDir );Error("Specify a package as 'name'" ) unless ( defined $ARGV[0] );EnvImport('GBE_RM_URL');$cwd = Getcwd();## Allow use of the test database# Defaut is live data, but some error recovery stuff can be done via# the test database.#if ( $opt_testRmDatabase ){Warning ("Using Test Database");$ENV{GBE_RM_USERNAME} = 'RELEASE_MANAGER';$ENV{GBE_RM_PASSWORD} = 'RELEASE_MANAGER';$ENV{GBE_RM_LOCATION} = 'jdbc:oracle:thin:@auperaora07.vix.local:1521:RELMANU1';}## Init the pruning mode#setPruneMode( $opt_pruneModeString || 'ripple');## Detect Merge Package Request# These use pre-configured bits#if ( $opt_mergePackages ){if ( $opt_mergePackages eq 'LinuxDrivers' ){$opt_name = $opt_mergePackages;@ARGV = qw (linux_drivers_eb5600linux_drivers_viperlinux_drivers_cobralinux_drivers_etx86linux_drivers_tp5600);# linux_drivers_bcp4600} elsif ( $opt_mergePackages eq 'flashCopier' ) {$opt_name = $opt_mergePackages;@ARGV = qw (flash_copier_eb5600flash_copier_pcp5700flash_copier_tp5600);} elsif ( $opt_mergePackages eq 'u-boot' ) {$opt_name = $opt_mergePackages;@ARGV = qw (u-bootu-boot-hk);} elsif ( $opt_mergePackages eq 'dams_gen1' ) {$opt_name = $opt_mergePackages;@ARGV = qw (dams_eb5600dams_pcp5700dams_tp5600);} elsif ( $opt_mergePackages eq 'linux_day0fs_gen1' ) {$opt_name = $opt_mergePackages;@ARGV = qw (linux_day0fs_eb5600linux_day0fs_tp5600linux_day0fs_etx86);} elsif ( $opt_mergePackages eq 'linux_kernel_gen1' ) {$opt_name = $opt_mergePackages;@ARGV = qw (linux_kernel_etx86linux_kernel_tp5600linux_kernel_eb5600linux_kernel_bcp4600);} elsif ( $opt_mergePackages eq 'serpent' ) {$opt_name = $opt_mergePackages;@ARGV = qw (linux_kernel_viperlinux_kernel_cobra);} elsif ( $opt_mergePackages eq 'emv_raw_cs_merge' ) {$opt_name = 'emv_raw_cs';@ARGV = qw (emv_raw_csemv_raw_cs-w32);} elsif ( $opt_mergePackages eq 'seattleBr' ) {$opt_name = 'br_applets';@ARGV = qw (br_applet_cstbr_applet_gak_wsfbr_applet_gak_wsf_posbr_applet_obftp_ctbr_applet_obftp_etbr_applet_obftp_kcmbr_applet_obftp_ktbr_applet_obftp_ptbr_applet_obftp_stbr_applet_pftp_ct_brtbr_applet_pftp_ct_vanpoolbr_applet_pftp_kcm_dartbr_applet_pftp_kcm_rrbr_applet_pftp_kcm_vanpoolbr_applet_pftp_ktbr_applet_pftp_pt_vanpoolbr_applet_pftp_stbr_applet_pftp_st_llrbr_applet_pftp_wsfbr_applet_saftp_ct_brtbr_applet_saftp_kcm_rrbr_applet_saftp_stbr_applet_saftp_st_llrbr_applet_trubr_applet_tvmunit_test_br_cstunit_test_br_gakunit_test_br_kcm_ct_saftpunit_test_br_obftpunit_test_br_st_saftpunit_test_br_vanpoolSalesConfiguration);} else{Error ("Unknown Merge Package Name: $opt_mergePackages");}}# Get data for all packages#foreach my $packageName ( @ARGV ){next unless ( $packageName );Verbose( "Base Package: $packageName");my $pkg_id = GetPkgIdByName ( $packageName );GetData_by_pkg_id ( $pkg_id, $packageName );$pkg_ids{$pkg_id} = 1;$first_pkg_id = $pkg_id unless ( $first_pkg_id );push @packageNames, $packageName;$multiPackages++;}{## Delete entries that have been created as we read in# data, but don't exist in RM. They will not have a pvid.#foreach my $entry ( keys(%versions) ){delete $versions{$entry}unless ( exists $versions{$entry}{pvid} );}}$totalVersions = scalar keys %versions;Error ("No packages specified") unless ( $multiPackages >= 0 );Warning ("Multiple Packages being processed") if ( $multiPackages > 1 );$packageNames = join ('_', @packageNames );$packageNames = $opt_name if ( defined $opt_name );Message ("PackageName: $packageNames" );## Save logging data#if ( $opt_log ){my $opt_logfile = $packageNames . '.import';Message ("Logging outout: $opt_logfile" );open STDOUT, '>', $opt_logfile or die "Can't redirect STDOUT: $!";open STDERR, ">&STDOUT" or die "Can't dup STDOUT: $!";}## Prepare tip version hash#$tipVersions{$_} = 1 foreach ( @opt_tip );## Read in external data and massage it all#getEssenialPackageVersions();getVobMapping();smartPackageType(); # Determine special prune modeReportPathVariance();massageData();getSvnData();smartPackageType(); # Have another gorestoreData() if ( $opt_resume );my @missedTips = keys %tipVersions;Error ("Specified tip version not found: @missedTips") if ( @missedTips );if ( $opt_flat ){# @flatOrder = sort {$versions{$a}{version} cmp $versions{$b}{version}} keys(%versions);# @flatOrder = sort {$versions{$a}{created} cmp $versions{$b}{created}} keys(%versions);if ( $flatMode == 1 ) {Message ("Flat import. Sorted by TimeStamp");@flatOrder = sort {$versions{$a}{TimeStamp} cmp $versions{$b}{TimeStamp}} keys(%versions);} elsif ( $flatMode == 2 ) {Message ("Flat import. Sorted by Version");# Only iff all the bits are numericsub sortCotsVersion{my @va = split '\.', $versions{$a}{vname};my @vb = split '\.', $versions{$b}{vname};my $rv = scalar @va <=> scalar @vb;return $rv if ( $rv );foreach my $ii ( 0 .. scalar @va ){$va[$ii] = '' unless ( defined $va[$ii] );$vb[$ii] = '' unless ( defined $vb[$ii] );if ( ($va[$ii] =~ m~^\d+$~) && ($va[$ii] =~ m~^\d+$~) ){$rv = $va[$ii] <=> $vb[$ii];}else{$rv = $va[$ii] cmp $vb[$ii];}return $rv if ( $rv );}return $rv;}@flatOrder = sort sortCotsVersion keys(%versions);# @flatOrder = sort {$versions{$a}{vname} cmp $versions{$b}{vname}} keys(%versions);} else {@flatOrder = sort {$a <=> $b} keys(%versions);}my $tip = $flatOrder[-1];$versions{$tip}{Tip} = 1 if $tip;}## Generate dumps and images#if ( $opt_images || 1 ){createImages();}if ( $opt_dump ){DebugDumpData ("Versions", \%versions );DebugDumpData ("Starts", \@startPoints );DebugDumpData ("Ends", \@endPoints );DebugDumpData ("Suffixes", \%suffixes );}# Display VCS tags#if ( $opt_listTags ){foreach my $entry (sort {$versions{$a}{version} cmp $versions{$b}{version}} keys(%versions) ){print $versions{$entry}{vcsTag} || '-' ,"\n";}}exit if ( ($opt_dump > 1) || ($opt_images > 1) );transferPackageToSvn();if ( $opt_postimage ){getSvnData();createImages();}exit 0;#-------------------------------------------------------------------------------# Function : transferPackageToSvn## Description : Transfer the package to SVN## Inputs :## Returns :#sub transferPackageToSvn{Error ("Repository Path not setup")unless ( $svnRepo );## Going to do serious work# Need to ensure we have more arguments#if ( $opt_protected ){Warning("Protected Package not transferred: $packageNames - $opt_protected","See cc2svn_protected.txt for details");exit 0;}if ( $noTransfer ){Warning("Protected Package not transferred: $packageNames","Configured within this program");exit 0;}## Perform all the work in a package specific subdirectory#$workDir = $opt_workDir . '/' . $packageNames;mkdir $workDir unless ( -d $workDir );chdir $workDir || Error ("Cannot cd to $workDir");## Process all packages# Going to create versions based on RM structure# May have several starting points: Process each#newPackage();if ( $opt_flat ){newProject();foreach my $entry (@flatOrder ){newPackageVersion( $entry, $versions{$entry}{suffix} );}}else{processBranch(@allStartPoints);}endPackage();chdir $cwd || Error ("Cannot cd back to $cwd");rmdir $workDir;Warning ("Work Directory still exists: $workDir");saveData();}#-------------------------------------------------------------------------------# Function : setPruneMode## Description : Set the pruning mode## Inputs : mode - Text mode value## Returns : Nothing#sub setPruneMode{my ($mode) = @_;my $value;if ( $mode ){if ( $mode =~ m/none/i) {$value = 0;} elsif ( $mode =~ m/ripple/i) {$value = 1;} elsif ( $mode =~ m/retain/i) {$value = 2;} elsif ( $mode =~ m/severe/i) {$value = 3;} else {Error ("Unknown pruning mode", "Use: none, ripple, retain or severe");}$pruneModeString = $mode;$pruneMode = $value;}}#-------------------------------------------------------------------------------# Function : smartPackageType## Description : Have a look at the projects in the package set and# attempt to determine what sort of mechanism to use## Inputs : Uses %suffixes data## Returns :#my $packageType = 'UNKNOWN';sub smartPackageType{## Rebuild suffixes hash based on post massaged versions#my %suffixes;my @unknown;foreach my $entry ( keys %versions ){my $suffix = $versions{$entry}{suffix} || '';push (@unknown, $entry) if ($suffix eq 'unknown');next if ( exists $suffixes{$suffix} );next if ( $versions{$entry}{badSingleton} );next if ( $versions{$entry}{locked} eq 'N' || $versions{$entry}{isaWip} );$suffixes{$suffix} = 1;$knownProjects{$suffix}{seen} = 1;}## The 'unknown' suffix is really an 'empty' suffix# Try to be clever# Map unknown to 'cr' or 'mas' if present##if ( exists $suffixes{'unknown'} ){my $new_suffix;if ( exists $suffixes{'.cr'} ) {$new_suffix = '.cr';} elsif ( exists $suffixes{'.mas'} ) {$new_suffix = '.mas';}if ( $new_suffix ){foreach my $entry ( @unknown ){$versions{$entry}{suffix} = $new_suffix;}delete $suffixes{'unknown'};delete $knownProjects{'unknown'}{seen};}}if ( exists $suffixes{'.cots'} && !exists ($notCots{$packageNames}) ) {$packageType = 'COTS';$Projects{'.cots'}{Trunk} = 1;$singleProject = 1;$opt_flat = 1 unless defined $opt_flat;setPruneMode('none') unless (defined $opt_pruneModeString);} elsif ( exists $suffixes{'.tool'} ) {$packageType = 'TOOL';$Projects{'.tool'}{Trunk} = 1;$singleProject = 1;setPruneMode('none') unless (defined $opt_pruneModeString);# $opt_flat = 1;} elsif ( scalar (keys %suffixes ) == 1 ) {$packageType = 'SINGLE_PROJECT';$singleProject = 1;} else {$packageType = 'MULTIPLE_PROJECT';}## Some packages are special#if ( $svnRepo =~ m~/Manufacturing(/|$)~ ){Message ("Set Manufacturing Repo style");$opt_flat = 1;setPruneMode('none') unless (defined $opt_pruneModeString);}if ( $packageNames =~ m'^br_applet_' ){$opt_flat = 1 unless defined $opt_flat;}if ( exists $specialPackages{$packageNames} ){my $data = ',' . $specialPackages{$packageNames} . ',';if ( index( $data, ',all' ) >= 0) {setPruneMode('none') unless (defined $opt_pruneModeString);}if ( index( $data, ',protected,' ) >= 0) {$noTransfer = 1;}if ( index( $data, ',flat,' ) >= 0) {$opt_flat = 1;}if ( index( $data, ',flatTime,' ) >= 0) {Message ("Flatten import tree. Sort by Time");$opt_flat = 1;$flatMode = 1; # By Time$opt_processRipples = 0;}if ( index( $data, ',flatVersion,' ) >= 0) {Message ("Flatten import tree. Sort by Version");$opt_flat = 1;$flatMode = 2; # By Version$opt_processRipples = 0;}if ( index( $data, ',processRipples,' ) >= 0) {$opt_processRipples = 1;}if ( index( $data, ',NoProcessRipples,' ) >= 0) {$opt_processRipples = 0;Message ("Disable Processing of ripples");}## This is a real kludge. The user MUST make sure that the branch AND all related# branches ( xxx_for_yyy.zzz ) have been deleted from the repository.#if ( $data =~ m~,Onlyonebranch=(.*?),~ ) {$opt_onlyOneBranch = $1;Message ("Limiting the import to one branch: $opt_onlyOneBranch");unless (exists $Projects{$opt_onlyOneBranch}){Error("The specified branch does not map to a configured project");}}if ( index( $data, ',noVCS,' ) >= 0) {$opt_noVCS = 1;Message ("Use of ClearCase disabled.");}if ( index( $data, ',SetProjectBase,' ) >= 0) {$opt_preserveProjectBase = 1;$opt_ignoreProjectBaseErrors = 1;Message ("Preserving ProjectBase");}if ( index( $data, ',AllowMultiPath,' ) >= 0) {$opt_AllowMuliplePaths = 1;Message ("Allowing Multiple Paths");}if ( index( $data, ',IgnoreBadSourcePath,' ) >= 0) {$opt_IgnoreBadSourcePath = 1;Message ("Ignore Source Paths tagged as Bad");}if ( $data =~ m~,ForceProjectBase=(.*?),~ ) {$opt_forceProjectBase = $1;$opt_AllowMuliplePaths = 1;Message ("Force Project Base: $opt_forceProjectBase");}if ( $data =~ m~,LimitProjectBase=(.*?),~ ) {$opt_AllowMuliplePaths = 1;@opt_limitProjectBase = split(':', $1);Message ("Limit Project Base: @opt_limitProjectBase");}if ( $data =~ m~,SelectProjectBase=(.*?),~ ) {$opt_AllowMuliplePaths = 1;@opt_selectProjectBase = split(':', $1);Message ("Select Project Base from: @opt_selectProjectBase");}if ( $data =~ m~,mergePaths=(.*?),~ ) {@opt_mergePaths = split(':', $1);Message ("Merge Paths: @opt_mergePaths");}if ( $data =~ m~,DeleteFiles=(.*?),~ ) {@opt_deleteFiles = split(':', $1);Message ("Delete Files: @opt_deleteFiles");}if ( $data =~ m~,DeleteLinks,~ ) {$opt_deleteLinks = 1;Message ("Delete soft links");}if ( index( $data, ',ForceSuck,' ) >= 0) {$opt_forceSuck = 1;Message ("Force sucking empty directories");}if ( index( $data, ',IgnoreProjectBase,' ) >= 0) {$opt_ignoreProjectBaseErrors = 1;Message ("Ignore ProjectBase Errors");}if ( index( $data, ',IgnoreMakeProject,' ) >= 0) {$opt_ignoreMakeProjectErrors = 1;Message ("Ignore MakeProject Usage");}if ( index( $data, ',NoBuildFileCheck,' ) >= 0) {$opt_ignoreBuildFileClashes = 1;Message ("Ignoring Build File Clashes");}if ( index( $data, ',SkipBuildFileCheck,' ) >= 0) {$opt_skipBuildNameCheck = 1;Message ("Skip Build File Clashes Testing");}if ( index( $data, ',IgnoreBadPath,' ) >= 0) {$opt_ignoreBadPaths = 1;Message ("Ignore Bad Paths in makefile Usage");}if ( index( $data, ',utf8,' ) >= 0) {$mustConvertFileNames = 1;Message ("Convert filenames to UTF8");}if ( index( $data, ',NoRetain,' ) >= 0) {$opt_reuse = 2;Message ("Package Versions not Retained");}if ( index( $data, ',RetainCompressed,' ) >= 0) {$opt_saveCompressed = 1;Message ("Package Versions will be retained as compressed images");}if ( $data =~ m~,Trunk=(.*?),~ ) {my $tt = $1;$Projects{$tt}{Trunk} = 1;Message ("Force project to trunk: $tt");}}Message("Package Type: $packageType, $pruneModeString");}#-------------------------------------------------------------------------------# Function : massageData## Description : Massage all the data to create a tree of package versions# that can be used to create images as well as an import order## Inputs :## Returns :#my $reprocess=0;sub calcLinks{## Process the 'versions' hash and:# Add back references# Find starts and ends# Entry with no previous# Entry with no next#$reprocess = 0;foreach my $entry ( keys(%versions) ){foreach ( @{ $versions{$entry}{next}} ){$versions{$_}{last} = $entry;}}@allStartPoints = ();@startPoints = ();@endPoints = ();foreach my $entry ( keys(%versions) ){push @startPoints, $entryunless ( exists $versions{$entry}{last} || $versions{$entry}{badSingleton} );push @allStartPoints, $entryunless ( exists $versions{$entry}{last} );push @endPoints, $entryunless ( @{$versions{$entry}{next}} > 0 )}}sub massageData{## Report unknown suffixes# Handle bad, or little known project suffixes by creating them#foreach my $suffix ( keys %suffixes ){if ( exists $Projects{$suffix} ){next;}Message ("Unknown project suffix: '$suffix'");push @unknownProjects, $suffix;my $cleanSuffix = ucfirst(lc(substr( $suffix, 1)));$Projects{$suffix}{Name} = 'Project_' . $cleanSuffix;}calcLinks();$initialTrees = scalar @allStartPoints;Message ('Total RM versions: ' . $totalVersions );Message ('Initial trees: ' . $initialTrees );## Attempt to glue all the start points into one chain.# This should allow us to track projects that branch from each other# in cases where the RM data is incorrect/incomplete# Strays are those that have no next or last## Glue based on Name, then PVID (Creation Order)#{## Examine threads. If it is a single entry thats bad then drop it# This is simple to do. Should examine all entries, but thats a# bit harder. Perhaps later.#if (1) {Message ("Dropping Bad Singletons");my $badSingletons;foreach my $entry ( sort {$a <=> $b} @startPoints ){my $ep = $versions{$entry};unless ( $ep->{last} || $ep->{next}[0] ){# if ( $ep->{isaWip} )if ( (!$opt_IgnoreBadSourcePath && (exists $ep->{badVcsTag} && $ep->{badVcsTag})) || $ep->{isaWip} ){$ep->{badSingleton} = 1;$reprocess = 1;$badSingletonCount++;# Add to a list of its own.if ( $badSingletons ){push @{$versions{$badSingletons}{next}}, $entry;}$badSingletons = $entry;}}}calcLinks()if ( $reprocess );}## True Patches show up as singletons - they have no parent# Need to create strands of patches to be glued onto the base#{my %patchTree;my $patchSeen;Message ("Creating patch threads");foreach my $entry ( sort {$versions{$a}{version} cmp $versions{$b}{version}} @startPoints ){my $ep = $versions{$entry};next unless ( defined $ep->{buildVersion} );my $suffix = $ep->{name} . $ep->{suffix};my ($major, $minor, $patch, $build) = @{$ep->{buildVersion}};my $patchBase = sprintf ("%3.3d.%3.3d.%3.3d.$suffix", $major, $minor, $patch);if ( defined $ep->{buildVersion} ){if ( $ep->{isaPatch} ){push @{$patchTree{$patchBase}}, $entry;$ep->{patchRoot} = $patchBase;$patchSeen++;}}}my %patchRoot;if ($patchSeen){foreach my $entry ( sort {$versions{$a}{version} cmp $versions{$b}{version}} keys %versions ){my $ep = $versions{$entry};next if ( $ep->{isaPatch} );next unless ( defined $ep->{buildVersion} );my $suffix = $ep->{name} . $ep->{suffix};my ($major, $minor, $patch, $build) = @{$ep->{buildVersion}};my $patchBase = sprintf ("%3.3d.%3.3d.%3.3d.$suffix", $major, $minor, $patch);if ( defined $patchRoot{$patchBase}){Warning ("Multiple Patch Roots identified", $versions{$patchRoot{$patchBase}}{vname},$ep->{vname}, "Both hash to: " . $patchBase );}else{$patchRoot{$patchBase} = $entry;}}#DebugDumpData('%patchRoot', \%patchRoot );foreach ( keys %patchTree ){my $last;foreach my $entry ( sort {$versions{$a}{version} cmp $versions{$b}{version}} @{$patchTree{$_}} ){if ( $last ){$versions{$last}{MakeTree} = 1;push @{$versions{$last}{next}}, $entry;$reprocess = 1;}else{# First entry in thread.# print "--- Patch Branch $versions{$entry}{vname}\n";$versions{$entry}{branchPoint} = 2;my $patchBase = $versions{$entry}{patchRoot};my $patchBaseEntry = $patchRoot{$patchBase};if ( $patchBase ){if ( defined($patchBaseEntry) && exists ($versions{$patchBaseEntry}) ){push @{$versions{$patchBaseEntry}{next}}, $entry;# Message( "Attaching ",$versions{$entry}{version}," to $patchBase");}else{Message( "Cannot Attach ",$versions{$entry}{version}," to $patchBase" );Warning ("Cannot attach thread. No base version");}}}$last = $entry;}}}calcLinks()if ( $reprocess );}#DebugDumpData('$verions', \%versions );## Create simple trees out of the chains# Tree is based on suffix (project) and version#{my %trees;Message ("Entries into trees");foreach my $single ( @startPoints ){my $suffix = $versions{$single}{suffix} || '';push @{$trees{$suffix}}, $single;}foreach ( keys %trees ){my $last;foreach my $entry ( sort {$versions{$a}{version} cmp $versions{$b}{version}} @{$trees{$_}} ){if ( $last ){$versions{$last}{MakeTree} = 1;push @{$versions{$last}{next}}, $entry;$reprocess = 1;}$last = $entry;}}calcLinks()if ( $reprocess );}## Have a number of trees that are project related# Attempt to create a single tree by inserting# Secondary trees into the main line at suitable points#my @AllVersions = sort { $a <=> $b } @startPoints;my $lastEntry = shift @AllVersions;Error ("Oldest entry has a previous version") if ( $versions{$lastEntry}{last} );#print "Oldest: $lastEntry\n";## Insert remaining entries into out list, which is now sorted#my @completeList;foreach my $base ( @AllVersions ){push @completeList, recurseList($lastEntry);@completeList = sort {$a <=> $b} @completeList;# Message("Complete List: ", @completeList);# Message("Complete List($completeList[0]) Length: " . scalar @completeList);$lastEntry = $base;my $last;foreach my $entry ( @completeList ){if ( $entry > $base ){Error ("Not expecting last to be empty. $base, $entry") unless ( $last );last;}$last = $entry;}## Insert at end if point not yet found##print "Inserting $base at $last\n";push @{$versions{$last}{next}}, $base;$versions{$base}{GluedIn} = 1;$reprocess = 1;}## Recalc basic links if any processing done#calcLinks()if ( $reprocess );}## Remove Dead Ends# Packages that were never released# Not locked, unless essential or a branchpoint# Won't consider these to be mainline path.#{Message ("Remove Dead Ends");foreach my $entry ( @endPoints ){my $deadWood;while ( $entry ){last if ( $versions{$entry}{Essential} );my @next = @{$versions{$entry}{next}};my $count = @next;last if ( $count > 1 );last unless ( $versions{$entry}{locked} eq 'N' || $versions{$entry}{isaWip} );$versions{$entry}{DeadWood} = 1;$trimCount++;} continue {$entry = $versions{$entry}{last};}}}## Walk each starting point list and determine new Projects# branchpoints.#Message ("Locate Projects branch points");foreach my $bentry ( keys(%versions) ){my $baseSuffix = $versions{$bentry}{suffix};foreach my $entry ( @{$versions{$bentry}{next}} ){if ( $baseSuffix ne $versions{$entry}{suffix}){unless ( exists $versions{$entry}{DeadWood} || $versions{$entry}{badSingleton} ){#print "--- Project Branch $versions{$entry}{vname}\n";$versions{$entry}{branchPoint} = 1;$versions{$entry}{newSuffix} = 1;}}}}## Mark UkHops special points#foreach my $entry ( keys(%versions) ) {foreach my $rtag_id ( keys %{$versions{$entry}{Releases}} ) {next unless ( exists $ukHopsReleases{$rtag_id} );next unless ( $svnRepo =~ m~/ITSO_TRACS$~ );## This package is current in a special ukHops release# Need to handle the differently#my $ukData = $ukHopsReleases{$rtag_id};# Mark version we want on the trunk# Will calculate tip laterif ( $ukData->{trunk} ){## Can only place on trunk IFF its a tip# May have a WIP.# Solution. Walk to the tip, but only if there is one# path.#my $end = $entry;my $last;while ( $end ){$last = $end;if ( @{$versions{$end}{next}} > 1){Warning ("Uk Release. Preferred trunk is not a tip: $versions{$entry}{vname}");last;}$end = @{$versions{$end}{next}}[0];}$versions{$last}{ukTrunk} = 1 ;}## What to do if the version is in more than one release#$versions{$entry}{ukBranch}++;if ( $versions{$entry}{ukBranch} > 1 ){Warning ("Version found in multiple Uk Releases - don't know what to do");}## What to do if the package has multiple version in a release#$ukData->{count}++;if ( $ukData->{count} > 1 ){Warning ("Package has multiple versions in the one Uk Release: $versions{$entry}{Releases}{$rtag_id}{rname}");}}}## Prune# Marks paths to root for all essential packages# Marks the last-N from all essential packages#if ( $pruneMode ){Message ("Prune Tree: $pruneModeString");foreach ( @EssentialPackages ){#next unless ( exists $versions{$_} ); # Aleady deleted# Mark previous-N to be retained as wellmy $entry = $_;my $count = 0;while ( $entry ){last if ( $versions{$entry}{KeepMe} );# unless ( $versions{$entry}{isaRipple} ){my $keepFlag = ($count++ < $opt_retaincount);last unless ( $keepFlag );$versions{$entry}{KeepMe} = $keepFlag;}$entry = $versions{$entry}{last}}}## Keep recent versions# Keep versions created in the last N days# Will keep recent ripples too#if ( $pruneMode == 1 ) # 1 == ripple{foreach my $entry ( keys(%versions) ){next unless ( $versions{$entry}{Age} <= $opt_recentAge );$versions{$entry}{keepRecent} = 1;$recentCount++;#print "--- Recent version $versions{$entry}{vname}, $versions{$entry}{Age} <= $opt_recentAge\n";}## Keep the tip of each branch#foreach my $entry ( @endPoints ){#print "--- Tip version $versions{$entry}{vname}\n";my $count = 0;while ( $entry && $count < 2){last if ( $versions{$entry}{Essential} );last if ( $versions{$entry}{keepRecent} );next if ( $versions{$entry}{locked} eq 'N' );next if ( $versions{$entry}{DeadWood} );#print "--- Keeping Tip version $versions{$entry}{vname}\n";$versions{$entry}{keepRecent} = 1;$count++;} continue {$entry = $versions{$entry}{last};}}}## Keep versions that are common parents to Essential Versions# Mark paths through the tree to essential versions# Mark nodes with the number of essential versions that they sprout# Don't do it if we are ripple pruning#Message ("Prune Tree keep common parents");if ( $pruneMode != 1 ){foreach my $entry ( @endPoints ){my $hasEssential = 0;$visitId++;while ( $entry ){$hasEssential = 1 if ( exists ($versions{$entry}{Essential}) && $versions{$entry}{Essential} );if ( $hasEssential ){if ( @{$versions{$entry}{next}} > 1 ){$versions{$entry}{EssentialSplitPoint}++;}last if ( exists $versions{$entry}{EssentialPath} );$versions{$entry}{EssentialPath} = 1;}if ( ($versions{$entry}{visitId} || 0) == $visitId ){DebugDumpData ("Versions", \%versions );Warning ("Circular dependency");last;}$versions{$entry}{visitId} = $visitId;$entry = $versions{$entry}{last};}}}## Keep first version of each ripple. Must keep first# Group ripples together so that they can be proccessed at the same time#calcRippleGroups()if ( $pruneMode == 1);## Delete all nodes that are not marked for retention# This is rough on the tree#Message ("Prune Tree Deleting");# 0 - Keep me# 1 - Prune mesub pruneMe{my ($entry) = @_;return 0 unless ( exists $versions{$entry} );return 0 unless ( $versions{$entry}{last} );# return 0 if ( ($pruneMode == 2) && exists $versions{$entry}{KeepMe} );return 0 if ( exists $versions{$entry}{KeepMe} );return 0 if ( exists $versions{$entry}{Essential} );return 0 if ( $versions{$entry}{newSuffix} );return 0 if ( $versions{$entry}{newSuffix} && (exists $versions{$entry}{EssentialPath}) );# return 1 if ( exists $versions{$entry}{DeadWood} );return 0 if ( exists $versions{$entry}{EssentialSplitPoint} && $versions{$entry}{EssentialSplitPoint} > 1 );return 0 if ( exists $versions{$entry}{keepLowestRipple} && $versions{$entry}{keepLowestRipple} );return 0 if ( ($pruneMode == 1) && ! $versions{$entry}{isaRipple} );return 0 if ( exists $versions{$entry}{keepRecent} && $versions{$entry}{keepRecent} );return 1;}## Determine a list of entries to be pruned# Done in two steps so that we can skip the pruning if its only a small number#my @pruneList;foreach my $entry ( keys(%versions) ){push ( @pruneList, $entry ) if ( pruneMe($entry) );}## If the list is very small then just import all of them#if ( scalar @pruneList < 10 ){Message ("Retaining pruned entries - low count:" . scalar @pruneList );@pruneList = ();} else {my $total = scalar keys %versions;if ( scalar @pruneList < ($total / 15)){Message ("Retaining pruned entries - low percentage of $total:" . scalar @pruneList );@pruneList = ();}}foreach my $entry (@pruneList ){#print "--- Prune: $versions{$entry}{vname}\n";# Delete the current node#my @newNext;$pruneCount++;my $last = $versions{$entry}{last};foreach ( @{$versions{$last}{next}} ){next if ( $_ == $entry );push @newNext, $_;}foreach ( @{$versions{$entry}{next}} ){push @newNext, $_;$versions{$_}{last} = $last;}@{$versions{$last}{next}} = @newNext;delete $versions{$entry};}# Recalculate endpointscalcLinks();}else{# No rippling happening# Some process still need to happen#calcRippleGroups();}## Want some versions to be forced to tip trunk#foreach my $name ( keys %ukHopsTip ){foreach my $entry ( keys(%versions) ){next unless ( $versions{$entry}{name} eq $name );next unless ( exists $versions{$entry}{Releases}{$ukHopsTip{$name}} );## Force this suffix to be the trunk# Remove all others#foreach my $suffix ( keys %Projects ){delete $Projects{$suffix}{Trunk};}my $suffix = $versions{$entry}{suffix};$Projects{$suffix}{Trunk} = 1;}}## Calculate best through-path for branches in the tree# Attempt to keep that 'max' version on the mainline# May be modified by -tip=nnnn## For each leaf (end point), walk backwards and mark each node with the# max version see. If we get to a node which already has been marked then# stop if our version is greater. We want the value to be the max version# to a leaf## Account for 'suffix'. When suffix changes, then the 'max' version must# be recalculated#Message ("Calculate Max Version");my $maxVersion;foreach my $entry ( @endPoints ){my $lastSuffix;my $forceTip;while ( $entry ){if (!defined($lastSuffix) || ($versions{$entry}{suffix} ne $lastSuffix) ){$maxVersion = '0';$visitId++;$forceTip = ( exists $tipVersions{$versions{$entry}{vname}} );$forceTip = 1 if $versions{$entry}{ukTrunk};delete $tipVersions{$versions{$entry}{vname}};$maxVersion = '999.999.999.999.zzz' if ( $forceTip );$lastSuffix = $versions{$entry}{suffix};#print "---Tip Found\n" if $forceTip;}# Detect circular dependenciesif ( ($versions{$entry}{visitId} || 0) == $visitId ){DebugDumpData ("Circular dependency: Versions", \%versions );Warning ("Circular dependency");last;}$versions{$entry}{visitId} = $visitId;my $thisVersion = $versions{$entry}{version} || '';if ( $thisVersion gt $maxVersion ){$maxVersion = $thisVersion;}if ( exists $versions{$entry}{maxVersion} ){if ( $versions{$entry}{maxVersion} gt $maxVersion ){last;}}$versions{$entry}{maxVersion} = $maxVersion;$entry = $versions{$entry}{last};}}## Locate all instances where a package-version branches# Determine the version that should be on the non-branching path## Reorder the 'next' list so that the first item is the non-branching# path. This will be used in the data-insertion phase to simplify the# processing.#Message ("Calculate package version branches");foreach my $entry ( sort {$a <=> $b} keys(%versions) ){calculateWalkOrder($entry);}## Mark Project Branch Tips as they will be in the Repository# Find each project head and walk primary entry to the end.#foreach my $entry ( keys(%versions) ){## Root of each tree is 'new'#unless ( defined $versions{$entry}{last}){unless ( $versions{$entry}{badSingleton} ){$versions{$entry}{newSuffix} = 1;}}## Update stats#$badVcsCount++ if ( $versions{$entry}{badVcsTag} );$ProjectCount++ if ( $versions{$entry}{newSuffix} );next if ( $opt_flat );next unless ($versions{$entry}{newSuffix} );#print "--- Project new Suffix $versions{$entry}{vname}\n";my $suffix = $versions{$entry}{suffix};$knownProjects{$suffix}{count}++;my $next = $versions{$entry}{next}[0];my $tip;while ( $next ){last if ( $suffix ne $versions{$next}{suffix} );$tip = $next unless (exists ($versions{$next}{DeadWood}) || $versions{$next}{badSingleton});$next = $versions{$next}{next}[0];}$versions{$tip}{Tip} = 1 if $tip;}unless ( $opt_flat ){my $finalTrees = scalar @startPoints;Warning ("Still have multiple trees: $finalTrees") unless ( $finalTrees == 1 );}## Display warnings about multiple#foreach ( sort keys %knownProjects ){my $count = $knownProjects{$_}{count} || 0;Warning ("Multiple Project Roots: $_ ($count)" )if ( $count > 1 );}## Display warnings about Bad Essential Packages#$allSvn = 1;foreach my $entry ( keys(%versions) ){markDpkgArchive($entry);$rippleCount++ if ( exists($versions{$entry}{isaRipple}) && $versions{$entry}{isaRipple} );$allSvn = 0 unless ( $versions{$entry}{isSvn} );next unless ( exists $versions{$entry}{Essential} );next unless ( $versions{$entry}{badVcsTag} );push @badEssentials, $entry;Warning ("BadVCS Essential: " . GetVname($entry));}## All done#$processTotal = scalar keys %versions;Message("Retained entries: $processTotal" );Message("Pruned entries: $pruneCount");Message("Deadwood entries: $trimCount");Message("Bad Singletons: $badSingletonCount");Message("Ripples: $rippleCount");Message("Recent entries: $recentCount");}sub calculateWalkOrder{my ($entry) = @_;my @next = @{$versions{$entry}{next}};my $count = @next;my @ordered;my $main;if ( $count > 1 ){# Array to hash to simplify removalmy %nexts = map { $_ => 1 } @next;foreach my $e ( @next ){## Locate branch points that are not a part of a new project# These will not be preferred paths for walking#if ( !defined($versions{$e}{branchPoint}) && $versions{$entry}{suffix} ne $versions{$e}{suffix} ){unless ( exists $versions{$e}{DeadWood} || $versions{$e}{badSingleton} ){#print "--- Project Branch (1) $versions{$e}{vname}\n";$versions{$e}{branchPoint} = 1;$versions{$e}{newSuffix} = 1;}}## Remove those that already have a branch,#if ( $versions{$e}{branchPoint} || $versions{$e}{newSuffix} || $versions{$e}{DeadWood} ){push @ordered, $e;delete $nexts{$e};}}## Select longest arm as the non-branching path# Note: Reverse sort order# Done so that 'newest' item is given preference# to the main trunk in cases where all subtrees are# the same length#my $maxData = '';my $countEntry;foreach my $e ( sort {$b <=> $a} keys %nexts ){if ( $versions{$e}{maxVersion} gt $maxData ){$maxData = $versions{$e}{maxVersion};$countEntry = $e;}}if ($countEntry){$main = $countEntry;delete $nexts{$countEntry};}## Append the remaining#push @ordered, keys %nexts;## Re-order 'next' so that the main path is first# Sort (non main) by number#@ordered = sort {$a <=> $b} @ordered;unshift @ordered, $main if ( $main );@{$versions{$entry}{next}} = @ordered;## Ensure all except the first are a branch point# First may still be a branch point#shift @ordered;foreach my $e ( @ordered ){$versions{$e}{branchPoint} = 1;}}}#-------------------------------------------------------------------------------# Function : calcRippleGroups## Description : Locate and mark ripple groups# packages that are ripples of each other# Keep first version of each ripple. Must keep first# Group ripples together so that they can be# proccessed at the same time## Inputs :## Returns :#sub calcRippleGroups{my %rippleVersions;foreach my $entry ( keys(%versions) ){my $ep = $versions{$entry};if ( defined $ep->{buildVersion} ){my $suffix = $ep->{suffix};my $pname = $ep->{name};$suffix = $pname . $suffix;my ($major, $minor, $patch, $build) = @{$ep->{buildVersion}};#print "--- $major, $minor, $patch, $build, $suffix\n";my $key;my $type = 'patch';$type = $packageRippleControl{$pname} if ( exists $packageRippleControl{$pname});if ( $type eq 'patch' ) {$key = "$major.$minor.$patch";# $build = $build;} elsif ( $type eq 'minor' ) {$key = "$major.$minor";# $build = ($patch * 1000) + $build;} elsif ( $type eq 'major' ) {$key = "$major";# $build = ($minor * 1000000) + ($patch * 1000) + $build;} else {Error ("Invalid type in packageRippleControl for package $pname: $type");}$rippleVersions{$suffix}{$key}{count}++;my $rp = $rippleVersions{$suffix}{$key};$rp->{list}{$entry} = $versions{$entry}{version};# next if ( $ep->{badVcsTag} );# next if ( $ep->{locked} eq 'N');# if (!defined ($rp->{min}) || $rp->{min} > $build )# {# $rp->{pvid} = $entry;# $rp->{min} = $build;# }}}# DebugDumpData("rippleVersions", \%rippleVersions );while ( my($suffix, $e1) = each %rippleVersions ){#DebugDumpData("rippleVersions. Suffix , e1", $suffix, $e1 );while ( my( $mmp, $e2) = each %{$e1} ){# next unless ( exists $e2->{pvid} );# my $entry = $e2->{pvid};# if ( !exists $versions{$entry} )# {# Error ("Internal: Expected entry not found: $entry, $mmp");# }## $versions{$entry}{keepLowestRipple} = 1;#print "--- Keep Ripple: $versions{$entry}{name} $versions{$entry}{vname}\n";## Update entry with list of associated ripples, removing lowest#my @rippleList = sort {$e2->{list}{$a} cmp $e2->{list}{$b}} keys %{$e2->{list}};my $firstEntry = shift @rippleList;$versions{$firstEntry}{keepLowestRipple} = 1;#print "--- Keep Lowest: $versions{$firstEntry}{name} $versions{$firstEntry}{vname}\n";if ( @rippleList){#DebugDumpData("LIST: $entry", $e2->{list}, \@rippleList );@{$versions{$firstEntry}{rippleList}} = @rippleList;# foreach my $pvid ( @rippleList )# {# print "----- $versions{$pvid}{name} $versions{$pvid}{vname}\n";# }}}}# Error ("Just Testing");}#-------------------------------------------------------------------------------# Function : processBranch## Description : Process one complete branch within the tree of versions# May be called recursivly to walk the tree## Inputs : Array of package-version ID to process## Returns : Nothing#sub processBranch{foreach my $entry ( @_ ){## Do we need to create a branch before we can process this package#if ( $versions{$entry}{newSuffix} || $versions{$entry}{branchPoint} ){newProject();$createBranch = 1;$createSuffix = 1 if $versions{$entry}{newSuffix};}newPackageVersion( $entry );no warnings "recursion";processBranch (@{$versions{$entry}{next}});}}#-------------------------------------------------------------------------------# Function : newPackageVersion## Description : Create a package version## Inputs : $entry - Ref to entry being proccessed## Returns :#sub newPackageVersion{my ($entry) = @_;my %data;my $flags = 'e';my $rv = 1;my $startTime = time();my $timestamp = localtime;$data{rmRef} = 'ERROR';$data{tag} = 'ERROR';## If its been processed then fake that its been done# May have been a ripple that we processed#return if ($versions{$entry}{Processed});$processCount++;Message ("------------------------------------------------------------------" );Message ("Package $processCount of $processTotal");Message ("New package-version: " . GetVname($entry) . " Tag: " . $versions{$entry}{vcsTag} );## Detect user abort#if ( -f $cwd . '/stopfile' ){$globalError = 1;Message ("Stop file located");}## If we have a global error,then we pretend to process, but we# report errors for the logging system#if ( $globalError ){Message ("Global error prevents futher importation. ($globalError)");}else{## Call worker function# It will exit on any error so that it can be logged#$rv = newPackageVersionBody( \%data, @_ );if ( $rv >= 10 ){$globalError = 2;Message("Global errror: ", $data{errStr});}}## Highlight essential packages that failed to transfer#if ( $globalError ) {$flags = 'e';} elsif ( $rv && ( exists $versions{$entry}{Essential} ) ) {$flags = 'X';} elsif ( $rv ) {$flags = 'E';} else {$flags = 'G';}## Always log results to a file# Flags:# e - Error: Global Fatal causes other versions to be ignored# X - Essential Package NOT proccessed# E - Error processing package# G - Good#my $duration = time() - $startTime;my $line = join(';',$flags,$entry,$packageNames,$versions{$entry}{vname},$data{rmRef},$data{tag},$timestamp,$duration,$data{errStr} || '');logToFile( $cwd . '/importsummary.txt', ";$line;");## Sava data#if ( $rv != 6 ){$data{errFlags} = $flags;$data{duration} = $duration;}$versions{$entry}{rmRef} = $data{rmRef};delete $data{rmRef};delete $data{tag};##delete $data{ViewRoot};$versions{$entry}{data} = \%data;## Delete the created view# Its just a directory, so delete it#if ( $data{ViewRoot} && -d $data{ViewRoot}){my $cfile = saneLabel($entry) . '.tgz';if ( $opt_reuse == 0 || $opt_reuse == 2 || ($rv && ($rv != 4 && $rv != 12 && $rv != 5 )) ){Message ("Delete View: $data{ViewRoot}");RmDirTree ($data{ViewRoot} );unlink $cfile;}else{Message ("Retaining View: $data{ViewRoot}");if ( $opt_saveCompressed ){Message ("Compressing the retained directory");unless ( -f $cfile ){my $rv = System ('tar', '-czf', $cfile, $data{ViewRoot} );if ( $rv ){Warning("Failed to compress directory");}}else{Message ("Reusing compressed file");}RmDirTree ($data{ViewRoot} );}}}else{Message ("No view to delete");}## Create pretty pictures#unless ( $rv ){getSvnData();createImages();}if($opt_processRipples){## If this version has any 'ripples' then process them while we have the# main view. Note the ripple list may contain entries that do not# exist - they will have been pruned.#foreach my $rentry ( @{$versions{$entry}{rippleList}} ){next unless( exists $versions{$rentry} );if ($versions{$rentry}{Processed}){Warning ("Ripple Processed before main entry");$versions{$rentry}{rippleProcessed} = 1;}Message ("Proccessing associated Ripple: " . GetVname($rentry));newPackageVersion($rentry);}}}#-------------------------------------------------------------------------------# Function : newPackageVersionBody## Description : Perform the bulk of the work in creating a new PackageVersion# Designed to return on error and have error processing# performed by caller## Inputs : $data - Shared data# $entry - Package entry to process## Returns : Error Code# 0 - All is well# <10 - Recoverable error# 1 - Bad VCS Tag# 2 - No Files in the extracted view# Label not found# Failed to extract files from CC# No Files in the extracted view after labeling dirs# 3 - Deadwood# 4 - Bad usage of ProjectBase detected# Use of MakeProject detected# 5 - Subversion Import disabled# 6 - Restored via resume# 7 - Not imported. not on Onle One Branch# >10 - Fatal error#sub newPackageVersionBody{my ($data, $entry) = @_;my $rv;my $vcs_type;my $cc_label;my $cc_path;my $cc_path_original;my $selectDir;## Init Data#$data->{rmRef} = 'ERROR';$data->{tag} = '';$data->{ViewRoot} = undef;$data->{ViewPath} = undef;$data->{errStr} = '';$versions{$entry}{Processed} = 1;SystemConfig ('ExitOnError' => 0);push @processOrder, $entry;return 0 if ( $opt_test );## Calculate the label for the target package# Use format <packageName>_<PackageVersion># Need to handle WIPs too.#my $import_label = saneLabel($entry);## If resuming - then test existence#if ( $opt_resume ){if ( exists $restoreData{$entry} ){## May be able to test existence by looking at $versions{$entry}{svnVersion}# The hard work may have been done#my $isInSvn = 0;if ( exists $versions{$entry}{svnVersion} && $versions{$entry}{svnVersion} ){$isInSvn = 1;}Message("SvnVersion check: $isInSvn");$rv = testSvnLabel( "$svnRepo/$packageNames", $import_label );unless ( $rv ){Message ("Skip import - resume detected presence");$firstVersionCreated = $entry unless ( $firstVersionCreated );$versions{$entry}{TagCreated} = 2;foreach ( keys %{$restoreData{$entry}} ){$data->{$_} = $restoreData{$entry}{$_};}$forceImportFlush = 1;DebugDumpData('Data', $data );return 6;}}else{Warning ("Resume data missing");}}## If we are only processing Only One Branch then skip versions that are not a part of that branch#if ($opt_onlyOneBranch){if ($versions{$entry}{'suffix'} eq $opt_onlyOneBranch){Message("Version on selected branch");}else{Message("Skip import. Version NOT on selected branch");return 7;}}# Keep DeadWood. May be a WIP# if ( exists $versions{$entry}{DeadWood} && $versions{$entry}{DeadWood} )# {# $data->{errStr} = 'Package is DeadWood';# return 3;# }## Check for a handcrafted substitute package# May have been created with gen_cots#testDpkgArchive($entry);if (extractFilesFromStore($data, $entry) ){Message ("Using package from store");}else{## Determine version information#if ($opt_IgnoreBadSourcePath){# Ignore versions tagged with a bad source path# Will expect that the Vob will be forced# Hope that we have a labeldelete $versions{$entry}{badVcsTag};}$data->{tag} = $versions{$entry}{vcsTag} || '';if ( $versions{$entry}{badVcsTag} ){Warning ("Error: Bad VcsTag for: " . GetVname($entry),"Tag: $data->{tag}" );$data->{errStr} = 'VCS Tag Marked as Bad';return 1;}$data->{tag} =~ m~^(.+?)::(.*?)(::(.+))?$~;$vcs_type = $1;$cc_label = $4;$cc_path = $2;$cc_path = '/' . $cc_path;$cc_path =~ tr~\\/~/~s;$cc_path_original = $cc_path;## Process IgnoreBadSourcePath#if ($opt_IgnoreBadSourcePath){if (($vcs_type eq 'UC') || (length($cc_label) < 1)){$versions{$entry}{badVcsTag} = 98;Warning ("Error: Bad VcsTag for: " . GetVname($entry),"Tag: $data->{tag}" );$data->{errStr} = 'VCS Tag Marked as Bad - and has no label';return 1;}}## Correct well known path mistakes in CC paths#if ( $vcs_type eq 'CC' ){$cc_path =~ s~/build.pl$~~i;$cc_path =~ s~/src$~~i;$cc_path =~ s~/cpp$~~i;$cc_path =~ s~/MASS_Dev/Infra/~/MASS_Dev_Infra/~i;$cc_path =~ s~/MASS_Dev/Tools/~/MASS_Dev_Tools/~i;$cc_path =~ s~/MASS_Dev/Bus/~/MASS_Dev_Bus/~i;$cc_path =~ s~/MASS_Dev_Bus/Cbp/~/MASS_Dev_Bus/CBP/~i;$cc_path =~ s~/MREF_Package/ergpostmongui$~/MREF_Package/ergpostmongui~i;$cc_path =~ s~/MREF_../MREF_Package/~/MREF_Package/~i;$cc_path =~ s~/MREF_Package/mass_ergocdp/~/MREF_Package/ergocdp/~i;$cc_path =~ s~/MASS_Dev_Bus/CBP/systemCD.ejb~/MASS_Dev_Bus/CBP/systemCD/ejb~i;$cc_path =~ s~/MASS_Dev_Bus/Financial/cpp/paymentmanager~/MASS_Dev_Bus/Financial/cpp/paymentmanager~i;$cc_path =~ s~/MASS_Dev_Bus/WebServices~/MASS_Dev_Bus/WebServices~i;$cc_path =~ s~/MASS_Dev_Bus/CBP/nullAdapter~//MASS_Dev_Bus/CBP/nullAdaptor~i;$cc_path =~ s~/DPG_SWBase/Services~/DPG_SWBase/services~i;$cc_path = '/MASS_Dev_Bus/Application' if ( $versions{$entry}{name} eq 'application');$cc_path = '/MASS_Dev_Bus/Product' if ( $versions{$entry}{name} eq 'product');$cc_path = '/MASS_Dev_Bus/Financial' if ( $versions{$entry}{name} eq 'FinRun');$cc_path = '/MASS_Dev_Bus' if ( $cc_path =~ m~/MASS_Dev_Bus/ImageCapture(/|$)~i );$cc_path = '/MASS_Dev_Bus' if ( $cc_path =~ m~/MASS_Dev_Bus/ImageCapture(/|$)~i );$cc_path = '/MASS_Dev_Bus/CBP/enquiry' if ( $versions{$entry}{name} eq 'EJBEnqPxyConnector');$cc_path = '/MASS_Dev_Bus/CBP/enquiry' if ( $versions{$entry}{name} eq 'proxyif4j');$cc_path = '/MASS_Dev_Bus' if ( $versions{$entry}{name} eq 'ImageCaptureTomcatDeployment');$cc_path = '/MASS_Dev_Bus/WebServices/MassWS' if ( $versions{$entry}{name} eq 'MassWebServicesImpl');if ( $versions{$entry}{name} =~ m/^ERGagency$/i|| $versions{$entry}{name} =~ m/^ERGavm$/i|| $versions{$entry}{name} =~ m/^ERGboi$/i|| $versions{$entry}{name} =~ m/^ERGcallcenter$/i|| $versions{$entry}{name} =~ m/^ERGcardholder$/i|| $versions{$entry}{name} =~ m/^ERGcdaimports$/i|| $versions{$entry}{name} =~ m/^ERGcda$/i|| $versions{$entry}{name} =~ m/^ERGcscedit$/i|| $versions{$entry}{name} =~ m/^ERGcs$/i|| $versions{$entry}{name} =~ m/^ERGofs$/i|| $versions{$entry}{name} =~ m/^ERGols$/i|| $versions{$entry}{name} =~ m/^ERGtpf$/i|| $versions{$entry}{name} =~ m/^ERGorasys$/i|| $versions{$entry}{name} =~ m/^ERGoracs$/i|| $versions{$entry}{name} =~ m/^ERGpxyif$/i|| $versions{$entry}{name} =~ m/^ERGtp5upg$/i|| $versions{$entry}{name} =~ m/^ERGinstitutional$/i|| $versions{$entry}{name} =~ m/^ERGinfra$/i|| $versions{$entry}{name} =~ m/^ERGcrrpts$/i|| $versions{$entry}{name} =~ m/^ERGmiddle$/i|| $versions{$entry}{name} =~ m/^ERGmiddleapi$/i|| $versions{$entry}{name} =~ m/^ERGwebapi$/i|| $versions{$entry}{name} =~ m/^ERGwebtestui$/i|| $versions{$entry}{name} =~ m/^ERGwebesbui$/i|| $versions{$entry}{name} =~ m/^ERGwspiv$/i|| $versions{$entry}{name} =~ m/^ERGwscst$/i|| $versions{$entry}{name} =~ m/^sposMUG$/i|| $versions{$entry}{name} =~ m/^ERGfinman$/i|| $versions{$entry}{name} =~ m/^ERGkm$/i|| $versions{$entry}{name} =~ m/^ERGxml$/i|| $versions{$entry}{name} =~ m/^ERGoradacw$/i|| $versions{$entry}{name} =~ m/^ERGtru$/i){$cc_path = '/MREF_Package';}if ( $versions{$entry}{name} =~ m/^tp5000_MUG$/i ){if ( $versions{$entry}{version} =~ m~vtk$~ ){$cc_path = '/MREF_Package';}}$cc_path = $opt_forceProjectBaseif ( $opt_forceProjectBase );foreach ( @opt_limitProjectBase ){if ( $cc_path =~ m~$_~ ){$cc_path = $_;last;}}if ( $cc_path_original ne $cc_path ){Message ("Package: $versions{$entry}{name}. Forcing CC path to: $cc_path" );}}#print "--- Path: $cc_path, Label: $cc_label\n";if ( $vcs_type eq 'SVN' ){$rv = extractFilesFromSubversion( $data, $entry );return $rv if ( $rv );}else{## Create CC view# Import into Subversion View#$rv = extractFilesFromClearCase( $data, $cc_path, $cc_label, $entry );return $rv if ( $rv );## May need to limit the extracted source tree# Use the first selected directory that we have#if ( @opt_selectProjectBase ){foreach ( @opt_selectProjectBase ){my $testDir = join('/', $data->{ViewRoot}, $_);if ( -d $testDir ){$selectDir = $_;$data->{ViewPath} = $testDir;last;}}unless ( $selectDir ){Warning ("No directory selected from list");}else{Message ("Selecting Dir: /$selectDir");}}}}## Delete specified files from the source tree#if ( @opt_deleteFiles ){my @args;foreach my $delFileSpec ( @opt_deleteFiles ){Message ("Deleting files that match: $delFileSpec");push @args, "--FilterIn=$delFileSpec";}my $search = JatsLocateFiles->new("--Recurse=1", @args );my @rmFiles = $search->search($data->{ViewRoot});foreach my $rmFile ( @rmFiles ){Information("Deleting: $rmFile");unlink ( join ('/', $data->{ViewRoot}, $rmFile) )|| Warning "Cannot delete: $rmFile";}}## Some packages contain softlinks - that break the file scanner#if ( $opt_deleteLinks ){# Not doing anything yet - fixed the JATS find bit}## Developers have been slack# Sometime the mark the source path as 'GMTPE2005'# Sometimes as 'GMTPE2005/Package/Fred/Jill/Harry'## Attempt to suck up empty directories below the specified# source path#unless (($opt_preserveProjectBase || $opt_forceProjectBase || @opt_limitProjectBase || $selectDir) && ! $opt_forceSuck){## Look in ViewPath# If it contains only ONE directory then we can suck it up#my $testDir = findDirWithStuff( $data->{ViewPath} );unless ( $data->{ViewPath} eq $testDir ){Message ("Adjust Base Dir: $testDir");$data->{adjustedPath} = $data->{ViewPath};$data->{ViewPath} = $testDir;$adjustedPath++;}}Message ("BaseDir: $data->{ViewPath}");## Check for bad source paths#if (detectBadMakePaths($data) ){$count_BadPaths++;unless ( $opt_ignoreBadPaths ){$data->{BadPath}++;$data->{errStr} = 'Bad Paths in Makefile';return 4; # Lets see what the others look like too# return 14;}}## Some really ugly packages make use of a Jats feature called 'SetProjectBase'# Detect such packages as we will need to handle them differently# Can't really handle it on the fly# All we can do is detect it and report it - at the moment#if (detectProjectBaseUsage($data) ){unless ( $opt_ignoreProjectBaseErrors ){$data->{BadProjectBase}++;$data->{errStr} = 'Bad usage of ProjectBase detected';Warning ("ProjectBase Error");return 4; # Lets see what the others look like too# return 14;}}## Some really really ugly packgaes make use of the MakeProject directive# and then use an 'include.txt file to access paths all over the VOB# The problem is with lines like# /I ..\..\..\..\..\..\DPG_SWCode\projects\seattle\ddu\component\DTIApp\dsi\inc# Two problems:# Vob Name is not a part of the migration# If we 'SuckUp' empty directories then this may break# the pathing.# All we can do is detect it and report it - at the moment#if (detectMakeProjectUsage($data) ){unless ( $opt_ignoreMakeProjectErrors ){$data->{BadMakeProject}++;$data->{errStr} = 'Use of MakeProject detected';return 4; # Lets see what the others look like too# return 14;}}## Some packages have filenames that are need to be converted#if ( $mustConvertFileNames ){$rv = system ( '/home/dpurdie/svn/tools/convmv-1.15/convmv','-fiso-8859-1','-tutf8','-r','--notest',$data->{ViewPath} );if ( $rv ){$data->{errStr} = 'Failed to convert filenames to UTF8';return 14;}## Check to see if our ViewPath has been changed# If so, then try to fix it#unless ( -d $data->{ViewPath} ){Message ("Correct UTF-8 change to ViewPath");$data->{ViewPath} = encode('UTF-8', $data->{ViewPath}, Encode::FB_DEFAULT);Warning ("Correct UTF-8 change to ViewPath - FAILED") unless ( -d $data->{ViewPath} );}}## Have a CC view# Now we can create the SVN package and branching point before we# import the CC data into SVN#if ( !$opt_useSvn ){$data->{errStr} = 'Subversion Import disabled' unless $data->{errStr};return 5;}my @args;## Calculate args for functions#my $author = $versions{$entry}{created_id};if ( $author ){push @args, '-author', $author;}my $created = $versions{$entry}{created};if ( $created ){$created =~ s~ ~T~;$created .= '00000Z';push @args, '-date', $created;}my $log = $versions{$entry}{comment};if ( $log ){push @args, '-log', $log;}## Create package skeleton if needed#$rv = createPackage( $author, $created);if ( $rv ){$data->{errStr} = 'Failed to create Package';return 10;}## May need to create the branchpoint# The process is delayed until its needed so avoid creating unneeded# branch points#if ( $createBranch ){$rv = createBranchPoint ($entry, $author, $created);$createBranch = 0;$createSuffix = 0;if ( $rv ){$data->{errStr} = 'Failed to create Branch Point';return 11;}}## If we are in resume mode then we MUST kill the import directory# if we have skipped anything#if ( $forceImportFlush ){$forceImportFlush = 0;RmDirTree ('SvnImportDir');}push @args, "-branch=$currentBranchName" if ( defined $currentBranchName );push @args, "-replace" if ( defined $opt_onlyOneBranch );my $datafile = "importdata.$import_label.properties";my @mergeArg;push (@mergeArg, "-mergePaths", join(',', @opt_mergePaths) ) if ( @opt_mergePaths );if ( exists $mergePathExtended{$packageNames} ){my $eentry = $mergePathExtended{$packageNames};if ( exists $eentry->{$import_label} ){@opt_mergePaths = split(':', $eentry->{$import_label});Message("New MergePath Info: @opt_mergePaths");## Args take effect next version# In this version have no merging - reset the image#@mergeArg = ();}}$rv = JatsToolPrint ( 'jats_svn', 'import', '-reuse' ,"-package=$svnRepo/$packageNames","-dir=$data->{ViewPath}","-label=$import_label","-datafile=$datafile",@args,@mergeArg,);if ( $rv ){$data->{errStr} = 'Failed to import to SVN';return 12;}## Some packages generate multiple packages# Some of these are the result of merging several packages# so we can only do this detection After the import## Detect potential build problems where multiple buildfiles# exists and cannot be resolved by our build system## This is not a show stopper (yet)#unless ( $opt_skipBuildNameCheck ){if (detectBuildFileClashes($data, 'SvnImportDir')){unless ( $opt_ignoreBuildFileClashes ){$data->{BuildFileClash}++;Message ("Build File Clash detected");}}}else{Message ('Detect Build File Clashes - skipped');}$versions{$entry}{TagCreated} = 1;$firstVersionCreated = $entry unless ( $firstVersionCreated );## Read in the Rm Reference# Retain entries in a global file#if ( -f $datafile ){my $rmData = JatsProperties::New($datafile);if ( $rmData->getProperty('subversion.tag') ){$data->{rmRef} = 'SVN::' . $rmData->getProperty('subversion.tag');}else{Warning ("Property files has no subversion.tag");}$data->{fileCount} = $rmData->getProperty('files.base', 0);$data->{filesRemoved} = $rmData->getProperty('files.removed',0);$data->{filesAdded} = $rmData->getProperty('files.added',0);}unless ( $data->{rmRef} ){$data->{errStr} = 'Failed to determine Rm Reference';return 13;}######################## Deleted ################################################## ## # Add supplemental tags if this version is in a 'Release'# # But only for some packages - else looks like a mess# # Just a solution for the ITSO guys# ## foreach my $rtag_id ( keys %{$versions{$entry}{Releases}} )# {# next unless ( $svnRepo =~ m~/ITSO_TRACS(/|$)~);## my $prog_id = $versions{$entry}{Releases}{$rtag_id}{proj_id};# Message ("Adding Release Tag:$prog_id:$rtag_id");## my $rtext = 'Release_' . saneString($versions{$entry}{Releases}{$rtag_id}{rname});# my @comment;# push @comment, "Tagged by ClearCase to Subversion import";# push @comment, "Project:$prog_id:$versions{$entry}{Releases}{$rtag_id}{pname}";# push @comment, "Release:$rtag_id:$versions{$entry}{Releases}{$rtag_id}{rname}";## $data->{ReleaseTag}{$prog_id}{$rtag_id}{name} = $rtext;## $rv = JatsToolPrint ( 'jats_svnlabel' ,# '-comment', encode('UTF-8', join("\n", @comment), Encode::FB_DEFAULT),# $data->{rmRef},# '-clone',# $rtext,## @args,# '-author=buildadm',# );# $data->{ReleaseTag}{$prog_id}{$rtag_id}{eState} = $rv;# $data->{ReleaseTag}{tCount}++;## if ( $rv )# {# $data->{ReleaseTag}{eCount}++;# Warning("Failed to add Release Tag: $rtext");# }# }######################### Deleted ###############################################Message ("RM Ref: $data->{rmRef}");unlink $datafile;## All is good#$data->{errStr} = '';return 0;}#-------------------------------------------------------------------------------# Function : newProject## Description : Start a new project within a package## Inputs :## Returns :#sub newProject{# Message ("---- New Project");$createSuffix = 0;## New project# Kill the running import directory#RmDirTree ('SvnImportDir');}#-------------------------------------------------------------------------------# Function : newPackage## Description : Start processing a new package## Inputs :## Returns :#my $createPackageDone;sub newPackage{# Message( "---- New Package");## Create a package specific log file#$logSummary = $packageNames . ".summary.log";unlink $logSummary;Message( "PackageName: $packageNames");$createPackageDone = 1;$createBranch = 0;$createSuffix = 0;## First entry being created# Prime the work area#RmDirTree ('SvnImportDir');}#-------------------------------------------------------------------------------# Function : createPackage## Description : Create a new Package in SVN# Called before any serious SVN operation to ensure that the# package has been created. Don't create a package until# we expect to put something into it.## Will only create a package once## Inputs : $author - Who done it# $date - When## Returns :#sub createPackage{my ($author, $date) = @_;my @opts;push (@opts, '-date', $date) if ( $date );push (@opts, '-author', $author) if ( $author );## Only do once#return unless ( $createPackageDone );return if ( $opt_resume );$createPackageDone = 0;if ( $opt_onlyOneBranch ){JatsToolPrint ( 'jats_svn', 'create', "$svnRepo/$packageNames", @opts );return;}## Real import# Do not Delete package if it exists# Package must NOT exist#Message ("Creating new SVN package: $packageNames");if ( $opt_delete ){Message ("Delete existing version of package: $packageNames");JatsToolPrint ( 'jats_svn', 'delete-package', '-noerror', "$svnRepo/$packageNames" );}JatsToolPrint ( 'jats_svn', 'create', "$svnRepo/$packageNames", '-new', @opts );}#-------------------------------------------------------------------------------# Function : createBranchPoint## Description : Create a branch point for the current work# Perform the calculation to determine the details of# the branch point. The work will only be done when its# needed. This will avoid the creation of branchpoints# that are not used.## Inputs : $entry - Entry being processed# $author - Who done it# $date - When## Returns :#sub createBranchPoint{my ($entry, $author, $date) = @_;my $forceNewProject;# Message ("---- Create Branch Point");## Find previous good tag# We are walking a tree so something should have been created, but# the one we want may have had an error## Walk backwards looking for one that has been created#my $last = $versions{$entry}{last};while ( $last ){unless ( $versions{$last}{TagCreated} ){$last = $versions{$last}{last};}else{last;}}## If we have walked back to the base of the tree# If we transferred any software at all, then use the first# version as the base for this disconnected version## Otherwise we create a new, and empty, view#unless ( $last ){if ( $firstVersionCreated ){Warning ("Cannot find previous version to branch. Use first version");$last = $firstVersionCreated;}else{Warning ("Forcing First instance of a Project");$forceNewProject = 1;}}## Determine source name# This MUST have been created before we can branch#my $src_label;$src_label = saneLabel($last) if $last;## Create target name#my $tgt_label;if ($versions{$entry}{isaPatch} ){my $parent = $versions{$entry}{last};my $pver = $versions{$parent}{vname};$tgt_label = 'Patching_' . $pver;}elsif ( $forceNewProject || $versions{$entry}{newSuffix} || $createSuffix || !defined $src_label ){## Create target name based on project#return if ( $singleProject );my $suffix = $versions{$entry}{suffix};if ( $suffix ){Error ("Unknown Project: $suffix") unless ( defined $Projects{$suffix} );## If this project can be considered to be a truck, then 'claim' the# truck for the first created element.#if ( $Projects{$suffix}{Trunk} ){# This project can use the trunk, if it has not been allocated.$ProjectTrunk = $suffix unless ( defined $ProjectTrunk );# Message ("ProjectTrunk allocated to: $ProjectTrunk");## If this package has multiple instances of the potential# trunk, then don't place either of them on the trunk as it# may cause confusion#if ($knownProjects{$suffix}{count} < 2 ){if ( $suffix eq $ProjectTrunk ){return unless $currentBranchName;}}}$tgt_label = $Projects{$suffix}{Name};$tgt_label = $versions{$entry}{name} . '_' . $tgt_label if ($multiPackages);if ( !exists $ProjectsBaseCreated{$tgt_label} ){$ProjectsBaseCreated{$tgt_label} = 1;}else{# Project Base Already taken# Have disjoint starting points$tgt_label .= '.' . $ProjectsBaseCreated{$tgt_label} ++;}}else{## No suffix in use## Currently not handled# May have to force the use of the trunk#Error ("INTERNAL ERROR: No suffix present");}}else{$tgt_label = saneLabel($entry, $src_label . '_for_');}## Save branch name for use when populating sandbox#$currentBranchName = $tgt_label;# Message ("Setting currentBranchName: $currentBranchName");## Perform the branch#if ( defined $src_label ){if ( $opt_resume ){my $rv = JatsToolPrint ( 'jats_svnlabel','-check','-packagebase', "$svnRepo/$packageNames",'-branch',$tgt_label );return unless ( $rv );}## The 'clone' operation will backtrack the branch point# to the source of the label. This will make the output version# tree much prettier#my @opts;push (@opts, '-date', $date) if ( $date );push (@opts, '-author', $author) if ( $author );push (@opts, '-replace') if ( $opt_onlyOneBranch );JatsToolPrint ( 'jats_svnlabel','-packagebase', "$svnRepo/$packageNames",'tags/' . $src_label,'-branch','-clone', $tgt_label,@opts);}}#-------------------------------------------------------------------------------# Function : endPackage## Description : End of package processing# Clean up and display problems## Inputs :## Returns :#sub endPackage{Message ("-- Import Summary ------------------------------------------------" );RmDirTree ('SvnImportDir');my $processedCount = 0;my $inernalErrorCount = 0;my $notProcessedCount = 0;my $badPathCount = 0;my $badProjectBaseCount = 0;my $badMakeProjectCount = 0;my $buildFileClashes = 0;## Display versions that did get captured#foreach my $entry ( @processOrder ){$versions{$entry}{Scanned} = 1;next unless ( $versions{$entry}{TagCreated} );my $eflag = $versions{$entry}{Essential} ? 'E' : ' ';Warning ("Processed:$eflag:" . GetVname($entry) . ' :: ' . $versions{$entry}{rmRef} || $versions{$entry}{errStr} || '???' );}## Display versions that did not get created#foreach my $entry ( @processOrder ){$versions{$entry}{Scanned} = 1;if ( $versions{$entry}{TagCreated} ){$processedCount++;$badPathCount++ if ($versions{$entry}{data}{BadPath} );$badProjectBaseCount++ if ($versions{$entry}{data}{BadProjectBase} );$badMakeProjectCount++ if ($versions{$entry}{data}{BadMakeProject} );$buildFileClashes++ if ($versions{$entry}{data}{BuildFileClash} );next;}my $reason = $versions{$entry}{data}{errStr} || '';my $tag = $versions{$entry}{vcsTag}|| 'No Tag';my $eflag = $versions{$entry}{Essential} ? 'E' : ' ';Warning ("Not Processed:$eflag: " . GetVname($entry) . ':' . $tag . ' : ' . $reason );$notProcessedCount++;}foreach my $entry ( keys(%versions) ){next if ( $versions{$entry}{Scanned} );Warning ("(E) INTERNAL ERROR. Package Not Processed: " . GetVname($entry) );$inernalErrorCount++;}if ( $adjustedPath || 1 ){Information ("Package Info: Files, Removed, Added, Version, ViewPath");foreach my $entry ( @processOrder ){my $viewPath = $versions{$entry}{data}{ViewPath} || '';Information (sprintf "%4s, %4s, %4s, %20s : %s",$versions{$entry}{data}{fileCount} || '-',$versions{$entry}{data}{filesRemoved} || '-',$versions{$entry}{data}{filesAdded} || '-',GetVname($entry), $viewPath);}}Message ("Packages processed: $processedCount");Warning ("Packages not processed: $notProcessedCount") if ( $notProcessedCount );Warning ("Internal Errors: $inernalErrorCount") if ( $inernalErrorCount );Warning ("Multiple source paths", @multiplePaths ) if ( scalar @multiplePaths > 1 );Message ("Packages Relabled: $packageReLabelCount") if ( $packageReLabelCount );Warning ("Packages with Bad Paths: $badPathCount") if ( $badPathCount );Warning ("Packages with Ignored Bad Paths: $badPathCount") if ( $count_BadPaths );Warning ("Packages with Bad ProjectBase: $badProjectBaseCount") if ( $badProjectBaseCount );Warning ("Packages with MakeProjects: $badMakeProjectCount") if ( $badMakeProjectCount );Warning ("Build File Clashes Found: $buildFileClashes") if ( $buildFileClashes );Warning ("Global Error Detected") if ( $globalError );Message ("---- All Done -----");}#-------------------------------------------------------------------------------# Function : extractFilesFromClearCase## Description : Extract files from ClearCase# May take a while as we handle nasty errors## Inputs : $data - Hash of good stuff from newPackageVersionBody# $cc_path# $cc_label# $entry - original PV entry## Returns : exit code# Sets up# $data->{errStr}# $data->{errCode}# As per newPackageVersionBody#sub extractFilesFromClearCase{my ($data, $cc_path, $cc_label, $entry) = @_;my $tryCount = 0;my $rv = 99;$data->{ViewRoot} = ( defined $opt_name && ! defined $opt_mergePackages )? $opt_name : "$cc_label";$data->{ViewPath} = $data->{ViewRoot} . $cc_path;if ( $opt_preserveProjectBase && !$opt_forceProjectBase ){my $cc_vob = $cc_path;$cc_vob =~ s~^/~~;$cc_vob =~ s~/.*~~;$data->{ViewPath} = $data->{ViewRoot} . '/' . $cc_vob;Message ("Preserving Project Base");}$data->{ViewPath} =~ tr~/~/~s;## Some versions are bad and have been manually marked as bad# Use touch cc2svn_ignore - to create file#if ( $opt_reuse && -f "$data->{ViewRoot}/cc2svn_ignore" ){Message ("View specifically ignored");$data->{errStr} = 'View specifically ignored';$data->{errCode} = '0';return 4; # Will Retain view}## Attempt to reuse compressed file#if ( $opt_reuse ){my $cfile = saneLabel($entry) . '.tgz';if ( -f $cfile ){Message ("Restoring compressed image");my $rv = System ('tar', '-xzf', $cfile );if ( $rv ){Warning("Failed to decompress directory");$data->{errStr} = 'Failed to de-tar compressed image';return 2;}else{my $cc_vob = $cc_path;$cc_vob =~ s~^/~~;$cc_vob =~ s~/.*~~;my $detarPath = $data->{ViewRoot} . '/' . $cc_vob;unless ( -d $detarPath ){Warning ("Logic error: Did not de-tar into expected location", $detarPath)}else{if ( -d $data->{ViewPath} ){# All is goodreturn 0;}# Recalc ViewPath to the root of the VOB$cc_path =~ s~^/~~;$cc_path =~ s~/.*~~;$cc_path = '/' . $cc_path;$data->{ViewPath} = $data->{ViewRoot} . $cc_path;return 0;}}}}if ( $opt_reuse && -d $data->{ViewPath} ){Message ("Reusing view: $cc_label");## Br applet kludge - can be removed later# Add some nice data to each view# open (FH, '>' , $data->{ViewRoot} . '/cc2svn_tag' ) || Error ("Cannot open '$data->{ViewRoot}/cc2svn_tag'");# print FH $versions{$entry}{name},' ',$versions{$entry}{vname},"\n";# close FH;return 0;}while ( ($rv == 99) && ! $opt_noVCS) {my @args;push (@args, '-view', $opt_name ) if ( defined $opt_name && ! defined $opt_mergePackages );$rv = JatsToolPrint ( 'jats_ccrelease', '-extractfiles', '-root=.' , '-noprefix',"-label=$cc_label" ,"-path=$cc_path",@args);if ( $rv == 10 ) {## No files found# If this is the first time then try really hard to find them#unless ( $tryCount++ ){if ( $opt_relabel ){$packageReLabelCount++;$rv = JatsToolPrint('cc2svn_labeldirs','-vob', $cc_path,$cc_label,);$data->{DirsLabled} = 100 + $rv;}## Second attempt - massage the users path# We should have labled up to the VOB root so lets# just use the VOB and not the path## If we are not relabeling then we can still do this# in an attempt to fix user stupidity#$cc_path =~ s~^/~~;$cc_path =~ s~/.*~~;$cc_path = '/' . $cc_path;$data->{ViewPath} = $data->{ViewRoot} . $cc_path;redo;}$data->{errStr} = 'No Files in the extracted view';$data->{errCode} = '0';return 2;}elsif ( $rv == 11 ) {$data->{errStr} = 'Label not found';$data->{errCode} = 'L';return 2;}unless ( -d $data->{ViewPath} ){$data->{errStr} = 'Failed to extract files from CC';return 2;}## Looks good#return 0;};$data->{errStr} = 'No Files in the extracted view after labeling dirs';$data->{errCode} = '0';return 2;}#-------------------------------------------------------------------------------# Function : extractFilesFromSubversion## Description : Extract files from Subversion# May take a while as we handle nasty errors## Inputs : $data - Hash of good stuff from newPackageVersionBody# $entry - All the PV information## Returns : exit code# Sets up# $data->{errStr}# $data->{errCode}# As per newPackageVersionBody#sub extractFilesFromSubversion{my ($data, $entry ) = @_;my $tryCount = 0;my $rv = 99;## Create a nice name for the import#my $import_label = saneLabel($entry);$data->{ViewRoot} = ( defined $opt_name && ! defined $opt_mergePackages )? $opt_name : $import_label;$data->{ViewPath} = $data->{ViewRoot};$data->{ViewPath} =~ tr~/~/~s;if ( $opt_reuse && -d $data->{ViewPath} ){## Br applet kludge - can be removed later# Add some nice data to each view# open (FH, '>' , $data->{ViewRoot} . '/cc2svn_tag' ) || Error ("Cannot open '$data->{ViewRoot}/cc2svn_tag'");# print FH $versions{$entry}{name},' ',$versions{$entry}{vname},"\n";# close FH;Message ("Reusing view: $import_label");return 0;}## Only allow import from SVN if asked nicely# May be used if we are correcting a package - and some have been# placed in SVN#unless ( $opt_extractFromSvn || $opt_onlyOneBranch ){$data->{errStr} = 'Some Packages are in SVN';return 15;}#print "--- ViewRoot: $data->{ViewPath}\n";$rv = JatsToolPrint ( 'jats_svnrelease','-extractfiles','-root=.' ,'-noprefix','-DevMode=escrow','-label', $data->{tag},'-view', $data->{ViewPath},);if ( $rv == 10 ) {$data->{errStr} = 'No Files in the extracted view';$data->{errCode} = '0';return 2;} elsif ( $rv == 11 ) {$data->{errStr} = 'Label not found';$data->{errCode} = 'L';return 2;} elsif ( $rv ) {$data->{errStr} = 'Subversion reported error';return 2;}unless ( -d $data->{ViewPath} ){$data->{errStr} = 'Failed to extract files from Subversion';return 2;}## Looks good#return 0;}#-------------------------------------------------------------------------------# Function : extractFilesFromStore## Description : Extract files from Store# Local directory under dpkgExtract## Inputs : $data - Hash of good stuff from newPackageVersionBody# $entry - All the PV information## Returns : exit code# 1 - Files found# 0 - Not found#sub extractFilesFromStore{my ($data, $entry ) = @_;## Create a nice name for the import#my $import_label = saneLabel($entry);$data->{ViewRoot} = ( defined $opt_name && ! defined $opt_mergePackages )? $opt_name : $import_label;$data->{ViewPath} = 'dpkgExtract/' . $data->{ViewRoot};$data->{ViewPath} =~ tr~/~/~s;if ( -d $data->{ViewPath} ){$data->{fromStore} = 1;Message ("Reusing Stored view: $import_label");return 1;}## Not found in store#delete $data->{ViewRoot};delete $data->{ViewPath};return 0;}#-------------------------------------------------------------------------------# Function : testDpkgArchive## Description : Indicate if the package exists in dpkg_archive## Inputs :## Returns :#sub testDpkgArchive{my ($entry) = @_;my $vname = $versions{$entry}{vname};if ( -d join('/', $ENV{GBE_DPKG}, $packageNames, $vname )) {Message ("Version found in dpkg_archive");} else {Message ("Version NOT found in dpkg_archive");}}#-------------------------------------------------------------------------------# Function : markDpkgArchive## Description : Indicate if the package exists in dpkg_archive## Inputs :## Returns :#sub markDpkgArchive{my ($entry) = @_;my $vname = $versions{$entry}{vname};my $path = join('/', $ENV{GBE_DPKG}, $packageNames, $vname );delete $versions{$entry}{dpkgArchive};if ( -d $path ) {$versions{$entry}{dpkgArchive} = $path;}}#-------------------------------------------------------------------------------# Function : detectMakeProjectUsage## Description : etect and report usage of the MakeProject directive## Inputs : $data - Ref to a hash of bits## Returns : true - Bad usage (Really good usage not detected)# false - Good usage detected#sub detectMakeProjectUsage{my ($data) = @_;my $retval = 0;my $eSuf = $opt_ignoreMakeProjectErrors ? '' : 'Error';## Find makefile.pl#Message ("Detect MakeProject Usage");my $usesMakeProject = 0;my $badIncludeFile = 0;my $search = JatsLocateFiles->new("--Recurse=1","--FilterIn=makefile.pl",);my @makefiles = $search->search($data->{ViewRoot});foreach my $file ( @makefiles ){#print "---Reading: $workDir/$data->{ViewRoot}/$file\n";if ( open( my $fh, '<', "$data->{ViewRoot}/$file" ) ){my $eof = 0;my $line = '';until ( $eof ){my $in = <$fh>;unless ( defined $in ){$eof = 1;}else{$in =~ s~\s+$~~;$in =~ s~^\s+~~;$in =~ s~^#.*$~~;$in =~ s~\s*[^\$]#.*$~~;$line .= ' ' if ( $line );$line .= $in;$line =~ s~\s+~ ~g;#print "====== '$line'\n";redo unless ( $line =~ m~;$~ );}#print "---- $line\n";if ( $line =~ m~^MakeProject~ ){$usesMakeProject++;$data->{UsesMakeProject}++;Warning ("Package uses MakeProject:","Line: " . $line,"Root: " . "$data->{ViewRoot}","File: " . "$data->{ViewRoot}/$file",);## Extract out the project name#my @myArgs;my $myProjectDir;my $myProject = "$data->{ViewRoot}/$file";$myProject =~ s~/[^/]+$~~;unless ($line =~ m~\s*(\w+)\s*\((.*)\)\s*;\s*$~ ){Error("Could not detect arguments: $line");}my $args = $2;$args =~ tr~'" ~ ~s;@myArgs = split (/\s*,\s*/, $args);shift @myArgs;foreach ( @myArgs ){next if ( m~^--~ );$myProject .= '/' . $_;$myProjectDir = $myProject;$myProjectDir =~ s~/[^/]+$~~;last;}Error ("No project Found") unless ( defined $myProjectDir);## Look for 'include.txt' that may be bwteen the makefile and the project#if ( -f "$myProjectDir/include.txt" ){Warning ("Co-located 'include.txt' file also found");}# The only problem is if the include.txt file# escapes from the VOB - or even uses the vob root## Examine the include file# Expect it to look like# /I Path### Determine safe level# Relative to the include file#my $depthPath = $myProjectDir;my $depth = 0;Error ("Expect this to work") unless ( $depthPath =~ s~^$data->{ViewRoot}/~~ );foreach ( split('/', $depthPath) ){if ( $_ eq '..' ) {$depth--;} else {$depth++;}}#print "Depth: $depth, $depthPath\n";if ( open( my $if, '<', "$myProjectDir/include.txt" ) ){while ( <$if> ){s~\s+$~~;s~^\s+~~;next unless ( $_ );if ( m~/I\s+(.*)~ ){my $path = $1;$path =~ tr~\\/~/~s;$path =~ s~\\~/~g;#print "Examine: $path\n";my $minLevel = 0;my $level = 0;foreach ( split('/', $path) ){if ( $_ eq '..' ){$level--;$minLevel = $level if ($level < $minLevel);}else{$level++;}}#print "Min: $minLevel, $level, ($depth + $minLevel)\n";if ( $depth + $minLevel <= 0){$badIncludeFile++;Warning ("Included path escapes package:","Line: " . $_,"File: " . "$myProjectDir/include.txt",);last;}}}close $if;}}$line = '';}close $fh;}else{Warning ("MakeProject$eSuf - Cannot open makefile: $file");$retval = 1;}}## Used# May be improved latter#if ( $usesMakeProject && $badIncludeFile){Warning ("MakeProject$eSuf - Problem detected");$retval = 1;}## Until we have more faith in the detection algorithm#if ( $usesMakeProject ){Warning ("MakeProject$eSuf - Makeproject used. Must check manually");$retval = 1;}return $retval;}#-------------------------------------------------------------------------------# Function : detectBadMakePaths## Description : Detect and report bad usage of some directives## Inputs : $data - Ref to a hash of bits## Returns : true - Bad usage (Really good usage not detected)# false - Good usage detected#sub detectBadMakePaths{my ($data) = @_;my $retval = 0;my $eSuf = $opt_ignoreBadPaths ? '' : 'Error';## Find makefile.pl#Message ("Detect Bad Source Paths");my $badPath = 0;my $search = JatsLocateFiles->new("--Recurse=1","--FilterIn=makefile.pl",);my @makefiles = $search->search($data->{ViewPath});foreach my $file ( @makefiles ){$file =~ tr~/~/~s;my $max_up = ($file =~ tr~/~/~);my $shownPath;#print "---Reading: $workDir/$data->{ViewPath}/$file\n";if ( open( my $fh, '<', "$data->{ViewPath}/$file" ) ){my $eof = 0;my $line = '';until ( $eof ){my $in = <$fh>;unless ( defined $in ){$eof = 1;}else{$in =~ s~\s+$~~;$in =~ s~^\s+~~;$in =~ s~^#.*$~~;$in =~ s~\s*[^\$]#.*$~~;$line .= ' ' if ( $line );$line .= $in;$line =~ s~\s+~ ~g;#print "====== '$line'\n";redo unless ( $line =~ m~;$~ );}if ( $line =~ m~^AddDir~ || $line =~ m~^AddSrcDir~ || $line =~ m~^AddIncDir~ || $line =~ m~^Src~ ){## Extract out the arguments#my @myArgs;my $myProjectDir;my $myProject = "$data->{ViewRoot}/$file";$myProject =~ s~/[^/]+$~~;unless ($line =~ m~\s*(\w+)\s*\((.*)\)\s*;\s*$~ ){Error("Could not detect arguments: $line");}my $args = $2;$args =~ tr~'" ~ ~s;@myArgs = split (/\s*,\s*/, $args);shift @myArgs;foreach ( @myArgs ){next if ( m~^--~ );next unless ( m~^\.\./~ );my $tmp = $_;$tmp =~ s~Z~z~g;$tmp =~ s~\.\./~Z~g;my $upCount = ( $tmp =~ tr~Z~Z~ );if ( $upCount > $max_up ){Warning ("Makefile Path: $file ") unless $shownPath;Warning ("Path escapes view: $max_up, $upCount, $_");$badPath++;$shownPath = 1;}#print "---x Path : $max_up, $upCount, $_\n";}}$line = '';}close $fh;}else{Warning ("detectBadMakePaths$eSuf - Cannot open makefile: $file");$retval = 1;}}## Used# May be improved latter#if ( $badPath ){Warning ("detectBadMakePaths$eSuf - Bad Path seen. Must check manually");$retval = 1;}return $retval;}#-------------------------------------------------------------------------------# Function : detectProjectBaseUsage## Description : Detect and report usage of the SetProjectBase directive## Inputs : $data - Ref to a hash of bits## Returns : true - Bad usage (Really good usage not detected)# false - Good usage detected#sub detectProjectBaseUsage{my ($data) = @_;my $retval = 0;my $eSuf = $opt_ignoreProjectBaseErrors ? '' : 'Error';## Find makefile.pl#Message ("Detect ProjectBase Usage");my $usesProjectBase = 0;my $definesProjectBase = 0;my $definitionError = 0;my $search = JatsLocateFiles->new("--Recurse=1","--FilterIn=makefile.pl",);my @makefiles = $search->search($data->{ViewPath});foreach my $file ( @makefiles ){if ( open( my $fh, '<', "$data->{ViewPath}/$file" ) ){while ( <$fh> ){s~\s+$~~;s~^\s+~~;next if ( m~^#~ );if ( m~\$ProjectBase~ ){$usesProjectBase++;Message ("Project Base Use: $_");$data->{UsesProjectBase}++;}if ( m~^SetProjectBase~ ){$definesProjectBase++;$data->{DefinesProjectBase}++;Warning ("Package initialises SetProjectBase:","Line : " . $_,"Root : " . "$data->{ViewRoot}","Path : " . "$data->{ViewPath}","File : " . "$data->{ViewPath}/$file",);# The only problem is if the user attempts to escape# from the root of the view.## Examine the depth of the makefile with the directive# Examine the depth of the view base### Locate the build.pl file# This is the basis for for the directive#my $blevel;my @bpaths = split ('/', $file );my $buildFile;while ( @bpaths ){$bpaths[-1] = 'build.pl';my $bfile = join '/', @bpaths ;$buildFile = "$data->{ViewPath}/$bfile";if ( -f $buildFile ){$blevel = scalar @bpaths;last;}pop @bpaths;}unless (defined $blevel){Warning ("SetProjectBase$eSuf calculation failed - can't find build.pl");# $retval = 1;$definitionError++;}else{Warning ("Build: $buildFile");## Whats the file for#if (open (BF, '<', $buildFile )){while ( <BF> ){s~\s+$~~;if ( m~\s*BuildName~ ){Warning ("BuildName: $_");last;}}close BF;}## Determine the depth of the view root#my $countPath = ($data->{ViewPath} =~ tr~/~/~);my $countBuild = ($buildFile =~ tr~/~/~);my $max_up = $countBuild - $countPath -1;m~--Up=(\d+)~i;my $ulevel = $1;if ( defined $ulevel ){my @paths = split ('/', $file );my $plevel = scalar @paths;#print "--- blevel: $blevel\n";#print "--- bpaths: @bpaths\n";#print "--- ulevel: $ulevel\n";#print "--- paths: @paths\n";#print "--- plevel: $plevel\n";#print "--- max_up: $max_up\n";if ( $ulevel > $max_up ){Warning ("SetProjectBase escapes view. MaxUp: $max_up, Up: $ulevel");$definitionError++;}}else{$retval = 1;Warning ("SetProjectBase$eSuf MAY escape view - can't detect level")}}}}close $fh;}else{Warning ("SetProjectBase$eSuf - Cannot open makefile: $file");$retval = 1;}}## Detect defined, but not used#if ( $usesProjectBase && ! $definesProjectBase ){Warning ("SetProjectBase - Uses Default ProjectBase");}if ( ! $usesProjectBase && $definesProjectBase ){Warning ("SetProjectBase - Defines ProjectBase without using it");}if ( $usesProjectBase && $definesProjectBase && $definitionError ){Warning ("SetProjectBase$eSuf - Problem detected");$retval = 1;}return $retval;}#-------------------------------------------------------------------------------# Function : detectBuildFileClashes## Description : Scan a directory for multiple buildfiles and conflicts# Only works for Jats build.pl files - at the moment## Inputs : $data - PackageVersion Data# $rootDir - Directory to scan## Returns : 0 - All is well# !0 - Multiple build files found#sub detectBuildFileClashes{my ($pvdata, $rootDir) = @_;my %data;my $rv = 0;Message ('Detect Build File Clashes');my $bscanner = BuildFileScanner ( $rootDir, 'build.pl' );my $count = $bscanner->locate();## None found - OK ( but not good )#return $rv unless ( $count );## Process all the build files in the tree#$bscanner->scan();my @buildfiles = $bscanner->getMatchList();# DebugDumpData('$bscanner', $bscanner );# DebugDumpData('@buildfiles', \@buildfiles );# exit 99;foreach my $bf ( @buildfiles ){my $bdir = $bf->{dir};my $bname = $bf->{name};my $bversion = $bf->{version};next unless ( defined($bname) );Information ("BuildFiles: $bname, $bversion : $bdir");if ( exists ($data{$bname}{count}) && ($data{$bname}{count} >= 1) ){Warning ("MultipleBuildFiles for $bname ($bversion)");$rv = 1;}$data{$bname}{count}++;push @{$data{$bname}{versions}}, $bversion;}return $rv;}#-------------------------------------------------------------------------------# Function : findDirWithStuff## Description : Find a directory that contains more than just another subdir# Note: don't use 'glob' it doesn't work if the name has a space in it.## Inputs : $base - Start of the scan## Returns : Path to dir with more than just a single dir in it#sub findDirWithStuff{my ($base) = @_;while ( $base ){my $fileCount = 0;my $dirCount = 0;my $firstDir;opendir (my $dh, $base ) || Error ("Cannot opendir $base. $!");my @list =readdir $dh;closedir $dh;foreach ( @list ){next if ( $_ eq '.' );next if ( $_ eq '..' );$_ = $base . '/' . $_;if ( -d $_ ){$dirCount++;$firstDir = $_ unless ( defined $firstDir );return $baseif ( $dirCount > 1 )}elsif ( -e $_ ){return $base;}# else its probably a dead symlink}return $baseunless ( $dirCount == 1 );$base = $firstDir;}}#-------------------------------------------------------------------------------# Function : JatsToolPrint## Description : Print and Execuate a JatsTool command## Inputs :## Returns :#sub JatsToolPrint{Information ("Command: @_");JatsTool @_;}sub GetVname{my ($entry) = @_;my $me = 'NONE';if ( $entry ){$me = $versions{$entry}{vname};unless ( $me ){$me = 'Unknown-' . $entry;}}return $me;}#-------------------------------------------------------------------------------# Function : saneLabel## Description : Generate a sane version label# Handle duplicates (due to character squishing)# Cache results for repeatability## Inputs : $entry - Version info# $pkgname - Alternate pkgname (branching)## Returns : Sane string#sub saneLabel{my ($entry, $pkgname) = @_;my $me;$me = $versions{$entry}{vname};$pkgname = $versions{$entry}{name} unless ( defined $pkgname );## If we have calculated it, then reuse it.#if ( exists $versions{$entry}{saneLabel}{$pkgname} ){return $versions{$entry}{saneLabel}{$pkgname};}Error ("Package does have a version string: pvid: $entry")unless ( defined $me );## Convert Wip format (xxxx) into a string that can be used for a label#if ( $me =~ m~^(.*)\((.*)\)(.*)$~ ){$me = $1 . '_' . $2 . '_' . $3 . '.WIP';$me =~ s~_\.~.~;$me =~ s~^_~~;}## Allow for WIPS# Get rid of multiple '_'# Replace space with -#$me = $pkgname . '_' . $me;$me =~ tr~ ~-~s;$me =~ tr~-~-~s;$me =~ tr~_~_~s;## Due to some sillyness ( package version starting with _ )# we may get duplicates. Detect and allocate different numbers#if ( exists $saneLabels{$me} ){$saneLabels{$me}++;$me = $me . '.' . $saneLabels{$me};Message ("Duplicate SaneLabel resolved as: $me");}else{$saneLabels{$me} = 0;}## Cache value#$versions{$entry}{saneLabel}{$pkgname} = $me;return $me;}sub saneString{my ($string) = @_;## Get rid of multiple '_'# Replace space with -#$string =~ s~\W~_~g;$string =~ tr~ ~_~s;$string =~ tr~_-~-~s;$string =~ tr~-_~-~s;$string =~ tr~-~-~s;$string =~ tr~_~_~s;$string =~ s~-$~~;$string =~ s~_$~~;return $string;}exit 0;#-------------------------------------------------------------------------------# Function : GetPkgIdByName## Description :## Inputs : pkg_name## Returns : pkg_id#sub GetPkgIdByName{my ( $pkg_name ) = @_;my (@row);my $pv_id;my $pkg_id;## Establish a connection to Release Manager#connectRM(\$RM_DB) unless ( $RM_DB );## Extract data from Release Manager#my $m_sqlstr = "SELECT pkg.PKG_NAME, pkg.PKG_ID" ." FROM RELEASE_MANAGER.PACKAGES pkg" ." WHERE pkg.PKG_NAME = \'$pkg_name\'";my $sth = $RM_DB->prepare($m_sqlstr);if ( defined($sth) ){if ( $sth->execute( ) ){if ( $sth->rows ){while ( @row = $sth->fetchrow_array ){Verbose( "DATA: " . join(',', @row) );$pkg_id = $row[1] || 0;last;}}else{Error ("GetPkgIdByName:No Data for package: $pkg_name");}$sth->finish();}}else{Error("GetPkgIdByName:Prepare failure" );}return $pkg_id;}#-------------------------------------------------------------------------------# Function : GetData_by_pkg_id## Description :## Inputs : pv_id## Returns :#sub GetData_by_pkg_id{my ( $pkg_id, $packageName ) = @_;my (@row);## Establish a connection to Release Manager#Message ("Extract package versions from Release Manager: $packageName");connectRM(\$RM_DB) unless ( $RM_DB );## Extract data from Release Manager#my $m_sqlstr = "SELECT " ."pkg.PKG_NAME, " . # row[0]"pv.PKG_VERSION, " . # row[1]"pkg.PKG_ID, " . # row[2]"pv.PV_ID, " . # row[3]"pv.LAST_PV_ID, " . # row[4]"pv.MODIFIED_STAMP, " . # row[5]"release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), " . # row[6]"amu.USER_NAME, " . # row[7]"pv.COMMENTS, " . # row[8]"pv.DLOCKED, " . # row[9]"pv.CREATOR_ID, ". # row[10]"pv.BUILD_TYPE ". # row[11]" FROM " ."RELEASE_MANAGER.PACKAGES pkg, " ."RELEASE_MANAGER.PACKAGE_VERSIONS pv, " ."ACCESS_MANAGER.USERS amu" ." WHERE " ."pv.PKG_ID = \'$pkg_id\' " ."AND pkg.PKG_ID = pv.PKG_ID " ."AND amu.USER_ID (+) = pv.CREATOR_ID";my $sth = $RM_DB->prepare($m_sqlstr);if ( defined($sth) ){if ( $sth->execute( ) ){if ( $sth->rows ){while ( @row = $sth->fetchrow_array ){Verbose( "DATA: " . join(',', @row) );my $pkg_name = $row[0] || 'Unknown';my $pkg_ver = $row[1] || 'Unknown';$pkg_ver =~ s~\s+$~~;$pkg_ver =~ s~^\s+~~;my $pv_id = $row[3] || 'Unknown';my $last_pv_id = $row[4];my $created = $row[5] || 'Unknown';my $vcstag = $row[6] || 'Unknown';my $created_id = $row[7] || ($row[10] ? "Userid_$row[10]" :'Unknown');my $comment = $row[8] || '';my $locked = $row[9] || 'N';my $manual = $row[11] || 'M';## Some developers have a 'special' package version# We really need to ignore them#next if ( $pkg_ver eq '23.23.23.ssw' );## Add data to the hash#$versions{$pv_id}{name} = $pkg_name;$versions{$pv_id}{pvid} = $pv_id;$versions{$pv_id}{vname} = $pkg_ver;$versions{$pv_id}{vcsTag} = $vcstag;$versions{$pv_id}{created} = $created;$versions{$pv_id}{created_id} = $created_id;$versions{$pv_id}{comment} = $comment;$versions{$pv_id}{locked} = $locked;$versions{$pv_id}{TimeStamp} = str2time( $created );$versions{$pv_id}{Age} = ($now - $versions{$pv_id}{TimeStamp}) / (60 * 60 * 24);$versions{$pv_id}{TooOld} = 1 if ( $opt_age && $opt_age <= $versions{$pv_id}{Age} );$versions{$pv_id}{BuildType} = $manual;examineVcsTag($pv_id);## Process version number#my ($suffix, $version, $isaR, $isaWip, $buildVersion, $isaPatch ) = massageVersion($pkg_ver, $pkg_name);$versions{$pv_id}{version} = $version;$versions{$pv_id}{buildVersion} = $buildVersion;$versions{$pv_id}{isaWip} = 1 if ( $isaWip );$versions{$pv_id}{isaPatch} = 1 if ( $isaPatch );# Remove entries that address themselvespush (@{$versions{$last_pv_id}{next}}, $pv_id) unless ($pv_id == $last_pv_id || $last_pv_id == 0 || $isaPatch) ;## New method for detecting a ripple# Don't look at the version number# Use RM data# Inlude the comment - there are some cases where the comment# appears to have been user modified.## $versions{$pv_id}{isaRipple} = 1 if ( $isaR );# $versions{$pv_id}{isaRipple} = 1 if ( uc($manual) eq 'Y' );$versions{$pv_id}{isaRipple} = ( $comment =~ m~^Rippled Build~i && ( uc($manual) eq 'Y' ));## Process suffix#$suffix = 'Unknown' unless ( $suffix );$suffix = lc ($suffix);$versions{$pv_id}{suffix} = $suffix;push @{$suffixes{$suffix}}, $pv_id;# print "$pkg_name, $pkg_ver, $pv_id, $last_pv_id, $locked, $created, $created_id, $suffix\n";}}else{Error ("GetData_by_pkg_id: No Data: $m_sqlstr");}$sth->finish();}else{Error ("GetData_by_pkg_id: Execute: $m_sqlstr");}}else{Error("GetData_by_pkg_id:Prepare failure" );}}#-------------------------------------------------------------------------------# Function : massageVersion## Description : Process a version number and return usful bits## Inputs : Version Number# Package Name - debug only## Returns : An array# suffix# multipart version string useful for text comparisons#sub massageVersion{my ($version, $name) = @_;my ($major, $minor, $patch, $build, $suffix);my $result;my $buildVersion;my $isaRipple;my $isaWIP;my $isaPatch;$build = 0;#print "--- $name, $version\n";$version =~ s~^_~~;$version =~ s~^${name}_~~;## xxxxxxxxx.nnnn.cots#if ( $version =~ m~(.*)\.cots$~ ) {my $cots_base = $1;$suffix = '.cots';if ( $version =~ m~(.*?)\.([0-9]{4,5})\.cots$~ ){$result = $1 . sprintf (".%4.4d", $2) . $suffix;}else{$result = $cots_base . '.0000.cots';}if ( $result =~ m~(.*)\.(\d+)(\d\d\d)\.cots$~ ){$buildVersion = [$1, 0 , $2, $3 ];}}## Convert version into full form for comparisions# nnn.nnn.nnn.[p]nnn.xxx# nnn.nnn.nnn.[p]nnn-xxx# nnn.nnn.nnn-[p]nnn.xxx# nnn.nnn.nnn-[p]nnn-xxx# nnn.nnn.nnn[p]nnn-xxx# Don't flag as ripples - they are patches#elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-.p][p]?(\d+)([-.](.*))?$~ ) {$major = $1;$minor = $2;$patch = $3;$build = $4;$suffix = defined $6 ? ".$6" : '';$isaRipple = 0;$isaPatch = 1;}## nn.nnn.nnnnn.xxx# nn.nnn.nnnnn-xxx# nnn.nnn.nnnx.xxx# Don't flag as ripples - they are patches#elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)\w?([-.](.*))?$~ ) {$major = $1;$minor = $2;$patch = $3;if ( length( $patch) >= 4 ){$build = substr( $patch, -3 ,3);$patch = substr( $patch, 0 ,length($patch)-3);}$suffix = defined $5 ? ".$5" : '';}## nnn.nnn.nnn# nnn.nnn-nnn# nnn.nnn_nnn#elsif ( $version =~ m~^(\d+)\.(\d+)[-._](\d+)$~ ) {$major = $1;$minor = $2;$patch = $3;$suffix = '';}## nnn.nnn.nnn.nnn# nnn.nnn.nnn-nnn# nnn.nnn.nnn_nnn#elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-._](\d+)$~ ) {$major = $1;$minor = $2;$patch = $3;$build = $4;$suffix = '';$isaRipple = 0;}## nnn.nnn#elsif ( $version =~ m~^(\d+)\.(\d+)$~ ) {$major = $1;$minor = $2;$patch = 0;$suffix = '';}## nnn.nnn.xxx#elsif ( $version =~ m~^(\d+)\.(\d+)(\.\w+)$~ ) {$major = $1;$minor = $2;$patch = 0;$suffix = $3;}## nnn.nnn.c.xxx#elsif ( $version =~ m~^(\d+)\.(\d+)\.(\w)(\.\w+)$~ ) {$major = $1;$minor = $2;$patch = ord($3);$suffix = $4;}## nnn.nnn.nnnz#elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)([a-z])$~ ) {$major = $1;$minor = $2;$patch = $3;$build = ord($4) - ord('a');$suffix = '.cots';$isaRipple = 0;}## ???REV=???#elsif ( $version =~ m~REV=~ ) {$suffix = '.cots';$result = $version . '.000000.cots';}## Wip Packages# (nnnnnn).xxx# Should be essential, but want to sort very low#elsif ($version =~ m~\((.*)\)(\..*)?~) {$suffix = $2 || '';$result = "000.000.000.00000$suffix";$isaWIP = 1;}## !current#elsif ($version eq '!current' || $version eq 'current_$USER' || $version eq 'current' || $version eq 'beta' || $version eq 'latest' || $version eq 'beta.cr' || $version eq 'CREATE') {$suffix = '';$result = "000.000.000.00000$suffix";$isaWIP = 1;}## Also WIP: FINRUN.103649.BEI.WIPelsif ($version =~ m~(\.[a-zA-Z]+)\.WIP$~) {$suffix = lc($1);$result = "000.000.000.00000$suffix";$isaWIP = 1;}## Also ERGOFSSLS190100_015# Don't flag as a rippleelsif ($version =~ m~^ERG[A-Z]+(\d\d)(\d\d)(\d\d)[-_](\d+)(\.\w+)?$~) {$major = $1;$minor = $2;$patch = $3;$build = $4;$suffix = $5 || '.sls';$isaRipple = 0;}## nnnn#elsif ($version =~ m~[0-9]{4}~) {$suffix = '';$major = 0;$minor = 0;$patch = $version;$build = 0;}## Stuff we don't yet handle#else {Warning ("Unknown version number: $name,$version");$version =~ m~(\.\w+)$~;$suffix = $1 || '';$result = $version;}$isaRipple = ($build > 0) unless defined $isaRipple;unless ( $result ){# Major and minor of 99.99 are normally funy versions# Don't make important desicions on them#if ( $major == 99 && $minor == 99 ){$major = 0;$minor = 0;$patch = 0;}$result = sprintf("%3.3d.%3.3d.%3.3d.%5.5d%s", $major,$minor,$patch,$build,$suffix || '.0000');$buildVersion = [ $major, $minor, $patch, $build ];}$suffix = lc( $suffix );if ( exists $suffixFixup{$suffix} ){$suffix = $suffixFixup{$suffix} ;}return ($suffix, $result, $isaRipple, $isaWIP, $buildVersion, $isaPatch );}#-------------------------------------------------------------------------------# Function : vcsCleanup## Description : Cleanup and rewrite a vcstag## DUPLICATED IN:# - cc2svn_procdata# - cc2svn_importpackage## Inputs : vcstag## Returns : Cleaned up vcs tag#sub vcsCleanup{my ($tag) = @_;$tag =~ tr~\\/~/~; # Force use of /$tag =~ s~/+$~~; # Trailing /if ( $tag =~ m~^CC::~ ){$tag =~ s~CC::/VOB:/~CC::/~; # Kill stuff$tag =~ s~CC::load\s+~CC::~; # Load rule$tag =~ s~CC::\s+~CC::~; # Leading white space$tag =~ s~CC::[A-Za-z]\:/~CC::/~; # Leading driver letter$tag =~ s~CC::/+~CC::/~; # Multiple initial /'s$tag =~ s~/build.pl::~::~i;$tag =~ s~/src::~::~i;$tag =~ s~MASS_Dev_Bus/Cbp/~MASS_Dev_Bus/CBP/~i;$tag =~ s~MASS_Dev_Bus~MASS_Dev_Bus~i;$tag =~ s~/MASS_Dev/Infra~MASS_Dev_Infra~i;$tag =~ s~/MASS_Dev/Bus/web~/MASS_Dev_Bus/web~i;$tag =~ s~/Vastraffik/~/Vasttrafik/~;$tag =~ s~/MREF_Package/ergpostmongui$~/MREF_Package/ergpostmongui~i;$tag =~ s~DPC_SWCode/~DPG_SWCode/~i;}return $tag;}#-------------------------------------------------------------------------------# Function : examineVcsTag## Description : Examine a VCS Tag and determine if it looks like rubbish# Give it a clean## Inputs : $entry## Returns : Will add Data to the $entry#sub examineVcsTag{my ($entry) = @_;my $bad = 0;$versions{$entry}{vcsTag} = vcsCleanup($versions{$entry}{vcsTag});my $vcstag = $versions{$entry}{vcsTag};if ( $vcstag =~ m~^SVN::~ ) {$versions{$entry}{isSvn} = 1;} elsif ( $vcstag =~ m~^CC::(.*?)(::(.+))?$~ ) {my $path = $1 || '';my $label = $2 || '';$bad = 1 unless ( $label );$bad = 1 if ( $label =~ m~^N/A$~i || $label =~ m~^na$~i );$bad = 1 unless ( $path );$bad = 1 if ( $path =~ m~^N/A$~i || $path =~ m~^na$~i );$bad = 1 if ( $path =~ m~^/dpkg_archive~ || $path =~ m~^dpkg_archive~ );$bad = 1 if ( $path =~ m~^/devl/~ || $path =~ m~^devl/~ );$bad = 1 if ( $path =~ m~^CVS~ );$bad = 1 if ( $path =~ m~^http:~i );$bad = 1 if ( $path =~ m~^[A-Za-z]\:~ );$bad = 1 if ( $path =~ m~^//~ );$bad = 1 if ( $path =~ m~^/blade1/~ );$bad = 1 if ( $path =~ m~^/devl/~ );$bad = 1 if ( $path =~ m~^/*none~i );$bad = 1 if ( $path =~ m~^/*NoWhere~i );$bad = 1 if ( $path =~ m~^-$~i );$bad = 1 if ( $path =~ m~^cvsserver:~ );$bad = 1 if ( $path =~ m~,\s*module:~ );$bad = 1 if ( $path =~ m~[()]~ );# $bad = 1 unless ( $path =~ m~^/~ );}else{$bad = 1;}$versions{$entry}{badVcsTag} = 1 if ( $bad );}#-------------------------------------------------------------------------------# Function : logToFile## Description : Log some data to a named file# Use file locking to allow multiple process to log## Inputs : $filename - Name of file to log# ... - Data to log## Returns : Nothing#sub logToFile{my ($file, @data) = @_;open (LOGFILE, '>>', $file);flock (LOGFILE, LOCK_EX);print LOGFILE "@data\n";flock (LOGFILE, LOCK_UN);close (LOGFILE);}#-------------------------------------------------------------------------------# Function : createImages## Description : Create nice images of the RM version tree## Inputs :## Returns :#sub createImages{my $filebase = "${packageNames}";my $openOk;foreach my $ii ( 0 .. 5 ){if (open (FH, '>', $cwd . "/$filebase.dot" )){$openOk = 1;last;}sleep (2);}unless ( $openOk ){Warning ("Cannot open image output: $filebase.dot");return;}print FH "digraph \"${packageNames}\" {\n";#print FH "rankdir=LR;\n";print FH "node[fontsize=16];\n";print FH "node[target=_graphviz];\n";# print FH "subgraph cluster_A {\n";# print FH "node[fontsize=12];\n";{my @text;push @text, $packageNames;push @text, 'HyperLinked to Release Manager';push @text, 'Created:' . localtime();push @text, '|';push @text, 'Total RM versions: ' . $totalVersions;push @text, 'Essential Entries: ' . scalar @EssentialPackages;push @text, 'Initial trees: ' . $initialTrees;push @text, 'Number of Entries: ' . $processTotal;push @text, 'Type : ' . $packageType;push @text, 'All versions in Subversion' if ( $allSvn );push @text, '|';push @text, 'Total Project Branches: ' . $ProjectCount;foreach ( sort keys %knownProjects ){my $count = $knownProjects{$_}{count} || 0;if ( $count ){my $text = 'Project Branch: ' . $_;$text .= " (" . $count . ")" if ( $count > 1 );push @text, $text;}}push @text, '|';push @text, 'Bad VCS : ' . $badVcsCount;push @text, 'Bad Singletions : ' . $badSingletonCount;push @text, 'Deadwood entries : ' . $trimCount;push @text, 'Walking Mode : Flat' if ($opt_flat);push @text, 'Pruned Mode : ' . $pruneModeString;push @text, 'Pruned entries : ' . $pruneCount;push @text, 'Recent entries : ' . $recentCount;if ( @unknownProjects ){push @text, '|';push @text, 'Unknown Projects';push @text, 'Unknown Project: ' . $_ foreach (sort @unknownProjects );}## Multiple Paths#if ( scalar @multiplePaths > 1 ){push @text, '|';push @text, 'Multiple Paths';if ( $opt_AllowMuliplePaths ){push @text, 'Multiple Paths allowed:' . scalar @multiplePaths . ' found';}else{push @text, @multiplePaths;}}## Bad essentials#if ( @badEssentials ){push @text, '|';push @text, 'Bad Essential Versions';push @text, GetVname($_) foreach ( @badEssentials );}## Subversion Data#if ( %svnData ){push @text, '|';push @text, 'Subversion';push @text, 'Trunk used' if exists $svnData{branches}{trunk} ;push @text, 'Labels: ' . scalar keys %{$svnData{tags}} ;push @text, 'Branches: ' . scalar keys %{$svnData{branches}} ;push @text, 'Relabled Packages : ' . $packageReLabelCount;}push @text, '';my $text = join '\l', @text;$text =~ s~\|\\l~|~g;my @attributes;push @attributes, "shape=record";push @attributes, "label=\"{$text}\"";push @attributes, "tooltip=\"$packageNames\"";push (@attributes, "URL=\"" . $GBE_RM_URL . "/view_by_version.asp?pkg_id=$first_pkg_id" . "\"" )if $first_pkg_id;push @attributes, "color=red";my $attr = join( ' ', @attributes);my $tld_done = 'TitleBlock';print FH "$tld_done [$attr]\n";}## Generate Legend#{my @text;push @text, 'Legend';push @text, '|';push @text, 'Node Content';push @text, 'Package Version';# push @text, 'Release Manager Ref (pvid)';push @text, 'Creation Date: yyyy-mm-dd';push @text, '(Coded information)';push @text, '|{Code';push @text, '|{N: Not Locked';push @text, 'b: Bad Singleton';push @text, 'B: Bad VCS Tag';push @text, 'd: Package in dpkg_archive';push @text, 'D: DeadWood';push @text, 'E: Essential Release Version';push @text, 'F: Package directories labled';push @text, 'G: Glued into Version Tree';push @text, 'L: Label not in VOB';push @text, 'p: Is a Patch';push @text, 'r: Recent version';push @text, 'R: Ripple';push @text, 'S: Splitpoint';push @text, 't: Glued into Project Tree';push @text, 'T: Tip version';push @text, 'V: In SVN';push @text, '+: In Subversion';push @text, '0: Zero files extracted';push @text, '}}';push @text, '|';push @text, 'Outline';push @text, 'Red: Dead or Bad VCS Tag';push @text, 'Orange: Project Branch Root';push @text, 'Green: Ripple Build Version';push @text, 'Blue: Essential Version';push @text, 'Darkmagenta: Entry Glued into tree';push @text, 'Magenta: Entry added to project tree';push @text, 'DeepPink: Label not in VOB';push @text, 'DarkViolet: Zero files extracted';push @text, '|';push @text, 'Fill';push @text, 'PowderBlue: Essential Version';push @text, 'Red: Bad Essential Version';push @text, 'Light Green: Migrated to SVN';# push @text, 'Red: Entry Glued into tree';# push @text, 'Green: Entry added to project tree';push @text, '|';push @text, 'Shape';push @text, 'Oval: Normal Package Version';push @text, 'Invhouse: Project Branch Root';push @text, 'Octagon: Branch Point';push @text, 'Box: Bad Single version with no history';push @text, 'Doublecircle: Tip of a Project Branch';push @text, '';my $text = join '\l', @text;$text =~ s~\|\\l~|~g;$text =~ s~\}\\l~}~g;my @attributes;push @attributes, "shape=record";push @attributes, "label=\"{$text}\"";push @attributes, "color=red";my $attr = join( ' ', @attributes);my $tld_done = 'LegendBlock';print FH "$tld_done [$attr]\n";}# print FH "\n}\n";print FH "TitleBlock -> LegendBlock [style=invis]\n";sub genLabelText{my ($entry) = @_;my @label;push @label, $versions{$entry}{name} if ( $multiPackages );push @label, $versions{$entry}{vname};# push @label, $entry; # Add PVIDpush @label, substr( $versions{$entry}{created}, 0, 10); # 2008-02-19# push @label, 'V=' . $versions{$entry}{maxVersion};# push @label, 'B=' . $versions{$entry}{svnBranchTip} if ( exists $versions{$entry}{svnBranchTip} );my $stateText = '';$stateText .= 'N' if ($versions{$entry}{locked} eq 'N');$stateText .= 'b' if (exists $versions{$entry}{badSingleton});$stateText .= 'B' if (exists $versions{$entry}{badVcsTag});$stateText .= 'G' if (exists $versions{$entry}{GluedIn});$stateText .= 't' if (exists $versions{$entry}{MakeTree});$stateText .= 'E' if (exists $versions{$entry}{Essential});$stateText .= 'd' if (exists $versions{$entry}{dpkgArchive});$stateText .= 'D' if (exists $versions{$entry}{DeadWood});$stateText .= 'p' if ( $versions{$entry}{isaPatch} );$stateText .= 'R' if ( $versions{$entry}{isaRipple} );$stateText .= 'r' if (exists $versions{$entry}{keepRecent} && $versions{$entry}{keepRecent} );$stateText .= 'S' if (exists $versions{$entry}{EssentialSplitPoint} && $versions{$entry}{EssentialSplitPoint} > 1 );$stateText .= 'T' if (exists $versions{$entry}{Tip} );$stateText .= 'V' if (exists $versions{$entry}{isSvn} );$stateText .= '+' if (exists $versions{$entry}{svnVersion} );$stateText .= '0' if (exists $versions{$entry}{data}{errCode} && $versions{$entry}{data}{errCode} eq '0');$stateText .= 'L' if (exists $versions{$entry}{data}{errCode} && $versions{$entry}{data}{errCode} eq 'L');$stateText .= 'F' if ($versions{$entry}{data}{DirsLabled});# $stateText .= 's' if (exists $versions{$entry}{branchPoint} );# $stateText .= ' T='. $versions{$entry}{threadId} if (exists $versions{$entry}{threadId});# $stateText .= ' EssentalPath' if (exists $versions{$entry}{EssentialPath});# $stateText .= ' Count='. $versions{$entry}{EssentialSplitPoint} if (exists $versions{$entry}{EssentialSplitPoint});# $stateText .= ' M='. $versions{$entry}{maxVersion} if (exists $versions{$entry}{maxVersion});push @label, "(${stateText})" if ( length($stateText) );## Insert Release Namesforeach my $rtag_id ( keys %{$versions{$entry}{Releases}} ) {next unless ( exists $ukHopsReleases{$rtag_id} );push @label, "Release: $versions{$entry}{Releases}{$rtag_id}{rname}";}return join ('\n', @label );}sub genAttributes{my ($entry) = @_;my @attributes;push @attributes, 'label="' . genLabelText($entry) . '"';push @attributes, 'URL="' . dotUrl($entry) . '"';push @attributes, 'tooltip="' . "Goto: $versions{$entry}{vname}, PVID=$entry" ,'"';my $shape;$shape = 'box' if ($versions{$entry}{badSingleton});$shape = 'octagon' if ($versions{$entry}{branchPoint});$shape = 'invhouse' if ($versions{$entry}{newSuffix});$shape = 'doublecircle' if ($versions{$entry}{Tip});push @attributes, 'shape=' . $shape if ( $shape );my $color;my $fill;$color = 'color=green style=bold' if ( $versions{$entry}{isaRipple} );$color = 'color=orange style=bold' if ( $versions{$entry}{newSuffix} );$color = 'color=red style=bold' if ( $versions{$entry}{DeadWood} || $versions{$entry}{badVcsTag} );$color = 'color=blue style=bold' if ( $versions{$entry}{Essential} );$color = 'color=darkmagenta style=bold' if ( $versions{$entry}{GluedIn} );$color = 'color=magenta style=bold' if ( $versions{$entry}{MakeTree} );$color = 'color=DeepPink style=bold' if (exists $versions{$entry}{data}{errCode} && $versions{$entry}{data}{errCode} eq 'L');$color = 'color=DarkViolet style=bold' if (exists $versions{$entry}{data}{errCode} && $versions{$entry}{data}{errCode} eq '0');$fill = 'style=filled fillcolor=powderblue' if ( $versions{$entry}{Essential} );$fill = 'style=filled fillcolor=red' if ( $versions{$entry}{Essential} && $versions{$entry}{badVcsTag} );$fill = 'style=filled fillcolor="#99FF99"' if ( exists $versions{$entry}{svnVersion} );push @attributes, $color if ( $color );push @attributes, $fill if ( $fill );return '[' . join( ' ', @attributes) . ']';}sub genArrowAttributes{my ($not_first, $entry) = @_;my @attributes;push @attributes, 'arrowhead=empty' if ( $not_first );push ( @attributes, 'label="' . $versions{$entry}{svnBranchTip} .'"' ) if ( exists $versions{$entry}{svnBranchTip} );return ('[' . join( ' ', @attributes) . ']') if ( @attributes ) ;return '';}## Flat#if ( $opt_flat ){my $last = 0;foreach my $entry (@flatOrder ){if ( $last ){my $me = dotTag($last);print FH pentry($me) ,' -> ', pentry(dotTag($entry)), genArrowAttributes(0, $entry) ,";\n";print FH pentry($me) ,genAttributes($last) . ";\n";}$last = $entry;}print FH pentry(dotTag($last)) ,genAttributes($last) . ";\n";}else{foreach my $entry ( sort {$a <=> $b} keys(%versions) ){my $me = dotTag($entry);my @versions = @{ $versions{$entry}{next}};my $ii = 0;foreach ( @versions ){print FH pentry($me) ," -> ",pentry(dotTag($_)), genArrowAttributes($ii++, $_), ";\n";}print FH pentry($me) ,genAttributes($entry) . ";\n";}}print FH "\n};\n";close FH;## Convert DOT to a SVG#unless ( $UNIX ){print "Generating graphical images\n";# system( "dot $filebase.dot -Tjpg -o$filebase.jpg" ); # -vsystem( "dot $filebase.dot -Tsvg -o$filebase.svg" ); # -v# unlink("$filebase.dot");## Display a list of terminal packages# These are packages that are not used by any other package#print "\n";# print "Generated: $filebase.dot\n";# print "Generated: $filebase.jpg\n";print "Generated: $filebase.svg\n";}else{print "Generated: $filebase.dot\n";}}sub dotTag{my ($entry) = @_;my $label = '';$label .= $versions{$entry}{name} if $multiPackages;$label .= $versions{$entry}{vname};$label =~ s~[-() ]~_~g;return $label;}sub dotUrl{my ($entry) = @_;my $pv_base = $GBE_RM_URL . "/fixed_issues.asp?pv_id=$entry";}#-------------------------------------------------------------------------------# Function : pentry## Description : Generate an entry list as text# Replace "." with "_" since DOT doesn't like .'s# Seperate the arguments## Inputs : @_ - An array of entries to process## Returns : A string#sub pentry{my ($data) = @_;$data =~ s~\.~_~g;$result = '"' . $data . '"' ;return $result;}#-------------------------------------------------------------------------------# Function : getVobMapping## Description : Read in Package to Repository Mapping## Inputs :## Returns : Populates %VobMapping# Mapping of PackageName to RepoName[/Subdir]#our %ScmRepoMap;sub getVobMapping{Message ("Read in Vob Mapping");my $fname = 'cc2svn.repo.dat';Error "Cannot locate $fname" unless ( -f $fname );require $fname;Error "Data in $fname is not valid\n"unless ( keys(%ScmRepoMap) >= 0 );$opt_vobMap = $ScmRepoMap{$packageNames}{repo}if (exists $ScmRepoMap{$packageNames});$opt_protected = $ScmRepoMap{$packageNames}{protected}if (exists $ScmRepoMap{$packageNames}{protected});$opt_vobMap = '' if ( $opt_repoSubdir );## Free the memory#%ScmRepoMap = ();## Calculate Target Repo#Warning ("No VOB Mapping found")unless ($opt_vobMap || ($opt_repoSubdir && $opt_repo));Error("No repository specified. ie -repo=DevTools or -repo=COTS")unless ( $opt_repo || $opt_vobMap );my $r1 = ($opt_repo || '') . '/' . ($opt_vobMap || '') . '/' . ($opt_repoSubdir || '') ;$r1 = 'Import_test/' . $r1 if ( $opt_useTestRepo );$r1 =~ s~//~/~g;$r1 =~ s~^/~~;$r1 =~ s~/\.$~~;$r1 =~ s~/$~~;$svnRepo = $opt_repo_base . $r1;Message( "Repo URL: $svnRepo");}#-------------------------------------------------------------------------------# Function : getEssenialPackageVersions## Description : Determine the 'Essental' Package Versions# Read the data in from an external file## Inputs :## Returns : Populates @EssentialPackages#our %ScmReleases;our %ScmPackages;our %ScmSuffixes;sub getEssenialPackageVersions{Message ("Read in Essential Package Versions");my $fname = 'cc2svn.raw.txt';Error "Cannot locate $fname" unless ( -f $fname );require $fname;Error "Data in $fname is not valid\n"unless ( keys(%ScmReleases) >= 0 );# DebugDumpData("ScmReleases", \%ScmReleases );# DebugDumpData("ScmPackages", \%ScmPackages );# DebugDumpData("ScmSuffixes", \%ScmSuffixes );## Create a list of essential packages# Retain packages-versions used in this program#foreach ( keys %ScmPackages ){next unless ( exists $pkg_ids{ $ScmPackages{$_}{pkgid} } );push @EssentialPackages, $_;Error ("Essential Package Version not in extracted Release Manager Data: $_")unless ( exists $versions{$_} );$versions{$_}{Essential} = 1;# Retain which RM Release this package-version is the tip# Release offoreach my $rtag_id ( @{$ScmPackages{$_}{'release'}} ){$versions{$_}{Releases}{$rtag_id}{rname} = $ScmReleases{$rtag_id}{name};$versions{$_}{Releases}{$rtag_id}{pname} = $ScmReleases{$rtag_id}{pName};$versions{$_}{Releases}{$rtag_id}{proj_id} = $ScmReleases{$rtag_id}{proj_id};}#print "ESSENTIAL: $versions{$_}{name} $versions{$_}{vname}\n";}## Free memory#%ScmReleases = ();%ScmPackages = ();%ScmSuffixes = ();# DebugDumpData("Essential", \@EssentialPackages );Message ("Essential Versions: " . scalar @EssentialPackages );}#-------------------------------------------------------------------------------# Function : ReportPathVariance## Description : Report variance in paths used by the versions## Inputs :## Returns :#my %VobPaths;sub ReportPathVariance{Message ("Detect Multiple Paths");foreach my $entry ( keys(%versions) ){my $e = $versions{$entry};next if ( isSet ($e, 'DeadWood' ) );next if ( isSet ($e, 'badVcsTag') );next if ( isSet ($e, 'isSvn') );my $tag = $e->{vcsTag};next unless ( $tag );$tag =~ m~^(.+?)::(.*?)(::(.+))?$~;my $vcsType = $1;my $cc_label = $4;my $cc_path = $2;$cc_path = '/' . $cc_path;$cc_path =~ tr~\\/~/~s;$cc_path =~ s~/+$~~;$VobPaths{$cc_path}++;}@multiplePaths = sort keys %VobPaths;if ( scalar @multiplePaths > 1 ){Warning ("Multiple Paths:" . $_ ) foreach (@multiplePaths);# Kill SVN import# User will need to configure one pathunless ( $opt_AllowMuliplePaths ){Warning ("Multiple Paths detected: Import supressed");$opt_useSvn = 0}else{Message ("Multiple Paths detected: Allowed");}}}sub isSet{my ($base, $element) = @_;return 0 unless ( exists $base->{$element} );return $base->{$element};}#-------------------------------------------------------------------------------# Function : recurseList## Description : Return a list of all element below a given head element## Inputs : $head - Head element## Returns : A list, not in any particular order#our @recurseList;sub recurseList{@recurseList = ();recurseListBody (@_);return @recurseList;}sub recurseListBody{foreach my $entry ( @_ ){push @recurseList, $entry;no warnings "recursion";recurseListBody (@{$versions{$entry}{next}});}}#-------------------------------------------------------------------------------# Function : getSvnData## Description : Read the SVN tree and see what we have## Inputs :## Returns :#my @svnDataItems;sub getSvnData{Message ("Examine Subversion Tree");## Re-init data#@svnDataItems = ();%svnData = ();## Create an SVN session#return unless ( $svnRepo );my $svn = NewSessionByUrl ( "$svnRepo/$packageNames" );return unless ( $svn );## extract data## DebugDumpData("SVN", $svn );$svn->SvnCmd ( 'log', '-v', '--xml', '--stop-on-copy', $svn->Full(), { 'credentials' => 1,'process' => \&ProcessSvnLog,});## Process dataforeach my $entry ( @svnDataItems ){my $name;my $target = $entry->{'target'};if ( $target =~ m~/tags/(.*)~ ) {$name = $1;$svnData{tags}{$name} = 1;} elsif ( $target =~ m~/branches/(.*)~ ) {$name = $1;# $branches{$1} = 1;} else {$svnData{nonTag}{$target} = 1;}my $fromBranch;if ( $entry->{'copyfrom-path'} =~ m~/trunk$~ ) {$fromBranch = 'trunk';} elsif ( $entry->{'copyfrom-path'} =~ m~/branches/(.*)~ ) {$fromBranch = $1;}# largest Rev number on branchif ( exists $svnData{max} && exists $svnData{max}{$fromBranch} ){if ( $svnData{max}{$fromBranch}{rev} < $entry->{'copyfrom-rev'} ){$svnData{max}{$fromBranch}{rev} = $entry->{'copyfrom-rev'};$svnData{max}{$fromBranch}{name} = $name;}}else{$svnData{max}{$fromBranch}{rev} = $entry->{'copyfrom-rev'};$svnData{max}{$fromBranch}{name} = $name;}}foreach my $branch ( keys %{$svnData{max}} ){$svnData{tips}{$svnData{max}{$branch}{name}} = $branch;}# DebugDumpData("svnDataItems", \@svnDataItems);# DebugDumpData("SvnData", \%svnData);foreach my $entry ( keys(%versions) ){my $import_label = saneLabel($entry);delete $versions{$entry}{svnVersion};delete $versions{$entry}{svnBranchTip};if ( exists $svnData{tags}{$import_label} ){$versions{$entry}{svnVersion} = 1;}if ( exists $svnData{tips}{$import_label} ){$versions{$entry}{svnBranchTip} = $svnData{tips}{$import_label};}}Message ( 'Trunk used: ' . (exists $svnData{'max'}{trunk} ? 'Yes' : 'No') );Message ( 'Labels : ' . scalar keys %{$svnData{tags}} );Message ( 'Branches : ' . scalar keys %{$svnData{'max'}} );}#-------------------------------------------------------------------------------# Function : ProcessSvnLog## Description :# Parse# <logentry# revision="24272"># <author>bivey</author># <date>2005-07-25T15:45:35.000000Z</date># <paths># <path# prop-mods="false"# text-mods="false"# kind="dir"# copyfrom-path="/enqdef/branches/Stockholm"# copyfrom-rev="24271"# action="A">/enqdef/tags/enqdef_24.0.1.sls</path># </paths># <msg>COTS/enqdef: Tagged by Jats Svn Import</msg># </logentry>## Inputs :## Returns :#my $entryData;my $entryActive;sub ProcessSvnLog{my ($self, $line ) = @_;$entryActive = '' unless ( defined $entryActive );return unless ( $line );#print "----- ($entryActive) $line\n";if ( $line =~ m~^<logentry~ ) {$entryData = ();$entryActive = 'A';} elsif ( ($line =~ s~\s*(.+?)="(.*)">(.*)</path>$~~) && ($entryActive eq 'A') ) {## Last entry has two items# Attribute# Data Item#$entryData->{$1} = $2;$entryData->{target} = $3;} elsif ( ($line =~ m~\s*(.*?)="(.*)"~) && ($entryActive eq 'A') ) {## Attribute#$entryData->{$1} = $2;} elsif ( $line =~ m~</logentry~ ) {$entryActive = '';if ( exists $entryData->{'copyfrom-path'} ){# DebugDumpData("Data", $entryData);push @svnDataItems, $entryData;}}## Return 0 to keep on goingreturn 0;}#-------------------------------------------------------------------------------# Function : saveData## Description : Save essential data## Inputs :## Returns :#sub saveData{my $file = $cwd . "/${packageNames}.data";Message ("Create: $file");my $fh = ConfigurationFile::New( $file );$fh->DumpData("\n# ScmVersions.\n#\n","ScmVersions", \%versions );## Close out the file#$fh->Close();}#-------------------------------------------------------------------------------# Function : restoreData## Description : Read in essential information# Used during a resume operation## Inputs :## Returns :#our %ScmVersions;sub restoreData{my $file = $cwd . "/${packageNames}.data";Message ("Restoring: $file");Error "Cannot locate restoration file: $file" unless ( -f $file );require $file;Error "Resume Data in $file is not valid\n"unless ( keys(%ScmVersions) >= 0 );foreach ( keys %ScmVersions ){$restoreData{$_} = $ScmVersions{$_}{data};$restoreData{$_}{rmRef} = $ScmVersions{$_}{rmRef};}%ScmVersions = ();}#-------------------------------------------------------------------------------# Function : testSvnLabel## Description : Test existence of an SVN label## Inputs : Package# Label to test## Returns : 0 - Tag in place# 1 - Not in place#sub testSvnLabel{my ($svnPkg, $svnTag) = @_;my $rv = JatsToolPrint ( 'jats_svnlabel','-check',"-packagebase=$svnPkg","$svnTag",);Message ("testSvnLabel: $svnTag - $rv");return $rv;}#-------------------------------------------------------------------------------# Documentation#=pod=for htmltoc SYSUTIL::cc2svn::=head1 NAMEcc2svn_gendata - CC2SVN tool to import an entire package into SVN=head1 SYNOPSISjats cc2svn_importpackage [options] package_nameOptions:-help - brief help message-help -help - Detailed help message-man - Full documentation-repository=name - Specify target repository-[no]flat - Do not create project tree. Def: -noflat-prunemode=mode - Mode: none, ripple, retain, severe, Def=ripple-retain=N - Specify retain count for pruning. Def=2-[no]test - Do not create packages. Def:-notest-[no]reuse - Keep and reuse ClearCase views-age=nnDays - Only keep recent package-dump[=n] - Dump raw data. N=0,1,2-images[=n] - Create SVG of version tree. N=0,1,2-name=aaa - Alternate output package name. Test Only-[no]log - Write output to log file. Def: -nolog-[no]postimage - Create image after transger: Def: -post-workdir=path - Use for temp storage (def:/work)-delete - Delete SVN package before test-[no]relabel - Attempt to relabel dirs in packages that don't extract-testRmDatabase - Use test database-[no]fromSvn - Also extract packages from SVN-[no]testRepo - Force use of a test repository.-resume - Resume aborted import (dangerous)=head1 OPTIONS=over 8=item B<-help>Print a brief help message and exits.=item B<-help -help>Print a detailed help message with an explanation for each option.=item B<-man>Prints the manual page and exits.=item B<-prunemode=mode>This option control the manner in which excess versions will be pruned. Validmodes are:=over 8=item noneNo pruning will be performed=item rippleNon-Essential packages that are ripple builds will be removed.=item retainVersions that preceed an Essential version will be retained.=item severeOnly Essential Versions, and Branching points will be retained.=back=back=head1 DESCRIPTIONThis program is a tool used in the conversion of ClearCase VOBS to subversion.It will take a complete package and all relevent versions from ClearCase andinsert them into subversion in a sessible manner. It will attempt to retainfile change order and history.It will:=over 8=item *Read in the Essential Package Version list.=item *Extract, from Release Manager, all known versions of the specified package.=item *It will attempt to determine the type of package: COTS, TOOL, CORE, PROJECTand alter the processing accordingly.=item *It will create a version dependency tree and determine 'new' project branchpoints. It will remove (prune) versions that are excess to requirements.=item *It will extract source from ClearCase and insert it into SVN, creatingbranches and tags as it goes.=backThe program can also be used to create a SVG image of the version dependencytree. This does not work on Linux; only Windows with 'dot' installed.=cut