Rev 1606 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed
#==============================================================================# **** Source Information ****## deploylib_pm_FileName $RCSfile: deploylib.pm,v $ ($Source: /export/repository/cvs/core/devl/TOOLS/deploylib.pm,v $)# deploylib_pm_Version, $Revision: 1.17 $# deploylib_pm_DateTime, $Date: 2002/08/01 05:54:58 $## Program Name : deploylib.pm## Program Type : Perl Module (.pm)## Original Author(s) : V.Chatzimichail(vasilic)## Description / Purpose:# Deploylib is a set of high-level functions written in Perl (for portability)# that allow a user to quickly setup a deployment configuration and produce a# deliverable package.##==============================================================================#------------------------------------------------------------------------------# Package definition#------------------------------------------------------------------------------package deploylib;#------------------------------------------------------------------------------# Pragmas#------------------------------------------------------------------------------require 5.005;use strict;use Getopt::Std;use File::Copy;use File::Find;use File::Basename;use File::Path;use Cwd;use Carp;use DBI;use LWP::UserAgent;use DeployUtils::Logger;use DeployUtils::BuildFile;use DeployUtils::RmPkgInfo;use Exporter();use ArrayHashUtils;#-------------------------------------------------------------------------------# Export variables and function into the users name space#-------------------------------------------------------------------------------our @ISA = qw(Exporter);our @EXPORT = qw(&Init&setPkgDescription&setPkgName&setErgAfcBaseDir&setPkgOverview&addInstallshieldFiles&installAllDpkgArchivePkgFiles&installAllDpkgArchivePkgFiles2&installAllDpkgArchiveDevcdFiles&installAllDpkgArchiveJspFiles&installAllDpkgArchiveFiles&installAllDpkgArchiveAcHtmlFiles&installAllDpkgArchiveInfoFilesFiles&installAllDpkgArchiveSqlFiles&installAllDpkgArchiveWarFiles&installAllDpkgArchiveJarFiles&installAllDpkgArchiveEtcFiles&installAllDpkgArchiveScriptsFiles&installAllDpkgArchiveIncludeFiles&installAllDpkgArchiveDocFiles&installDpkgArchiveFile&installDpkgArchiveAcHtmlFile&installDpkgArchiveRptFile&installDpkgArchiveRoxFile&installDpkgArchiveDatFile&installDpkgArchiveThxFile&installDpkgArchiveMugFile&installDpkgArchiveInfoFilesFile&installDpkgArchiveSqlFile&installDpkgArchiveWarFile&installDpkgArchiveJarFile&installDpkgArchiveSarFile&installDpkgArchiveEtcFile&installDpkgArchiveScriptsFile&installDpkgArchiveIncludeFile&installDpkgArchiveDocFile&installDpkgArchiveBinFile&installDpkgArchiveLibFile&installPkgAddConfigFile&installPkgAddSystemClassFile&updatePrototypeFileAddItem&updatePrototypeFileAddItem2&addPath2Prototype&createAfcRcScriptLink&createAfcRcScriptLink2&installAllDpkgArchiveBinFiles&CreateTargetDirStructure&createPatch&createPackage&createPrototypeFile&addPatchInfo2ProtoTypeFile&addPkgInfoClasses&addPkgInfoField&updatePrototypeFileItemClass&useReplaceClass&setReplaceClassFiles&createPkginfoFile&updatePrototypeFileItemOwner&chmod&chmodRecursive&chmodDir&chmodFile&createSymbolicLink&createPrototypeFile2&installDeployFile&createDpkgArchive&generateHtmlReleaseNote&generateInternalHtmlReleaseNote&generateIShieldIncludeFile&createPerlSvcWin32&createPerlAppWin32&convertFile&getErgAfcBaseDir&getGenericNameNoVersionForLib&getGenericNameForLib%TargetDstDirStructure%LocalSrcDirStructure%BuildPkgArchive$MachType$TargetHomeDir$TargetBaseDir$PkgName);#------------------------------------------------------------------------------# Constants global/local to this package#------------------------------------------------------------------------------use vars qw ( $opt_n $opt_v $opt_r $opt_t $opt_m $opt_d $opt_p $opt_o $opt_k $opt_g );my ($VENDOR_DESC) = "ERG Transit Systems Ltd";my ($CATEGORY_DESC) = "application";my ($ERGAFC_BASEDIR) = "/afc";my ($MAXINST) = "1000";my ($PROJECT_ACRONYM_LENGTH) = 3;my ($PKG_OVERVIEW) = "To Be Defined.";my (@PATCH_INFO_FILES) = qw (checkinstallcopyrightpatch_checkinstallpatch_postinstalli.nonepostinstallpreinstall) ;my (@PATCH_UTIL_FILES) = qw ( backoutpatch installpatch );my (@PKG_UTIL_FILES) = qw ( requestlib.sh );my (@PKG_ISHIELD_FILES) = qw ( ishieldlib.rul ishieldlib.h );my (@PKG_ISHIELD_IMG_FILES) = qw (islib_pane.bmpislib_splash.bmpislib_topicon.bmp);my (@PATCH_ISHIELD_FILES) = qw (postinstall.rulpreinstall.rulpostremove.rulpreremove.rul);my ($PKG_ISHIELD_DEF_FILE) = "pkgdef.h";my ($PKG_ISHIELD_DIR) = "";my ($PKG_UTIL_DIR) = "";my ($PATCH_UTIL_DIR) = "";my ($m_UID) = "";my ($m_GID) = "";my ($m_MASK) = "";#------------------------------------------------------------------------------# Variables global/local to this package#------------------------------------------------------------------------------our $InterfaceDir = "";our $DpkgBinDir = "";our %DpkgBinDirList = ();our $DpkgLibDir = "";our %DpkgLibDirList = ();our $DpkgScriptsDir = "";our $DpkgEtcDir = "";our $DpkgJarDir = "";our $DpkgSarDir = "";our $DpkgWarDir = "";our $DpkgSqlDir = "";our $DpkgInfoFilesDir = "";our $DpkgPkgDir = "";our $DpkgJspDir = "";our $DpkgRoxDir = "";our $DpkgRptDir = "";our $DpkgAcHtmlDir = "";our $DpkgIncludeDir = "";our $DpkgDevcdDir = "";our $DpkgDatDir = "";our $DpkgThxDir = "";our $DpkgMugDir = "";our $DpkgDocDir = "";our @LibCheckList = ();our $CurrentDir = "";our $RootDir = "";our $BuildType = "";our $MachType = "";our $Platform = "";our $Product = "";our $Target = "";our $SrcDir = "";our $PkgDir = "";our $ReleaseDir = "";our $Username = "";our $PkgBaseDir = "";our $PkgInfoFileName = "pkginfo";our $PkgInfoFile = "";our $ProtoTypeFileName = "prototype";our $ProtoTypeFile = "";our $PkgPatchName = "";our $PkgPatchID = "";our $PkgPatchNum = "";our $PkgPatchReadme = "";our $PkgPatchTmpDir = "";our $PkgVersion = "";our $PkgVersionStr = "";our $PkgVersionUser = "";our $PkgName = "";our $PkgBuildNum = "";our $PkgOutputFile = "";our $PkgReleaseNote = "";our $PkgLabel = "";our $PkgDesc = "";our $PkgNameLong = "";our $PkgInfoClasses = "none";our $PkgPreviousVersionStr = "";our $TargetBaseDir = "";our $TargetHomeDir = "";our $SandBoxName = "";our $ProjectAcronym = "";our $TmpGlobalVariable = ""; # used to pass variables into PERL find functionsour %TargetDstDirStructure = ();our %LocalSrcDirStructure = ();our $BuildFileInfo = "";# This was removed to add the use of the Buildfile.pm module, but this hash is needed# because the deployfiles use it for library version numbers in the file lists.# So it is left here and is a simply copy of the hash from buildfile pmour %BuildPkgArchive = ();our $RmPkgDetails = undef;our $RmPvPkgDetails = undef;#------------------------------------------------------------------------------# Initialization actions#------------------------------------------------------------------------------#------------------------------------------------------------------------------# Package Interface Subroutines## The following functions are used by the Makefile.pl scripts. Programmers# call the following functions to set up the basic requirements that the# automated make system requires.#------------------------------------------------------------------------------#------------------------------------------------------------------------------sub Init## Description:# Tests Environment Variables, it also checks the required command line# variables.## Inputs:# Command line.## Returns:# 1## Globals:# $makelib::RootDir## Notes:# -## Todo:# -#------------------------------------------------------------------------------{# first we deal with the command line values we expect, these include:# GBE_ROOT (-r)# Package Name (-n)# Package Home Directory (relative to the ERGAFC_BASEDIR) (-d)# Package Version (-v)# Build Type (-t)# Patch Number (-p)# Previous (old) version number (-o)# Platform (-m)# Product (optional) (-k)# Machine Type (optional) (-g)setLogLevel($ENV{DEPLOYLIB_DEBUG}) if ( defined($ENV{DEPLOYLIB_DEBUG}) && $ENV{DEPLOYLIB_DEBUG} >= 1 && $ENV{DEPLOYLIB_DEBUG} <= 5);$CurrentDir = cwd;my ($i);Getopt::Std::getopts ('v:n:r:t:m:d:p:o:k:g:');if ( $opt_n ){$PkgName = $opt_n;}else{LogError("Package Name not supplied!");}if ( $opt_r ){# lets change to root dir and get fully qualified path from cwd and return backchdir($opt_r);$RootDir = cwd;chdir($CurrentDir);$SandBoxName = File::Basename::basename($RootDir);}else{LogError("GBE_ROOT not supplied!");}if ( $opt_t ){$BuildType = $opt_t;}else{LogError("GBE_TYPE not supplied!");}## Target machine type ( Underlying machine type in a Product Family)# If not provided, the assume that its the same as the platform (compat)#$opt_g = $opt_m unless ( $opt_g );if ( $opt_g ){$Target = $opt_g;if ( $Target =~ /^SOLARIS/ ){$MachType = 'sparc';}elsif ( $Target =~ /^WCE/ ){$MachType = 'WinCE';}elsif ( $Target =~ /^WIN32/ ){$MachType = 'win32';}else{LogError("Unknown target [$opt_g] supplied!");}}## Platform# This is the full product name in a product family.#if ( $opt_m ){$Platform = $opt_m;}else{LogError("Platform not supplied!");}## Setup Product# If not defined then use the platform#$Product = $opt_k ? $opt_k : $Platform;if ( $opt_d ){$TargetBaseDir = $opt_d;}else{LogError("Package base directory not supplied!");}if ( $opt_p ){my $pNum = sprintf("%02s", $opt_p);if ( "$pNum" =~ m/^[0-9][0-9]$/ ){$PkgPatchNum = $pNum;}else{LogError("-p command line arg [$opt_p] has invalid format,\n" ."required format is an integer value.");}}if ($opt_v){if( "$opt_v" =~ m/^[0-9]*\.[0-9]*\.[0-9]*-[0-9]*\.[a-z][a-z][a-z]$/ ) # N.N.N-N.ppp{my ($s1, $s2) = split (/-/, $opt_v);my ($s1a, $s1b, $s1c) = split (/\./, $s1);my ($s2a, $s2b) = split (/\./, $s2);$PkgVersionStr = sprintf("%02s%02s%02s", $s1a,$s1b,$s1c);$PkgVersion = "$s1";$PkgBuildNum = "$s2a";if ( length("$s2b") == $PROJECT_ACRONYM_LENGTH ){$ProjectAcronym = $s2b;}else{LogError("-v command line arg [$opt_v] has invalid format, " ."required format is N.N.N-B.ppp where N is an integer and ppp is the project acronym.\n" ."Check propject acronym.");}}elsif( "$opt_v" =~ m/^[0-9]*\.[0-9]*\.[0-9]*\.[a-z][a-z][a-z]$/ ) # N.N.N.ppp{my ($tmpVar) = $opt_v;$tmpVar =~ s/^([0-9]*)\.([0-9]*)\.([0-9]*)\.([a-z][a-z][a-z])$/$1,$2,$3,$4/g;my ($s1, $s2, $s3, $s4) = split (/,/, $tmpVar);$PkgVersionStr = sprintf("%02s%02s%02s", $s1,$s2,$s3);$PkgVersion = "$s1\.$s2\.$s3";$PkgBuildNum = "1";if ( length("$s4") == $PROJECT_ACRONYM_LENGTH ){$ProjectAcronym = $s4;}else{LogError("-v command line arg [$opt_v] has invalid format, " ."required format is N.N.N.ppp where N is an integers and ppp is the project acronym.\n" ."Check propject acronym.");}}else{LogError("-v command line arg [$opt_v] has invalid format, " ."possible formats include:\n\n" ."\tN.N.N-B.ppp where N and B are integers and ppp is the project acronym,\n" ."\tN.N.N.ppp where N is an integer and ppp is the project acronym, B=0.\n");}$PkgVersionUser = $opt_v;}else{LogError("Package Version not supplied!");}# lets check to see if we have a previous versionif ($opt_o){$PkgPreviousVersionStr = $opt_o;}# lets define where we get our stuff from#if ( $ERGAFC_BASEDIR =~ m|/$| ){$TargetHomeDir= "$ERGAFC_BASEDIR$TargetBaseDir";}else{$TargetHomeDir= "$ERGAFC_BASEDIR/$TargetBaseDir";}$PkgDir = "$RootDir/pkg";$SrcDir = "$RootDir/src";$InterfaceDir = "$RootDir/interface";$ReleaseDir = "$RootDir/build/deploy";$PKG_UTIL_DIR = "$InterfaceDir/deployfiles";$PATCH_UTIL_DIR = $PKG_UTIL_DIR;## InstallShield files are provided via a package# Ensure that a suitable package has been provided#if ( ! -d $PKG_UTIL_DIR ){LogError('-x', "No deployment support files found");LogError( "These MUST be provided by a dependant package in build.pl");}$Username = getlogin || getpwuid($<);if ( "$BuildType" eq "D" ){$PkgBaseDir = "$PkgDir/debug";}else{$PkgBaseDir = "$PkgDir/prod";}$PkgInfoFile = "$PkgBaseDir/$PkgInfoFileName";$ProtoTypeFile = "$PkgBaseDir/$ProtoTypeFileName";$DpkgScriptsDir = "$InterfaceDir/scripts";$DpkgEtcDir = "$InterfaceDir/etc";$DpkgJarDir = "$InterfaceDir/jar";$DpkgSarDir = "$InterfaceDir/sar";$DpkgWarDir = "$InterfaceDir/war";$DpkgSqlDir = "$InterfaceDir/sql";$DpkgInfoFilesDir = "$InterfaceDir/infofiles";$DpkgPkgDir = "$InterfaceDir/pkg";$DpkgJspDir = "$InterfaceDir/jsp";$DpkgRoxDir = "$InterfaceDir/rox";$DpkgRptDir = "$InterfaceDir/rpt";$DpkgAcHtmlDir = "$InterfaceDir/achtml";$DpkgIncludeDir = "$InterfaceDir/include";$DpkgDevcdDir = "$InterfaceDir/devcd";$DpkgDatDir = "$InterfaceDir/dat";$DpkgThxDir = "$InterfaceDir/thx";$DpkgMugDir = "$InterfaceDir/mug";$DpkgDocDir = "$InterfaceDir/doc";$DpkgLibDir = "$InterfaceDir";$DpkgBinDir = "$InterfaceDir";# Define where we might find our artifacts# The search order is: Platform, Product, Target, MachineType## Only add the directory to the list if it actually exists# This will speed up searching later.## Create multiple search paths# One for an exaustive search# Others for selective searchs##foreach my $part ( $Platform, $Product, $Target, $MachType ){next unless ( $part );foreach my $subdir ( "lib." . "$part","lib." . "$part" . "$BuildType","lib/lib." . "$part" . "$BuildType","lib/$part" . "$BuildType","lib/$part" ){if ( -d "$DpkgLibDir/$subdir" ){UniquePush( \@{$DpkgLibDirList{_ALL_}}, $subdir);UniquePush( \@{$DpkgLibDirList{$part}}, $subdir);}}}foreach my $part ( $Platform, $Product, $Target, $MachType ){next unless ( $part );foreach my $subdir ( "bin." . "$part" . "$BuildType","bin." . "$part","bin/bin." . "$part" . "$BuildType","bin/" . "$part" . "$BuildType","bin/" . uc($part) . "$BuildType","bin/$part","bin." . "$part" . "P","bin/bin." . "$part" . "P","bin/" . "$part" . "P","bin/" . uc($part) . "P" ){if ( -d "$DpkgBinDir/$subdir" ){UniquePush( \@{$DpkgBinDirList{_ALL_}}, $subdir);UniquePush( \@{$DpkgBinDirList{$part}}, $subdir);}}}LogNorm("------------------------------------------------------------");# lets generate the patch id if we are building a patch#if ( "x$PkgPatchNum" ne "x" ){LogNorm("This is a PATCH build...");$PkgPatchName = uc ($PkgName);my ($_tmpStr) = sprintf("%s%s", $PkgPatchName,$PkgVersionStr);$PkgPatchID = "$_tmpStr" . "-" . "$PkgPatchNum";$PkgPatchReadme = "$PkgBaseDir" . "/README." . "$PkgPatchID";$PkgPatchTmpDir = "$PkgBaseDir/tmp";$PkgReleaseNote = "$PkgBaseDir" . "/$PkgPatchName" ."$PkgVersionStr\_" ."$PkgPatchNum\_" ."$ProjectAcronym\_" ."$Platform";$PkgLabel = uc ($ProjectAcronym) . "_" .$PkgPatchName . "_" .$PkgVersionStr ."_P" . $PkgPatchNum;# lets define what our output package name shall be#$PkgOutputFile = "na";}else{LogNorm("This is a normal RELEASE build...");$PkgReleaseNote = "$PkgBaseDir" . "/" ."$PkgName" . "-" ."$PkgVersion" . "." ."$ProjectAcronym" . "-" ."$Platform";$PkgLabel = uc ($ProjectAcronym) . "_" .uc ($PkgName) . "_" ."R_" ."$PkgVersionStr";# lets define what our output package name shall be#$PkgOutputFile = "$PkgName" . "-" ."$PkgVersion" . "." ."$ProjectAcronym" . "-" ."$Platform" . "-" ."$BuildType\.pkg";}# lets load all our build dependencies#$BuildFileInfo = DeployUtils::BuildFile->new("$RootDir/build.pl");# Now lets make a copy into %BuildPkgArchive%BuildPkgArchive = $BuildFileInfo->getDpkgArchiveHash();LogNorm("------------------------------------------------------------");# lets just show what we have determined.#LogNorm("Current environment definitions (Increase Debug Level to see all definitions)...");LogInfo("DeployFiles =[$PKG_UTIL_DIR]");LogNorm("PkgName =[$PkgName]");LogNorm("PkgVersionUser =[$PkgVersionUser]");LogNorm("PkgVersion =[$PkgVersion]");LogNorm("PkgVersionStr =[$PkgVersionStr]");LogNorm("PkgBuildNum =[$PkgBuildNum]");if ( "x$PkgPatchID" ne "x" ){LogNorm("PkgPatchName =[$PkgPatchName]");LogNorm("PkgPatchNum =[$PkgPatchNum]");LogNorm("PkgPatchID =[$PkgPatchID]");LogNorm("PkgPatchTmpDir =[$PkgPatchTmpDir]");}LogNorm("PkgReleaseNote =[$PkgReleaseNote]");LogNorm("PkgLabel =[$PkgLabel]");LogNorm("PkgPreviousVersionStr=[$PkgPreviousVersionStr]");LogNorm("ProjectAcronym =[$ProjectAcronym]");LogNorm("BuildType =[$BuildType]");LogNorm("MachType =[$MachType]");LogNorm("Platform =[$Platform]");LogNorm("Product =[$Product]");LogNorm("Target =[$Target]");LogNorm("CurrentDir =[$CurrentDir]");LogNorm("RootDir =[$RootDir]");LogNorm("SandBoxName =[$SandBoxName]");LogNorm("Username =[$Username]");LogNorm("TargetBaseDir =[$TargetBaseDir]");LogNorm("TargetHomeDir =[$TargetHomeDir]");LogNorm("PkgBaseDir =[$PkgBaseDir]");LogNorm("SrcDir =[$SrcDir]");LogNorm("PkgDir =[$PkgDir]");LogNorm("ReleaseDir =[$ReleaseDir]");LogInfo("InterfaceDir =[$InterfaceDir]");LogInfo("DpkgScriptsDir =[$DpkgScriptsDir]");LogInfo("DpkgBinDir(s) =[");foreach $i (@{$DpkgBinDirList{'_ALL_'}}){LogInfo(" $DpkgBinDir/$i");}LogInfo(" ]");LogInfo("DpkgLibDir(s) =[");foreach $i (@{$DpkgLibDirList{'_ALL_'}}){LogInfo(" $DpkgLibDir/$i");}LogInfo(" ]");LogInfo("DpkgEtcDir =[$DpkgEtcDir]");LogInfo("DpkgJarDir =[$DpkgJarDir]");LogInfo("DpkgSarDir =[$DpkgSarDir]");LogInfo("DpkgWarDir =[$DpkgWarDir]");LogInfo("DpkgSqlDir =[$DpkgSqlDir]");LogInfo("DpkgJspDir =[$DpkgJspDir]");LogInfo("DpkgRoxDir =[$DpkgRoxDir]");LogInfo("DpkgRptDir =[$DpkgRptDir]");LogInfo("DpkgAcHtmlDir =[$DpkgAcHtmlDir]");LogInfo("DpkgIncludeDir =[$DpkgIncludeDir]");LogInfo("DpkgDevcdDir =[$DpkgDevcdDir]");LogInfo("DpkgDatDir =[$DpkgDatDir]");LogInfo("DpkgThxDir =[$DpkgThxDir]");LogInfo("DpkgMugDir =[$DpkgMugDir]");LogInfo("DpkgDocDir =[$DpkgDocDir]");LogInfo("DpkgInfoFilesDir =[$DpkgInfoFilesDir]");LogInfo("DpkgPkgDir =[$DpkgPkgDir]");LogInfo("PkgInfoFile =[$PkgInfoFile]");LogInfo("ProtoTypeFile =[$ProtoTypeFile]");foreach $i ( $BuildFileInfo->getDpkgArchiveList() ){my $moduleInfo = $BuildFileInfo->getDpkgArchiveInfo($i);LogInfo( "Build Dependency =" ."[$moduleInfo->{type}] " ."[$i] " ."[$moduleInfo->{version}] " ."[$moduleInfo->{proj}]");}if ( "$MachType" eq "sparc" ){LogNorm("PkgOutputFile =[$PkgOutputFile]");}LogNorm("PkgOverview =[$PKG_OVERVIEW]");# Lets evaluate TargetDstDirStructure to expand any varsforeach $i ( keys %TargetDstDirStructure ){if ( $TargetDstDirStructure{$i} =~ /\$/ ){LogDebug("-n", "Expanding TargetDstDirStructure [$TargetDstDirStructure{$i}] to ");$TargetDstDirStructure{$i} = eval "sprintf " . qq/"$TargetDstDirStructure{$i}"/;print("[$TargetDstDirStructure{$i}]\n");}}# lets check waht we can before proceeding.#ValidateLocalSrcDirStructure();# Everything went ok lets begin by creating some dirs...#CreateTargetDirStructure();# lets get some details for our packagegetRmDetails();# donereturn 1;}#------------------------------------------------------------------------------sub setPkgDescription## Description:# This sub-routine is used to set the Package DESC field# from within the deployfile.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 1 ){LogError("Incorrect number of params passed to " ."setPkgDescription() function. " ."Check deploy config.");}my ($lpkgDesc) = shift;# we use what was defined in deployfile if# the RM details are not availableif ( ! defined($RmPkgDetails) ){$PkgDesc = $lpkgDesc;}else{# let's use the details if we have themif ( $RmPkgDetails->foundDetails() ){# we have RM details, we will only use them# if nothing is locally defined,# (ie locally defined details takes precedence)if ( "x$lpkgDesc" eq "x" ){$PkgDesc = $RmPkgDetails->pv_description();}else{$PkgDesc = $lpkgDesc;}}else{$PkgDesc = $lpkgDesc;}}# donereturn 1;}#------------------------------------------------------------------------------sub setPkgName## Description:# This sub-routine is used to set the Package NAME field# from within the deployfile.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 1 ){LogError("Incorrect number of params passed to " ."setPkgName() function. " ."Check deploy config.");}$PkgNameLong = shift;# donereturn 1;}#------------------------------------------------------------------------------sub setErgAfcBaseDir## Description:# This sub-routine is used to reset the ERG AFC base dir global variable# from within the deployfile.##------------------------------------------------------------------------------{# if TargetBaseDir is empty then init has not been called yet so we can set# base dir, if however it is not null then init has been called and setting# base dir after init causes problems in some cases.if ( $TargetBaseDir ne "" ){LogError("setErgAfcBaseDir() cannot be called after Init(), place before Init() in deployfile.pl");}# correct number of parameters?if ( ($#_+1) != 1 ){LogError("Incorrect number of params passed to " ."setErgBaseDir() function. " ."Check deploy config.");}my ($newDir) = @_;$ERGAFC_BASEDIR = "$newDir";return 1;}#------------------------------------------------------------------------------sub getErgAfcBaseDir## Description:# This sub-routine is used to get the ERG AFC base dir global variable# to be used within the deployfile.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 0 ){LogError("Incorrect number of params passed to " ."getErgBaseDir() function. " ."Check deploy config.");}return "$ERGAFC_BASEDIR";}#------------------------------------------------------------------------------sub setPkgOverview## Description:# This sub-routine is used to reset the package overview that# is used to build the package from within the deployfile.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 1 ){LogError("Incorrect number of params passed to " ."setPkgOverview() function. " ."Check deploy config.");}my ($mStr) = @_;$PKG_OVERVIEW = "$mStr";return 1;}#------------------------------------------------------------------------------sub getPkgOverview## Description:# This sub-routine is used to get the package overview string global variable# to be used within the deployfile.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 0 ){LogError("Incorrect number of params passed to " ."getPkgOverview() function. " ."Check deploy config.");}return "$PKG_OVERVIEW";}#------------------------------------------------------------------------------sub addInstallshieldFiles## Description:# This is called to add extra installshield files to the PKG_ISHIELD_FILES array.# For each parameter it checks for the existense of arg.* in the PKG_UTIL_DIR# and adds all found files to the array# This must be called before init() is called.## INPUT:# files to add## RETURN:# nothing##------------------------------------------------------------------------------{my @files;# lets just check to see if we can execute this function on this machine.if ( "$MachType" eq "sparc" ){LogInfo("addInstallshieldFiles() not supported on this machine type.");return 1;}foreach my $i ( @_ ){@files = glob("$PKG_UTIL_DIR/$i.*");foreach my $j ( @files ){$j = basename($j);LogNorm("Adding Installshield file $j");push(@PKG_ISHIELD_FILES, $j);}}return 1;} # addInstallshieldFiles#------------------------------------------------------------------------------sub removeBuildTypeFromItemName## Description:# This sub-routine is used to remove the buildtype from the item name.# i.e. debug files will be tagged with *D.*# prod file will be tagged with *P.*## INPUT:# item name## RETURN:# new item name.##------------------------------------------------------------------------------{my ($file) = @_;my ($nfile) = $file;$nfile =~ s/D\.|P\./\./;return "$nfile";}#------------------------------------------------------------------------------sub installAllDpkgArchivePkgFiles## Description:# This sub-routine is used to install all infofiles files from the# dpkg_archive into the defined install area.## It assumes based on the build type where the src files will be located.## If it has any problems it will log an error and stop processing.## Source directory: $DpkgPkgDir (interface/pkg)# Target directory: $PkgBaseDir (output/pkg/[debug|prod]##------------------------------------------------------------------------------{## Use the (now) more general function installAllDpkgArchivePkgFiles2# with spacial parameters to mimic the original function## Copy all from the 'pkg' directory to the PkgBaseDir#installAllDpkgArchivePkgFiles2 ( "--Dstdir=$PkgBaseDir", '--Srcdir=pkg', @_ );return 1;}#------------------------------------------------------------------------------sub installAllDpkgArchivePkgFiles2## Description:# This sub-routine is used to install all pkg files from the# dpkg_archive into the defined install area.## Simlar to installAllDpkgArchivePkgFiles, but the target directory# is specified by the user.## It assumes based on the build type where the src files will be located.## If it has any problems it will log an error and stop processing.## Inputs : targetTag - Target directory [Mandatory]# options - Optional options# --Srcdir=path [default=pkg]# --Dstdir=abs_path [internal use]# --NoRecurse# --Recurse [default]# --Flatten# --NoFlatten [default]# --FilterIn=xx# --FilterInRE=xx [default=.*]# --FilterOut=xx# --FilterOutRE=xx## Notes: --FilterIn=xxxx, --FilterOut=xxx# xxx is a simple Shell style filter where:# * means one or more charters '*.EXE'# ? means a single character '*.?'# [abc] means either a or b or c 'file.[ch]'## --FilterInRE=xxx, --FilterOutRE=xxx# xxx is a Regular Expression. There are harder to use but very# powerful. ie '.*\.EXE$'## The 'In' filters are applied before the 'Out' filters.## If no 'In' filters are specified then all files will be included.## The filter rules are applied to the path below the Srcdir, and, for# the purposes of the filter the path starts with a '/'.##------------------------------------------------------------------------------{my $src_base_dir;my $recurse = 1;my @dir_tree_exclude;my @dir_tree_include;my $flatten = 0;my $dstDir;LogNorm("Installing all Prepared pkg files...");## Process the arguments and extract parameters and options#foreach ( @_ ){if ( m/^--Srcdir=(.*)/ ) {LogError("installAllDpkgArchivePkgFiles2: Multiple --Srcdir not allowed")if ( $src_base_dir );$src_base_dir = "$InterfaceDir/$1";} elsif ( /^--Dstdir=(.*)/ ) {LogError("installAllDpkgArchivePkgFiles2: Multiple target directories not allowed")if ( $dstDir );$dstDir = $1;} elsif ( m/^--NoRecurse/ ) {$recurse = 0;} elsif ( m/^--Recurse/ ) {$recurse = 1;} elsif ( /^--FilterOut=(.*)/ ) {push @dir_tree_exclude, glob2pat($1);} elsif ( /^--FilterOutRE=(.*)/ ) {push @dir_tree_exclude, $1;} elsif ( /^--FilterIn=(.*)/ ) {push @dir_tree_include, glob2pat($1);} elsif ( /^--FilterInRE=(.*)/ ) {push @dir_tree_include, $1;} elsif ( /^--Flatten/ ) {$flatten = 1;} elsif ( /^--NoFlatten/ ) {$flatten = 0;} elsif ( m/^--/ ) {LogError("installAllDpkgArchivePkgFiles2: Unknown option: $_")} else {LogError("installAllDpkgArchivePkgFiles2: Multiple target directories not allowed")if ( $dstDir );# Convert the symbolic target directory name into a real path$dstDir = getTargetDstDirValue($_, "A");}}## Ensure that we have a valid source directory# Data taken from the 'pkg' directory unless otherwise specified by the user#$src_base_dir = $DpkgPkgDir unless $src_base_dir;LogError("installAllDpkgArchivePkgFiles2: Package directory not found: $src_base_dir")unless ( -d $src_base_dir );## Ensure that the user has specified a target directory#LogError("installAllDpkgArchivePkgFiles2: No target directories specified")unless ( $dstDir );## Build up a list of files to copy# Creating a list allows:# Simplified coding# Flattening and testing of the flattening#my @elements = ExpandDirTree( $src_base_dir, \@dir_tree_exclude, \@dir_tree_include, $recurse );## Perform the file copy# This copy will NOT create empty directories, but it will create needed# directories on the fly.#foreach my $sfile ( @elements ){## Split into directory and file as we may need to make the directory# since the copy operation will not#my $dir; # Target directorymy $tfile; # Target path(my $fname = $sfile )=~ s~^.*/+~~; # Filename(only)unless ( $flatten ){$sfile =~ m~^(.*/)~;$dir = "$dstDir/$1";$tfile = $sfile;}else{$dir = $dstDir;$tfile = $fname;}## Ensure the target directory is present#unless ( -d $dir ){LogInfo ( "mkdir $dir");mkpath ( $dir, 0, 0775);}## Copy the file# Ensure that the target file does not already exist# This is most likely to occur when flattening the directory structure#my $m_sfile = "$src_base_dir$sfile";my $m_tfile = "$dstDir/$tfile";if ( -f $m_tfile ){LogError("Failed to copy file [$m_sfile] to [$m_tfile]: File already exists");}if( File::Copy::copy("$m_sfile", "$m_tfile") ){LogNorm("Copied [$fname] to [$m_tfile] ...");}else{LogError("Failed to copy file [$m_sfile] to [$m_tfile]: $!");}}return 1;}#-------------------------------------------------------------------------------# Function : glob2pat## Description : Convert four shell wildcard characters into their equivalent# regular expression; all other characters are quoted to# render them literals.## Inputs : Shell style wildcard pattern## Returns : Perl RE#sub glob2pat{my $globstr = shift;$globstr =~ s~^/~~;my %patmap = ('*' => '[^/]*','?' => '[^/]','[' => '[',']' => ']',);$globstr =~ s{(.)} { $patmap{$1} || "\Q$1" }ge;return '/' . $globstr . '$';}#-------------------------------------------------------------------------------# Function : ExpandDirTree## Description : Search a directory tree and return a list of files# that match the inclusion and exclusion filter## The include filter is applied before the exclusuion filter## Inputs : $dir - Directory to process# $exclude - Ref to a List of regexps of files to exclude# $include - Ref to a List of regexps of files to include# $recurse - True: recurse subdirs## Returns : A list of files#my @ExpandDirTree_list; # Must be global to avoid closure problemsmy $ExpandDirTree_len;sub ExpandDirTree{my( $dir, $exclude, $include, $recurse ) = @_;## Clean up the user dir. Remove any trailing / as we will be adding it back##$dir =~ s~/*$~~g;## Init recursion information# Needed to avoid closure interactions#@ExpandDirTree_list = ();$ExpandDirTree_len = length( $dir );## Create a list of candidate files# If we are recursing the subtree, then this is a little harder# If we are not recursing then we can't simply glob the directory as# not all files are processed.## Will end up with a list of files that# 1) Start with a '/'# 2) Are rooted as $dir, but don't include $dir#if ( $recurse ){sub find_file_wanted{return if ( -d $_ );my $file = $File::Find::name;push @ExpandDirTree_list, substr($file, $ExpandDirTree_len );}## Under Unix we need to follow symbolic links, but Perl's# Find:find does not work with -follow under windows if the source# path contains a drive letter.## Solution. Only use follow under non-windows systems.# Works as Windows does not have symlinks (yet).#my $follow_opt = ! ( "$MachType" eq "win32" || "$MachType" eq "WinCE" );File::Find::find( {wanted => \&find_file_wanted, follow_fast => $follow_opt }, $dir);}else{local *DIR ;opendir DIR, $dir || die ("Cannot open $dir");foreach ( readdir( DIR ) ){next if /^\Q.\E$/;next if /^\Q..\E$/;next if ( -d "$dir/$_" );push @ExpandDirTree_list, '/' . $_;}closedir DIR;}## If filtering is not present then return the entire file list#return @ExpandDirTree_listunless ( @$include || @$exclude );## Filtering is present# Apply the filterin rules and then the filter out rules# If no filter-in rules, then assume that all files are allowed in and# simply apply the filter-out rules.#my @patsin = map { qr/$_/ } @{$include};my @patsout = map { qr/$_/ } @{$exclude};my @result;# map { print "Include:$_\n"; } @{$include};# map { print "Exclude:$_\n"; } @{$exclude};file:foreach my $file ( @ExpandDirTree_list ){if ( @$include ){my $in = 0;for my $pat (@patsin){if ( $file =~ /$pat/ ){$in = 1;last;}}#print "------- Not included $file\n" unless $in;next unless ( $in );}for my $pat (@patsout){#print "------- REJECT $file :: $pat \n" if ( $file =~ /$pat/ );next file if ( $file =~ /$pat/ );}push @result, $file;}return @result;}#------------------------------------------------------------------------------sub installAllDpkgArchiveDevcdFiles## Description:# This sub-routine is used to install all devcd files from the# dpkg_archive into the defined install area.## It assumes based on the build type where the src files will be located.## If it has any problems it will log an error and stop processing.## Source directory: $DpkgDevcdDir (interface/devcd)# Target directory: Symbolic Directory## Inputs: None##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 1 ){LogError("Incorrect number of params passed to " ."installAllDpkgArchiveDevcdFiles() function. " ."Check deploy config.");}LogNorm("Installing all Prepared Day 0 devcd files...");my ($targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "R");# ok we have a valid dst value we now need to get a hold of all the# lib scripts files.#if ( "$MachType" eq "win32" || "$MachType" eq "WinCE" ){$TmpGlobalVariable = $targetValue;File::Find::find( \&pkgFindDevcd, "$DpkgDevcdDir");}else{my ($i);my(@FindRes) = `find $DpkgDevcdDir -follow`;my ($m_sfile);my ($tmp_DstDir) = "$PkgBaseDir/$targetValue";my ($tmp_SrcDir) = "$DpkgDevcdDir";foreach $i (@FindRes){chomp($i);my($base)= File::Basename::basename($i);if ( $base eq "devcd" ){next;}my ($tmp_dItem) = $i;$tmp_dItem =~ s/$tmp_SrcDir/$tmp_DstDir/;if ( -d "$i"){# we have a directoryif ( ! -d "$tmp_dItem" ){mkpath ( "$tmp_dItem", 0, 0775);LogInfo ( "mkdir $tmp_dItem");}}else{if(File::Copy::copy("$i", "$tmp_dItem")){LogNorm("Copied [$base] to [$tmp_dItem] ...");}else{LogError("Failed to copy pkg file [$tmp_dItem] to [$i]: $!");}}}}return 1;}#------------------------------------------------------------------------------sub pkgFindDevcd## Description:# This subroutine is used to locate all associated devcd files in# a pre-defined dpkg_archive.## Trick: Will not copy a file/directory called 'devcd'# Not too sure why. May be an attempt to prevent empty devcd directories# If you know better, then correct this comment.#------------------------------------------------------------------------------{my($item)= "$File::Find::name";my($base)= File::Basename::basename($item);if ( $base eq "devcd" ){return 1;}my ($tmp_dItem) = $item;my ($tmp_DstDir) = "$PkgBaseDir/$TmpGlobalVariable";my ($tmp_SrcDir) = "$DpkgDevcdDir";$tmp_dItem =~ s/$tmp_SrcDir/$tmp_DstDir/;# we need to determine what type of item we are dealing with file we are dealing withif ( -d "$item"){# we have a directoryif ( ! -d "$tmp_dItem" ){mkpath ( "$tmp_dItem", 0, 0775);LogInfo ( "mkdir $tmp_dItem");}}else{if(File::Copy::copy("$item", "$tmp_dItem")){LogNorm("Copied [$base] to [$tmp_dItem] ...");}else{LogError("Failed to copy pkg file [$tmp_dItem] to [$item]: $!");}}}#------------------------------------------------------------------------------sub installAllDpkgArchiveFiles## Description:# This sub-routine is used to install all files from the# dpkg_archive into the defined install area.## It assumes based on the build type where the src files will be located.## If it has any problems it will log an error and stop processing.## Inputs: $targetType - Internal tag to specify source file# $targetTag - Users tag for destination###------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."installAllDpkgArchiveFiles() function. " ."Check deploy config.");}my ($targetType, $targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my $targetValue;if ( $targetTag eq "--NoTag" ){$targetValue = "$PkgBaseDir/$TargetBaseDir";}else{$targetValue = getTargetDstDirValue($targetTag, "A");}# ok we have a valid dst value we now need to get a hold of all the# lib scripts files.#local *DIR;my $src_dir;if ( "$targetType" eq "jar" ) { $src_dir = $DpkgJarDir; }elsif ( "$targetType" eq "sar" ) { $src_dir = $DpkgSarDir; }elsif ( "$targetType" eq "include" ) { $src_dir = $DpkgIncludeDir; }elsif ( "$targetType" eq "war" ) { $src_dir = $DpkgWarDir; }elsif ( "$targetType" eq "infofiles" ) { $src_dir = $DpkgInfoFilesDir; }elsif ( "$targetType" eq "sql" ) { $src_dir = $DpkgSqlDir; }elsif ( "$targetType" eq "etc" ) { $src_dir = $DpkgEtcDir; }elsif ( "$targetType" eq "scripts" ) { $src_dir = $DpkgScriptsDir; }elsif ( "$targetType" eq "rox" ) { $src_dir = $DpkgRoxDir; }elsif ( "$targetType" eq "rpt" ) { $src_dir = $DpkgRptDir; }elsif ( "$targetType" eq "doc" ) { $src_dir = $DpkgDocDir; }elsif ( "$targetType" eq "jsp" ) { $src_dir = $DpkgJspDir; }# elsif ( "$targetType" eq "achtml" ) { $src_dir = $DpkgAcHtmlDir; }else {LogError("installAllDpkgArchiveFiles() passed unknown target type [$targetType].");}opendir(DIR, $src_dir) orLogError("can't opendir $src_dir: $!");# lets process what we have found#my ($file);while (defined($file = readdir(DIR))){if ( $file !~ /^.$/ &&$file !~ /^..$/ ){my ($m_fLoc) = "$src_dir/$file";if(File::Copy::copy("$m_fLoc", "$targetValue")){LogNorm("Copied [$targetType] item [$file] to [$targetValue] ...");}else{LogError("Failed to copy [$targetType] item [$m_fLoc]: $!");}}}closedir(DIR);return 1;}#------------------------------------------------------------------------------sub installAllDpkgArchiveAcHtmlFiles## Description:# This sub-routine is used to install all achtml files from the# dpkg_archive into the defined install area.## It assumes based on the build type where the src files will be located.## If it has any problems it will log an error and stop processing.### Ugly trick:# This function tags a $$targetType argument which is used in constructing# the source directory path. ie: InterfaceDir/achtml/$targetType## Could provide as an option to installAllDpkgArchiveFiles and re-use that# function##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."installAllDpkgArchiveAcHtmlFiles() function. " ."Check deploy config.");}my ($targetType, $targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# lets check to see if the source type dir actually exists#my($m_sDirLoc) = "$DpkgAcHtmlDir/$targetType";if( ! -d "$m_sDirLoc" ){LogError("Failed to locate [$targetType] AcHtml dir [$m_sDirLoc].");}# know everything exists so lets do the biz.## now we need to copy all the files.#local *DIR;opendir(DIR, $m_sDirLoc) orLogError("can't opendir $m_sDirLoc: $!");my ($m_fLoc) = "";my ($file) = "";while (defined($file = readdir(DIR))){if ( $file !~ /^.$/ &&$file !~ /^..$/ ){$m_fLoc = "$m_sDirLoc/$file";if(File::Copy::copy("$m_fLoc", "$targetValue")){LogNorm("Copied AcHtml [$targetType] item [$file] to [$targetValue] ...");}else{LogError("Failed to copy AcHtml [$targetType] item [$m_fLoc]: $!");}}}closedir(DIR);return 1;}#------------------------------------------------------------------------------sub installAllDpkgArchiveInfoFilesFiles## Description:# This sub-routine is used to install all infofiles files from the# dpkg_archive into the defined install area.## It assumes based on the build type where the src files will be located.## If it has any problems it will log an error and stop processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 1 ){LogError("Incorrect number of params passed to " ."installAllDpkgArchiveInfoFilesFiles() function. " ."Check deploy config.");}my ($targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installAllDpkgArchiveFiles("infofiles", $targetTag);return 1;}#------------------------------------------------------------------------------sub installAllDpkgArchiveSqlFiles## Description:# This sub-routine is used to install all sql files from the# dpkg_archive into the defined install area.## It assumes based on the build type where the src files will be located.## If it has any problems it will log an error and stop processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 1 ){LogError("Incorrect number of params passed to " ."installAllDpkgArchiveSqlFiles() function. " ."Check deploy config.");}my ($targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installAllDpkgArchiveFiles("sql", $targetTag);return 1;}#------------------------------------------------------------------------------sub installAllDpkgArchiveWarFiles## Description:# This sub-routine is used to install all war files from the# dpkg_archive into the defined install area.## It assumes based on the build type where the src files will be located.## If it has any problems it will log an error and stop processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 1 ){LogError("Incorrect number of params passed to " ."installAllDpkgArchiveWarFiles() function. " ."Check deploy config.");}my ($targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installAllDpkgArchiveFiles("war", $targetTag);return 1;}#------------------------------------------------------------------------------sub installAllDpkgArchiveJarFiles## Description:# This sub-routine is used to install all jar files from the# dpkg_archive into the defined install area.## It assumes based on the build type where the src files will be located.## If it has any problems it will log an error and stop processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 1 ){LogError("Incorrect number of params passed to " ."installAllDpkgArchiveJarFiles() function. " ."Check deploy config.");}my ($targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installAllDpkgArchiveFiles("jar", $targetTag);return 1;}#------------------------------------------------------------------------------sub installAllDpkgArchiveEtcFiles## Description:# This sub-routine is used to install all etc files from the# dpkg_archive into the defined install area.## It assumes based on the build type where the src files will be located.## If it has any problems it will log an error and stop processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 1 ){LogError("Incorrect number of params passed to " ."installAllDpkgArchiveEtcFiles() function. " ."Check deploy config.");}my ($targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installAllDpkgArchiveFiles("etc", $targetTag);return 1;}#------------------------------------------------------------------------------sub installAllDpkgArchiveScriptsFiles## Description:# This sub-routine is used to install all scripts files from the# dpkg_archive into the defined install area.## It assumes based on the build type where the src files will be located.## If it has any problems it will log an error and stop processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 1 ){LogError("Incorrect number of params passed to " ."installAllDpkgArchiveScriptsFiles() function. " ."Check deploy config.");}my ($targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installAllDpkgArchiveFiles("scripts", $targetTag);return 1;}#------------------------------------------------------------------------------sub installAllDpkgArchiveIncludeFiles## Description:# This sub-routine is used to install all include files from the# dpkg_archive into the defined install area.## It assumes based on the build type where the src files will be located.## If it has any problems it will log an error and stop processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 1 ){LogError("Incorrect number of params passed to " ."installAllDpkgArchiveIncludeFiles() function. " ."Check deploy config.");}my ($targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installAllDpkgArchiveFiles("include", $targetTag);return 1;}#------------------------------------------------------------------------------sub installAllDpkgArchiveDocFiles## Description:# This sub-routine is used to install all include files from the# dpkg_archive into the defined install area.## It assumes based on the build type where the src files will be located.## If it has any problems it will log an error and stop processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 1 ){LogError("Incorrect number of params passed to " ."installAllDpkgArchiveIncludeFiles() function. " ."Check deploy config.");}my ($targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installAllDpkgArchiveFiles("doc", $targetTag);return 1;}#------------------------------------------------------------------------------sub installAllDpkgArchiveJspFiles## Description:# This sub-routine is used to install all jsp associated files from the# dpkg_archive into the defined install area.## It assumes based on the build type where the src files will be located.## If it has any problems it will log an error and stop processing.## Source directory: $DpkgJspDir# Target directory: $TargetBaseDir##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 0 ){LogError("Incorrect number of params passed to " ."installAllDpkgArchiveJspFiles() function. " ."Check deploy config.");}return installAllDpkgArchiveFiles ('jsp', '--NoTag');}#------------------------------------------------------------------------------sub installDpkgArchiveFile## Description:# This sub-routine is used to install a file of a particular type# from the dpkg_archive into the supplied install dir.## It assumes based on the build type where the file will be located.## If it fails to find the file it will report an error and terminates# processing.## Inputs: $targetType - Type of target ( provides source directory)# $sfile - Source file name, within source directory# $targetTag - Symbolic target dir### Note: This function will copy a single file##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 3 ){LogError("Incorrect number of params passed to " ."installDpkgArchiveFile() function. " ."Check deploy config.");}my ($targetType, $sfile, $targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# lets define the absolute location of the file#my ($m_dstFileLocation) = "$targetValue/$sfile";my ($m_srcFileLocation) = "";if ( "$targetType" eq "jar" ) { $m_srcFileLocation = "$DpkgJarDir/$sfile"; }elsif ( "$targetType" eq "sar" ) { $m_srcFileLocation = "$DpkgSarDir/$sfile"; }elsif ( "$targetType" eq "include" ) { $m_srcFileLocation = "$DpkgIncludeDir/$sfile"; }elsif ( "$targetType" eq "war" ) { $m_srcFileLocation = "$DpkgWarDir/$sfile"; }elsif ( "$targetType" eq "infofiles" ) { $m_srcFileLocation = "$DpkgInfoFilesDir/$sfile"; }elsif ( "$targetType" eq "sql" ) { $m_srcFileLocation = "$DpkgSqlDir/$sfile"; }elsif ( "$targetType" eq "etc" ) { $m_srcFileLocation = "$DpkgEtcDir/$sfile"; }elsif ( "$targetType" eq "scripts" ) { $m_srcFileLocation = "$DpkgScriptsDir/$sfile"; }elsif ( "$targetType" eq "rox" ) { $m_srcFileLocation = "$DpkgRoxDir/$sfile"; }elsif ( "$targetType" eq "dat" ) { $m_srcFileLocation = "$DpkgDatDir/$sfile"; }elsif ( "$targetType" eq "thx" ) { $m_srcFileLocation = "$DpkgThxDir/$sfile"; }elsif ( "$targetType" eq "mug" ) { $m_srcFileLocation = "$DpkgMugDir/$sfile"; }elsif ( "$targetType" eq "rpt" ) { $m_srcFileLocation = "$DpkgRptDir/$sfile"; }elsif ( "$targetType" eq "doc" ) { $m_srcFileLocation = "$DpkgDocDir/$sfile"; }else {LogError("installDpkgArchiveFile() passed unknown target type [$targetType].");}# we will check to see if the file exists.#if ( -f "$m_srcFileLocation" ){# now we need to copy the file.if(File::Copy::copy("$m_srcFileLocation", "$m_dstFileLocation")){LogNorm("Copied [$targetType] item [$sfile] to [$m_dstFileLocation] ...");}else{LogError("Failed to copy [$targetType] item [$sfile]: $!");}}else{LogError("Dpkg_archive [$targetType] item [$sfile] does not exist.");}return 1;}#------------------------------------------------------------------------------sub installDpkgArchiveAcHtmlFile## Description:# This sub-routine is used to install a achtml file from the# dpkg_archive into the supplied install dir.## It assumes based on the build type where the file will be located.## If it fails to find the file it will report an error and terminates# processing.## Ugly trick:# This function tags a $$targetType argument which is used in constructing# the source directory path. ie: InterfaceDir/achtml/$targetType## Could provide as an option to installDpkgArchiveFile and re-use that# function#------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 3 ){LogError("Incorrect number of params passed to " ."installDpkgArchiveAcHtmlFile() function. " ."Check deploy config.");}my ($targetType, $sfile, $targetTag) = @_;# lets check to see if the source type and file actually exist#my($m_sDirLoc) = "$DpkgAcHtmlDir/$targetType";if( ! -d "$m_sDirLoc" ){LogError("Failed to locate [$targetType] AcHtml dir [$m_sDirLoc].");}# lets check to see if the file exists#my($m_sFileLoc) = "$DpkgAcHtmlDir/$targetType/$sfile";if( ! -f "$m_sFileLoc" ){LogError("Failed to locate [$targetType] AcHtml file [$m_sFileLoc].");}# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# know everything exists so lets do the biz.## now we need to copy the file.if(File::Copy::copy("$m_sFileLoc", "$targetValue")){LogNorm("Copied [$targetType] AcHtml item [$sfile] to [$targetValue] ...");}else{LogError("Failed to copy [$targetType] AcHtml item [$sfile]: $!");}return 1;}#------------------------------------------------------------------------------sub installDpkgArchiveRptFile## Description:# This sub-routine is used to install a rpt file from the# dpkg_archive into the supplied install dir.## It assumes based on the build type where the file will be located.## If it fails to find the file it will report an error and terminates# processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."installDpkgArchiveRptFile() function. " ."Check deploy config.");}my ($sfile, $targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installDpkgArchiveFile("rpt", $sfile, $targetTag);return 1;}#------------------------------------------------------------------------------sub installDpkgArchiveRoxFile## Description:# This sub-routine is used to install a rox file from the# dpkg_archive into the supplied install dir.## It assumes based on the build type where the file will be located.## If it fails to find the file it will report an error and terminates# processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."installDpkgArchiveRoxFile() function. " ."Check deploy config.");}my ($sfile, $targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installDpkgArchiveFile("rox", $sfile, $targetTag);return 1;}#------------------------------------------------------------------------------sub installDpkgArchiveDatFile## Description:# This sub-routine is used to install a dat file from the# dpkg_archive into the supplied install dir.## It assumes based on the build type where the file will be located.## If it fails to find the file it will report an error and terminates# processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."installDpkgArchiveDatFile() function. " ."Check deploy config.");}my ($sfile, $targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installDpkgArchiveFile("dat", $sfile, $targetTag);return 1;}#------------------------------------------------------------------------------sub installDpkgArchiveThxFile## Description:# This sub-routine is used to install a thx file from the# dpkg_archive into the supplied install dir.## It assumes based on the build type where the file will be located.## If it fails to find the file it will report an error and terminates# processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."installDpkgArchiveThxFile() function. " ."Check deploy config.");}my ($sfile, $targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installDpkgArchiveFile("thx", $sfile, $targetTag);return 1;}#------------------------------------------------------------------------------sub installDpkgArchiveMugFile## Description:# This sub-routine is used to install a mug file from the# dpkg_archive into the supplied install dir.## It assumes based on the build type where the file will be located.## If it fails to find the file it will report an error and terminates# processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."installDpkgArchiveMugFile() function. " ."Check deploy config.");}my ($sfile, $targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installDpkgArchiveFile("mug", $sfile, $targetTag);return 1;}#------------------------------------------------------------------------------sub installDpkgArchiveInfoFilesFile## Description:# This sub-routine is used to install a infofiles file from the# dpkg_archive into the supplied install dir.## It assumes based on the build type where the file will be located.## If it fails to find the file it will report an error and terminates# processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."installDpkgArchiveInfoFilesFile() function. " ."Check deploy config.");}my ($sfile, $targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installDpkgArchiveFile("infofiles", $sfile, $targetTag);return 1;}#------------------------------------------------------------------------------sub installDpkgArchiveSqlFile## Description:# This sub-routine is used to install a sql file from the# dpkg_archive into the supplied install dir.## It assumes based on the build type where the file will be located.## If it fails to find the file it will report an error and terminates# processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."installDpkgArchiveSqlFile() function. " ."Check deploy config.");}my ($sfile, $targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installDpkgArchiveFile("sql", $sfile, $targetTag);return 1;}#------------------------------------------------------------------------------sub installDpkgArchiveWarFile## Description:# This sub-routine is used to install a war file from the# dpkg_archive into the supplied install dir.## It assumes based on the build type where the file will be located.## If it fails to find the file it will report an error and terminates# processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."installDpkgArchiveWarFile() function. " ."Check deploy config.");}my ($sfile, $targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installDpkgArchiveFile("war", $sfile, $targetTag);return 1;}#------------------------------------------------------------------------------sub installDpkgArchiveJarFile## Description:# This sub-routine is used to install a jar file from the# dpkg_archive into the supplied install dir.## It assumes based on the build type where the file will be located.## If it fails to find the file it will report an error and terminates# processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."installDpkgArchiveJarFile() function. " ."Check deploy config.");}my ($sfile, $targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installDpkgArchiveFile("jar", $sfile, $targetTag);return 1;}#------------------------------------------------------------------------------sub installDpkgArchiveSarFile## Description:# This sub-routine is used to install a sar file from the# dpkg_archive into the supplied install dir.## It assumes based on the build type where the file will be located.## If it fails to find the file it will report an error and terminates# processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."installDpkgArchiveSarFile() function. " ."Check deploy config.");}my ($sfile, $targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installDpkgArchiveFile("sar", $sfile, $targetTag);return 1;}#------------------------------------------------------------------------------sub installDpkgArchiveEtcFile## Description:# This sub-routine is used to install an etc file from the# dpkg_archive into the supplied install dir.## It assumes based on the build type where the file will be located.## If it fails to find the file it will report an error and terminates# processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."installDpkgArchiveEtcFile() function. " ."Check deploy config.");}my ($sfile, $targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installDpkgArchiveFile("etc", $sfile, $targetTag);return 1;}#------------------------------------------------------------------------------sub installDpkgArchiveScriptsFile## Description:# This sub-routine is used to install a scripts file from the# dpkg_archive into the supplied install dir.## It assumes based on the build type where the file will be located.## If it fails to find the file it will report an error and terminates# processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."installDpkgArchiveScriptsFile() function. " ."Check deploy config.");}my ($sfile, $targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installDpkgArchiveFile("scripts", $sfile, $targetTag);return 1;}#------------------------------------------------------------------------------sub installDpkgArchiveIncludeFile## Description:# This sub-routine is used to install a include file from the# dpkg_archive into the supplied install dir.## It assumes based on the build type where the file will be located.## If it fails to find the file it will report an error and terminates# processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."installDpkgArchiveIncludeFile() function. " ."Check deploy config.");}my ($sfile, $targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installDpkgArchiveFile("include", $sfile, $targetTag);return 1;}#------------------------------------------------------------------------------sub installDpkgArchiveDocFile## Description:# This sub-routine is used to install a include file from the# dpkg_archive into the supplied install dir.## It assumes based on the build type where the file will be located.## If it fails to find the file it will report an error and terminates# processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."installDpkgArchiveDocFile() function. " ."Check deploy config.");}my ($sfile, $targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# for now lets call the generic funtion to move all items# in the associated dpkg_archive dir.#installDpkgArchiveFile("doc", $sfile, $targetTag);return 1;}#------------------------------------------------------------------------------sub installDpkgArchiveBinFile## Description:# This sub-routine is used to install a binary file from the# dpkg_archive into the supplied install dir.## It assumes based on the build type where the file will be located.## If it fails to find the file it will report an error and terminates# processing.## Inputs : $sfile - Name of source file# or a reference to a list of files# $targetTag - Symbolic name of target# Options - Optional options## Options:# --SelectFrom=xxxx - Limits foile source selection# By default all LIB sources are searched.# The selector should be a Platform, Product# ,Target or MachineType### Returns : Nothing of use# Will not return if the file is not found##------------------------------------------------------------------------------{my @args;my $select = '_ALL_';## Process parameters and extract options#foreach ( @_ ){if ( m/^--SelectFrom=(.*)/ ) {$select = $1;LogError("installDpkgArchiveBinFile: Selector not known: $_")unless ( defined $DpkgLibDirList{$select} );} elsif ( m/^--/ ) {LogError('-x', "installDpkgArchiveBinFile: Unknown option ignored: $_")} else {push @args, $_;}}# correct number of parameters?my ($fref, $targetTag) = @_;if ( $#args != 1 ){LogError("Incorrect number of params passed to " ."installDpkgArchiveBinFile() function. " ."Check deploy config.");}# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");## Process the file name# This will either be a scalar name, or a reference to an array of names# If the user has provided an array of names then expand the list## Convert $fref into an reference to a list#my @one_file;unless ( ref ( $fref ) eq 'ARRAY' ){push @one_file, $fref;$fref = \@one_file;}foreach my $sfile ( @$fref ){if ( "$MachType" eq "win32" ){# if the item does not have an .exe extention# we shall add one for convience.#if ( $sfile !~ m/\.exe$/ &&$sfile !~ m/\.dll$/ ){$sfile = $sfile . ".exe";}}my ($i);my ($foundFileFlag) = "false";my ($m_DpkgBinDir) = "";my ($m_srcFileLocation) = "";my ($m_dstFileLocation) = "";foreach $i (@{$DpkgBinDirList{$select}}){$m_DpkgBinDir = "$DpkgBinDir" . "/$i";if ( ! -d "$m_DpkgBinDir" ){LogDebug("Directory [$m_DpkgBinDir] not found.");next;}# lets define the absolute location of the file$m_srcFileLocation = "$m_DpkgBinDir/$sfile";$m_dstFileLocation = "$targetValue/$sfile";# we will check to see if the file exists.#if ( -f "$m_srcFileLocation" ){# now we need to copy the file.if(File::Copy::copy("$m_srcFileLocation", "$m_dstFileLocation")){LogNorm("Copied Bin [$sfile] to [$m_dstFileLocation] ...");$foundFileFlag = "true";# no need to go further, we have found the file.#last;}else{LogError("Failed to copy binary [$sfile]: $!");}}# else we have not found the file yet!}# if we do not find the file at all we need to inform# the user.#if ( "$foundFileFlag" eq "false" ){LogError("Dpkg_archive bin file [$sfile] does not exist or is not in correct directory structure.");}}return 1;}#------------------------------------------------------------------------------sub installDpkgArchiveLibFile## Description:# This sub-routine is used to install a binary file from the# dpkg_archive into the supplied install location dir.## It assumes based on the build type where the file will be located.## If it fails to find the file it will report an error and terminates# processing.## Added optional 3rd parameter & if set to NoLinks then no generic named# libs will be created## Inputs : $sfile - Name of source file# or a reference to a list of files# $targetTag - Symbolic name of target# $links - Optional. 'nolinks' will supress generic named libs# Options - Optional options## Options:# --NoLink - same as 3rd arg == noloiks# --Link - Default# --SelectFrom=xxxx - Limits foile source selection# By default all LIB sources are searched.# The selector should be a Platform, Product# ,Target or MachineType### Returns : Nothing of use# Will not return if the file is not found##------------------------------------------------------------------------------{my @args;my $links = 1;my $select = '_ALL_';## Process parameters and extract options#foreach ( @_ ){if ( m/^--NoLink/ ) {$links = 0;} elsif ( m/^--Link/ ) {$links = 1;} elsif ( m/^--SelectFrom=(.*)/ ) {$select = $1;LogError("installDpkgArchiveLibFile: Selector not known: $_")unless ( defined $DpkgLibDirList{$select} );} elsif ( m/^--/ ) {LogError('-x', "installDpkgArchiveLibFile: Unknown option ignored: $_")} else {push @args, $_;}}## Handle the optional 3rd argument#if ( $args[2] ){$links = $args[2] !~ m/nolink/i;delete $args[2];}# correct number of parameters?my ($fref, $targetTag) = @_;if ( $#args != 1 ){LogError("Incorrect number of params passed to " ."installDpkgArchiveLibFile() function. " ."Check deploy config.");}## Check to see if the target tag exists# If does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");## Process the file name# This will either be a scalar name, or a reference to an array of names# If the user has provided an array of names then expand the list## Convert $fref into an reference to a list#my @one_file;unless ( ref ( $fref ) eq 'ARRAY' ){push @one_file, $fref;$fref = \@one_file;}foreach my $sfile ( @$fref ){# we exclude .dll files if this is a sparc build#if ( "$MachType" eq "sparc" &&$sfile =~ m/\.dll/){LogInfo("Excluding item [$sfile] from build, as we do not deliver dlls for this machine type [$MachType].");return 1;}# we exclude .so files if this is a win32 build#if ( "$MachType" eq "win32" &&$sfile =~ m/\.so/){LogInfo("Excluding item [$sfile] from build, as we do not deliver sosss for this machine type [$MachType].");return 1;}my ($libName) = $sfile;if ( "$MachType" eq "sparc" ){$libName =~ s/\.so.*$//;}# lets define the absolute location of the filemy ($m_srcFileLocation) = "";my ($m_dstFileLocation) = "";my ($m_DpkgLibDir) = "";my ($i);my ($j);my ($count);my ($foundFileFlag) = "false";my ($ExcludedFlag) = "false";## Search all the 'lib' locations, or a specified subset#foreach $i (@{$DpkgLibDirList{$select}}){$m_DpkgLibDir = "$DpkgLibDir" . "/$i";if ( ! -d "$m_DpkgLibDir" ){LogDebug("Directory [$m_DpkgLibDir] not found.");next;}$m_srcFileLocation = "$m_DpkgLibDir/$sfile";$m_dstFileLocation = "$targetValue/$sfile";# we only want debug items in a debug build#if(excludeItemFromBuild($sfile)){LogInfo("Excluding item [$sfile] from build as not compatible with build type [$BuildType].");$ExcludedFlag = "true";}else{# we need to ensure that only a single version/entry of the lib exists in the lib list#$count = 1;foreach $j (@LibCheckList){if ( $j =~ m/^$libName$/ ){$count++;}if ( $count > 1 ){LogError("Detected multiple references of lib [$libName] in lib list, check item [$sfile].");}}# we will check to see if the file exists.#if ( -f "$m_srcFileLocation" ){# now we need to copy the file.# we also want to create a generically named copy# of the library#my ($gName) = $sfile;my ($nVerName) = $sfile;$gName = removeBuildTypeFromItemName($sfile);$gName = removeVersionNumberFromItemName($gName);$nVerName = removeVersionNumberFromItemName($sfile);if(File::Copy::copy("$m_srcFileLocation", "$m_dstFileLocation")){LogNorm("Copied Lib [$sfile] to [$m_dstFileLocation] ...");$foundFileFlag = "true";if ( $links && ( "x$PkgPatchID" eq "x" || "$MachType" eq "win32") ){# normal build or if we are building win32 we want generic names# we want to create a copy of our target using# the generic nameif ( $sfile ne $nVerName ){createGenericCopy("$sfile", "$m_srcFileLocation", "$nVerName", "$targetValue");}if ( $sfile ne $gName ){createGenericCopy("$sfile", "$m_srcFileLocation", "$gName", "$targetValue");}}# lets add this lib to our check list for next time.#push @LibCheckList, $libName;# no need to go further, implies we found the file!#last;}else{# here found the file but we had some trouble#LogError("Failed to copy lib [$m_srcFileLocation]: $!");}}# else have not found the file yet!}}# if we do not find the file at all we need to inform# the user.#if ( "$foundFileFlag" eq "false" && $ExcludedFlag eq "false" ){LogError("Dpkg_archive lib file [$sfile] does not exist or is not in correct directory structure.");}}return 1;}#------------------------------------------------------------------------------sub installPkgAddConfigFile## Description:# This sub-routine is used to install a package config file from a supplied# source location to a predefined destination location that is based on# the build type.## The sub routine also updates to the prototype file with an appropriate# entry for the associated file.## If it has any problems it will log an error and stop processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 3 ){LogError("Incorrect number of params passed to " ."installPkgAddConfigFile() function. " ."Check deploy config.");}# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "sparc" ){LogInfo("installPkgAddConfigFile() not supported on this machine type.");return 1;}my ($sDirTag, $sfile, $tfile) = @_;# we must have a filename.#if ( "x$sfile" eq "x" ){LogError("Source filename not supplied. Check deploy config.");}# lets check to see if the local src dir tag exists# if does not the process with log an error.#my ($sDirValue) = getLocalDirValue("$sDirTag", "A");# lets check to see if the source file exists#if ( ! -f "$sDirValue/$sfile" ){LogError("Failed to find local source file [$sDirValue/$sfile].");}if ( ! -f "$ProtoTypeFile" ){LogError("Prototype file [$ProtoTypeFile] does not exist. " ."Ensure createPrototypeFile() function has been called before executing installPkgAddConfigFile() function. " ."Check deploy config.");}# lets determine which prototype file we are going to# usemy ($dFileName);$dFileName = "$PkgBaseDir/$sfile";# lets copy the file#if(File::Copy::copy("$sDirValue/$sfile", "$dFileName")){LogNorm("Copied [$sfile] to [$dFileName] ...");}else{LogError("Failed to copy local source file [$sDirValue/$sfile]: $!");}# now we need to update the prototype file#local *FILE;open ( FILE, ">> $ProtoTypeFile") orLogError("Failed to open file [$ProtoTypeFile].");printf FILE ("i $tfile=$sfile\n");close (FILE);return 1;}#------------------------------------------------------------------------------sub installPkgAddSystemClassFile## Description:# This sub-routine is used to install a package system class file from a supplied# source location to a predefined destination location the class type is also# supplied and must be sed, awk, build or preserve## The sub routine also updates to the prototype file with an appropriate# entry for the associated file.## If it has any problems it will log an error and stop processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 4 ){LogError("Incorrect number of params passed to " ."installPkgAddConfigFile() function. " ."Check deploy config.");}# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "sparc" ){LogInfo("installPkgAddConfigFile() not supported on this machine type.");return 1;}my ($sDirTag, $sfile, $tfile, $class) = @_;if ( $class ne "sed" && $class ne "build" && $class ne "awk" && $class ne "preserve" ){LogError("Class Name for System Class File can only be one of sed, build, awk or preserve");}# we must have a filename.#if ( "x$sfile" eq "x" ){LogError("Source filename not supplied. Check deploy config.");}# lets check to see if the local src dir tag exists# if does not the process with log an error.#my ($sDirValue) = getLocalDirValue("$sDirTag", "A");# lets check to see if the source file exists#if ( ! -f "$sDirValue/$sfile" ){LogError("Failed to find local source file [$sDirValue/$sfile].");}if ( ! -f "$ProtoTypeFile" ){LogError("Prototype file [$ProtoTypeFile] does not exist. " ."Ensure createPrototypeFile() function has been called before executing installPkgAddConfigFile() function. " ."Check deploy config.");}# lets determine which prototype file we are going to# usemy ($dFileName);$dFileName = "$PkgBaseDir/$sfile";# lets copy the file#if(File::Copy::copy("$sDirValue/$sfile", "$dFileName")){LogNorm("Copied [$sfile] to [$dFileName] ...");}else{LogError("Failed to copy local source file [$sDirValue/$sfile]: $!");}# now we need to update the prototype file#local *FILE;open ( FILE, ">> $ProtoTypeFile") orLogError("Failed to open file [$ProtoTypeFile].");printf FILE ("e $class $tfile=$sfile ? ? ?\n");close (FILE);return 1;}#------------------------------------------------------------------------------sub updatePrototypeFileAddItem## Description:# This sub-routine is used to update the prototype file with an# extra package add item. Here we pre-pend the ERGAFC_BASEDIR to the# destination item.## The only item type we support at this stage are "s" and "f" types.## You also need to supply the source tag, destination tag, user id, group id# and permissions associated to this item.## If it has any problems it will log an error and stop processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 6 ){LogError("Incorrect number of params passed to " ."updatePrototypeFileAddItem() function. " ."Check deploy config.");}# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "sparc" ){LogInfo("updatePrototypeFileAddItem() not supported on this machine type.");return 1;}my ($sTag, $dTag, $perms, $uid, $gid, $type) = @_;# lets determine which prototype file we are going to# usemy ($protoTypeFile);$protoTypeFile = "$ProtoTypeFile";# lets check the valid types$type = uc($type);if ( "$type" !~ /S/ ){LogError("Invalid type field supplied in updatePrototypeFileAddItem(). Check deploy config.");}# now we need to update the prototype file#local *FILE;open ( FILE, ">> $protoTypeFile") orLogError("Failed to open file [$protoTypeFile].");my($m_Str)="";if ( "$type" eq "S" ){$m_Str = "s none $sTag=$ERGAFC_BASEDIR/$dTag $perms $uid $gid";LogNorm("Updated prototype file with entry [$m_Str]");}else{$m_Str = "f none $sTag=$ERGAFC_BASEDIR/$dTag $perms $uid $gid";LogNorm("Updated prototype file with entry [$m_Str]");}printf FILE ("$m_Str\n");close (FILE);return 1;}#------------------------------------------------------------------------------sub updatePrototypeFileAddItem2## Description:# This sub-routine is used to update the prototype file with an# extra package add item. Here we do not pre-append the# ERGAFC_BASEDIR to the destination item.## The only item type we support at this stage are "s", "i" and "e" types.## You also need to supply the source tag, destination tag, user id, group id# and permissions associated to this item.## If it has any problems it will log an error and stop processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 6 && ($#_+1) != 7 ){LogError("Incorrect number of params passed to " ."updatePrototypeFileAddItem2() function. " ."Check deploy config.");}# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "sparc" ){LogInfo("updatePrototypeFileAddItem2() not supported on this machine type.");return 1;}# class must be last as it is optionalmy ($sTag, $dTag, $perms, $uid, $gid, $type, $class) = @_;$class = "none" if ( ($#_+1) == 6 );# lets determine which prototype file we are going to# usemy ($protoTypeFile);$protoTypeFile = "$ProtoTypeFile";# lets check the valid types$type = uc($type);if ( "$type" !~ /S/ && "$type" !~ /I/ && "$type" !~ /E/ ){LogError("Invalid type field supplied in updatePrototypeFileAddItem2(). Check deploy config.");}# now we need to update the prototype file#local *FILE;open ( FILE, ">> $protoTypeFile") orLogError("Failed to open file [$protoTypeFile].");my($m_Str)="";if ( "$type" eq "S" ){$m_Str = "s $class $sTag=$dTag $perms $uid $gid";LogNorm("Updated prototype file with entry [$m_Str]");}elsif ( "$type" eq "E" ){$m_Str = "e $class $sTag=$dTag $perms $uid $gid";LogNorm("Updated prototype file with entry [$m_Str]");}else{$m_Str = "i $sTag=$dTag";LogNorm("Updated prototype file with entry [$m_Str]");}printf FILE ("$m_Str\n");close (FILE);return 1;}#------------------------------------------------------------------------------sub addPath2Prototype## Description:# This sub-routine is used to add directory entries to the prototype file# to make sure the supplied path exists in the prototype file##------------------------------------------------------------------------------{# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "sparc" ){LogInfo("addPath2Prototype() not supported on this machine type.");return 1;}# class must be last as it is optionalmy ($path, $perms, $uid, $gid, $class) = @_;# set defaults if not supplied$perms = "?" if ( ($#_+1) < 2 );$uid = "?" if ( ($#_+1) < 3 );$gid = "?" if ( ($#_+1) < 4 );$class = "none" if ( ($#_+1) < 5 );LogNorm("addPathToPrototype adding path [$path $perms $uid $gid $class]");# lets determine which prototype file we are going to# usemy ($protoTypeFile);$protoTypeFile = "$ProtoTypeFile";# now we need to update the prototype file#local *FILE;open ( FILE, "+<$protoTypeFile") or LogError("Failed to open file [$protoTypeFile].");# set up has of all paths to be addedmy ( %pathDirs );my ( $workPath );my ( $i );$workPath = "/" if ( $path =~ s|^/|| );foreach $i ( split("/" , $path) ){$workPath .= $i;$pathDirs{$workPath} = 1;$workPath .= "/";}while ( <FILE> ){# lets get all the current dir entries and check for duplicates# class path mode owner groupif ( /^d ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*)/ ){# if this dir entry is defined in our paths to add we need to remove the entryif ( defined($pathDirs{$2}) ){LogWarn("addPath2Prototype: Path [$2] already exists in prototype file");delete($pathDirs{$2});}}}my $protoLine;# now we write the remaining dirs in the hashforeach $i ( sort keys(%pathDirs) ){$protoLine = sprintf("d %s %s %s %s %s", $class, $i, $perms, $uid, $gid);LogInfo("addPath2Prototype: Adding Dir entry [$protoLine]");printf FILE "$protoLine\n";}close FILE;return 1;}#------------------------------------------------------------------------------sub createAfcRcScriptLink## Description:# This sub-routine is used to create links into /afc/rc.d for start & stop# scripts.## INPUT:# Start prefix number (2 digit number)# Stop prefix Number (2 digit Number)# Full path to script to create link to.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 3 ){LogError("Incorrect number of params passed to " ."createAfcRcScriptLink() function. " ."Check deploy config.");}# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "sparc" ){LogInfo("createAfcRcScriptLink() not supported on this machine type.");return 1;}my ($startPrefix, $stopPrefix, $scriptPath) = @_;if ( $startPrefix ne "" ){updatePrototypeFileAddItem2(sprintf("/afc/rc.d/S%02d%s", $startPrefix, $PkgName),$scriptPath, "0755", "root", "other", "S");}if ( $stopPrefix ne "" ){updatePrototypeFileAddItem2(sprintf("/afc/rc.d/K%02d%s", $stopPrefix, $PkgName),$scriptPath, "0755", "root", "other", "S");}}#------------------------------------------------------------------------------sub createAfcRcScriptLink2## Description:# This sub-routine is used to create links into the afc rc.d for start & stop# scripts. It differs from the original in that you pass a TargetDirType# parameter and the filename instead of a full path. It then creates a relative# link from $BASEDIR/rc.d to TargetBaseDir## INPUT:# Start prefix number (2 digit number)# Stop prefix Number (2 digit Number)# Full path to script to create link to.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 4 ){LogError("Incorrect number of params passed to " ."createAfcRcScriptLink() function. " ."Check deploy config.");}# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "sparc" ){LogInfo("createAfcRcScriptLink() not supported on this machine type.");return 1;}my ($startPrefix, $stopPrefix, $targetTag, $scriptPath) = @_;# lets check to see if the target tag exists if does not the process with log an error.my ($targetValue) = getTargetDstDirValue($targetTag, "R");if ( $startPrefix ne "" ){updatePrototypeFileAddItem2(sprintf("rc.d/S%02d%s", $startPrefix, $PkgName),"../$targetValue/$scriptPath", "0755", "root", "other", "S");}if ( $stopPrefix ne "" ){updatePrototypeFileAddItem2(sprintf("rc.d/K%02d%s", $stopPrefix, $PkgName),"../$targetValue/$scriptPath", "0755", "root", "other", "S");}}#------------------------------------------------------------------------------sub createGenericCopy## Description:# This sub-routine is used to create a generic copy of a specific item.## On sparc this will be a link, but on win32 it will be a file based on the# buildType.## INPUT:# src item name# generic item name# target dir## RETURN:# 1##------------------------------------------------------------------------------{my ($sName, $sLoc, $gName, $tDir) = @_;my ($cmd);my ($retVal);if ( "$MachType" eq "sparc" ){# I want to cd into the tDir and then create the link.# only if an item of the same name does not already exist#if ( ! -f "$tDir/$gName" ){$cmd = "cd $tDir; ln -s $sName $gName";$retVal = system("$cmd");if ( $retVal != 0 ){LogError("Failed to create generic link [$gName] to [$tDir/$sName]: $retVal");}else{LogNorm("Created generic link [$gName] to [$tDir/$sName] ...");}}}else{# we only create a generic copy of the an item that matches# our build type. (i.e. if we are building a debug package then# only the debug items shall be considered.#if ( "$BuildType" eq "D" ){if ( $sName !~ /D\./ ){# this item is not a debug one.return 1;}}else{# this is prod buildif ( $sName !~ /P\./ ){# this item is not a prod one.return 1;}}# we have a match, lets create the copy.#if(File::Copy::copy("$sLoc", "$tDir/$gName")){LogNorm("Created generic lib copy [$tDir/$gName]...");}else{LogError("Failed to create generic lib copy [$gName] from [$sLoc]: $!");}}return 1;}#------------------------------------------------------------------------------sub removeVersionNumberFromItemName## Description:# This sub-routine is used to remove the version number from the item name.# i.e. myFile.so.1.2.3 ==> myFile.so## INPUT:# item name## RETURN:# new item name.##------------------------------------------------------------------------------{my ($file) = @_;my ($nfile) = $file;if ( "$MachType" eq "sparc" ){$nfile =~ s/\.so.*$/\.so/;}else{$nfile =~ s/\.[0-9]+\.[0-9]+.*dll$/\.dll/;}return "$nfile";}#------------------------------------------------------------------------------sub excludeItemFromBuild## Description:# This sub-routine is used to determine is a item is to be included in# a build based on the current build type and the extension# it SHOULD HAVE!.## i.e. debug files will be tagged with *D.*# prod file will be tagged with *P.*## if the item does not have a *D.* or a *P.* we included it by default.## INPUT:# filename## RETURN:# 1 - exclude# 0 - include##------------------------------------------------------------------------------{my ($file) = @_;# we only want to deliverif ( "$MachType" eq "win32" ){# we have to include it by default.return 0;}###################################################################################################################################################################### Third party packages do not adhere to the *D.* *P.*# conventions of debug and production builds.## Hopefully we won't have to many of these, only found# one so far.######################################################################################################################################################################if ( $file =~ /libTAO_BiDirGIOP\.so/ ){return 0;}if ( $file !~ /D\./ &&$file !~ /P\./){# we have to include it by default.return 0;}# we only want to deliverif ( "$BuildType" eq "D" ){if ( $file !~ /D\./ ){# we do not want this file for this build type.return 1;}else{return 0;}}else{if ( $file !~ /P\./ ){# we do not want this file for this build type.return 1;}else{return 0;}}return 1;}#------------------------------------------------------------------------------sub installAllDpkgArchiveBinFiles## Description:# This sub-routine is used to install all bin files from the# dpkg_archive into the defined install area.## It assumes based on the build type where the src files will be located.## If it has any problems it will log an error and stop processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 1 ){LogError("Incorrect number of params passed to " ."installAllDpkgArchiveBinFiles() function. " ."Check deploy config.");}my ($targetTag) = @_;# lets check to see if the target tag exists# if does not the process with log an error.#my ($targetValue) = getTargetDstDirValue($targetTag, "A");# ok we have a valid dst value we now need to get a hold of all the# lib files for this buildtype#my ($i);my ($m_DpkgBinDir);foreach $i (@{$DpkgBinDirList{'_ALL_'}}){$m_DpkgBinDir = "$DpkgBinDir" . "/$i";if ( ! -d "$m_DpkgBinDir" ){LogInfo("Directory [$m_DpkgBinDir] not found.");next;}local *DIR;opendir(DIR, $m_DpkgBinDir) orLogError("can't opendir $m_DpkgBinDir : $!");my ($file);while (defined($file = readdir(DIR))){if ( $file !~ /^\.$/ && # we do not want the . and .. entries.$file !~ /^\.\.$/ &&$file !~ /\.pdb$/ ){my ($m_fLoc) = "$m_DpkgBinDir/$file";if(File::Copy::copy("$m_fLoc", "$targetValue")){LogNorm("Copied [$file] to [$targetValue] ...");}else{LogError("Failed to copy bin [$m_fLoc]: $!");}}}closedir(DIR);}return 1;}#------------------------------------------------------------------------------sub rmDirectory## Description:# This sub-routine is used to remove an entire directory tree.## It recurses from a starting point removing each item and if it# finds a dir it recurses into that dir cleaning it as well.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 1 ){LogError("Incorrect number of params passed to rmDirectory() function.");}my ($startingPoint) = @_;LogInfo("Recursively removing Directory tree [$startingPoint]");foreach my $item ( glob("$startingPoint/*"), glob("$startingPoint/.*") ){if ( $item !~ /^$startingPoint\/\.$/ && $item !~ /^$startingPoint\/\.\.$/ ){if ( -d "$item" ){rmDirectory("$item");}else{unlink("$item");LogDebug("Removed file [$item].");}}}# lets clean the starting point.#my($base)= File::Basename::basename($startingPoint);if ( "$base" ne "." && "$base" ne ".." ){my $retVal = rmdir("$startingPoint");if( $retVal ){LogDebug("Removed dir [$startingPoint].");}else{LogError("Failed to remove dir [$startingPoint] : $!");}}return 1;}#------------------------------------------------------------------------------sub CreateDirectory## Description# Create a directory tree based on the path specified. It creates the tree# rooted at the root path specified. This path must exist## The first parameter is the root path to root the tree at (optional).# The second parameter is the tree to create.# The third parameter is the umask to create the path with#------------------------------------------------------------------------------{if ( ($#_+1) != 3 ){LogError("Incorrect number of params passed to CreateDirectory() function.");}my ( $rootPath, $dirPath, $umask ) = @_;# remove trailing slash from rootPath$rootPath =~ s|/$||;# remove leading slash from dirPath$dirPath =~ s|^/||;if ( ! -d $rootPath ){LogError("CreateDirectory: RootPath [$rootPath] does not exist");}LogNorm("CreateDirectory: Creating path [$dirPath] in [$rootPath]");my @dirs = split("/", $dirPath);foreach my $i ( @dirs ){$rootPath .= "/$i";if ( ! -d $rootPath ){LogDebug("CreateDirectory: Creating [$rootPath]");mkdir($rootPath, $umask);}}} # CreateDirectory#------------------------------------------------------------------------------sub CreateTargetDirStructure## Description:# This sub-routine create the target stucture based on what the user has# previously defined in the %TargetDstDirStructure hash array## It will also clean the contents of this location prior to creation.## In this function we also check to see if all the LocalSrcDirStructure# directories exist. We warn if they do not.##------------------------------------------------------------------------------{LogNorm("Cleaning any previous target file items...");my ($i);my ($m_dirD);# lets clean.#foreach $i ( sort {$b cmp $a} values %TargetDstDirStructure ){if ( "$i" !~ /^\.$/ &&"$i" !~ /^\.\.$/ ){$m_dirD = "$PkgBaseDir/$TargetBaseDir/$i";if ( -d "$m_dirD" ){rmDirectory("$m_dirD");}}}$m_dirD = "$PkgPatchTmpDir";if ( -d "$m_dirD" ){rmDirectory("$m_dirD");}$m_dirD = "$PkgBaseDir/$TargetBaseDir";if ( -d "$m_dirD" ){rmDirectory("$m_dirD");}$m_dirD = "$PkgBaseDir";if ( -d "$m_dirD" ){rmDirectory("$m_dirD");}# lets create.#LogNorm ("Creating target directory structure...");$m_dirD = "$PkgBaseDir";if ( ! -d "$m_dirD" ){mkpath ( "$m_dirD", 0, 0777);LogInfo("Creating target dir [$m_dirD].");}CreateDirectory($PkgBaseDir, $TargetBaseDir, 0777);foreach $i ( sort {$a cmp $b} values %TargetDstDirStructure ){CreateDirectory("$PkgBaseDir/$TargetBaseDir", $i, 0777);}# lets determine if we have a InstallShield config dir#if ( "$MachType" eq "win32" || "$MachType" eq "WinCE" ){# if this is a patch build i expect to find a "p" in the front of the# file names. we use this as a simple visual differentiation.#my ($m_ishieldDir);my ($m_ishieldProjFile);if ( "x$PkgPatchNum" ne "x" ){# patch build.$m_ishieldDir = "$RootDir/" . "p$PkgName";$m_ishieldProjFile = "$RootDir/" . "p$PkgName" . ".ism";}else{# normal build.$m_ishieldDir = "$RootDir/" . "$PkgName";$m_ishieldProjFile = "$RootDir/" . "$PkgName" . ".ism";}# here i can set the location of my IShield project dir# so i can use it later if required.$PKG_ISHIELD_DIR = $m_ishieldDir;# we check for an ism file based on the pkg name# if we find one we need to deal with the dir and# the isheildlib files.#if ( -f "$m_ishieldProjFile" ){if ( ! -d "$m_ishieldDir" ){LogError ("Local InstallShield config dir [$m_ishieldDir] does not exist. " ."Please create before continuing.");}else{# we populate the ishield config dir with the ishieldlib files#my ($i);LogNorm("Installing Standard ishieldlib files from [$PKG_UTIL_DIR] to [$m_ishieldDir]");foreach $i ( @PKG_ISHIELD_FILES ){# first we remove the file (as previously it install read-only).unlink("$m_ishieldDir/$i");if( File::Copy::copy("$PKG_UTIL_DIR/$i", "$m_ishieldDir") ){LogInfo("Copied [$PKG_UTIL_DIR/$i] to [$m_ishieldDir] ...");}else{LogError("Failed to copy info file [$PKG_UTIL_DIR/$i] to [$m_ishieldDir] : $!");}}# we also want to deliver the patch rule files# if this build is a patch build.#if ( "x$PkgPatchNum" ne "x" ){LogNorm("Installing Patch ishieldlib files from [$PKG_UTIL_DIR] to [$m_ishieldDir]");foreach $i ( @PATCH_ISHIELD_FILES ){# first we remove the file (as previously it install read-only).unlink("$m_ishieldDir/$i");if( File::Copy::copy("$PKG_UTIL_DIR/$i", "$m_ishieldDir") ){LogInfo("Copied [$PKG_UTIL_DIR/$i] to [$m_ishieldDir] ...");}else{LogError("Failed to copy info file [$PKG_UTIL_DIR/$i] to [$m_ishieldDir] : $!");}}}# we also want to deliver the islib imgages to be# used by this project, we assume the image has a project# acronym prefix, and if not found we just WARN the user## we assume our source dir is the interface/etc dir and our# dst dir is the PkgBaseDir#my ($m_islibImgFile) = "";LogNorm("Installing ishield image files from [$DpkgEtcDir] to [$m_ishieldDir]");foreach $i ( @PKG_ISHIELD_IMG_FILES ){$m_islibImgFile = "$DpkgEtcDir/$ProjectAcronym" . "_" . $i;if ( -f "$m_islibImgFile" ){if( File::Copy::copy("$m_islibImgFile", "$PkgBaseDir") ){LogInfo("Copied [$m_islibImgFile] to [$PkgBaseDir] ...");}else{LogError("Failed to copy info file [$m_islibImgFile] to " ."[$PkgBaseDir] : $!");}}else{# we shall check for the MASS items, if the exist we copy them# over. Here we assume the 'mas' acronymn is correct.#$m_islibImgFile = "$DpkgEtcDir/mas" . "_" . $i;if ( -f "$m_islibImgFile" ){if( File::Copy::copy("$m_islibImgFile", "$PkgBaseDir") ){LogInfo("Copied [$m_islibImgFile] to [$PkgBaseDir] ...");}else{LogError("Failed to copy info file [$m_islibImgFile] to " ."[$PkgBaseDir] : $!");}}else{LogWarn("Failed to locate ishieldlib image [xxx_$i], no image copied, " ."check depolylib config.");}}}}}else{LogWarn("Did not detect InstallShield project file [$m_ishieldProjFile]");LogWarn("Not installing InstallShield library files.");}}# done.return 1;}#------------------------------------------------------------------------------sub generateIShieldIncludeFile ()## Description:# This subroutine is used to generate a definition include file# that is used during IShield builds.## The output location of the file is the IShieldProjDir.##------------------------------------------------------------------------------{my ($outFile) = "$PKG_ISHIELD_DIR/$PKG_ISHIELD_DEF_FILE";# this is only relavent for win32 builds.if ( "$MachType" eq "sparc" ){return 1;}# lets open the file.#local *FILE;open ( FILE, "> $outFile") orLogError("Failed to open file [$outFile].");# lets populate the pkgdef file.printf FILE ("// This is an automatically generated include file.\n");printf FILE ("// Please do not modify, and please do not check into ClearCase.\n");printf FILE ("//\n");printf FILE ("#define PKG_NAME \"$PkgName\"\n");printf FILE ("#define PKG_NAMELONG \"$PkgNameLong\"\n");printf FILE ("#define PKG_VERSION \"$PkgVersion\"\n");printf FILE ("#define PKG_BUILDNUM \"$PkgBuildNum\"\n");printf FILE ("#define PKG_PROJACRONYM \"$ProjectAcronym\"\n");printf FILE ("#define PKG_DESC \"$PkgDesc\"\n");# if this build is a patch build.#if ( "x$PkgPatchNum" ne "x" ){printf FILE ("#define PATCH_NAME \"$PkgPatchName\"\n");printf FILE ("#define PATCH_NUM \"$PkgPatchNum\"\n");printf FILE ("#define PATCH_ID \"$PkgPatchID\"\n");}else{printf FILE ("#define PATCH_NAME \"\"\n");printf FILE ("#define PATCH_NUM \"\"\n");printf FILE ("#define PATCH_ID \"\"\n");}# lets close the fileclose FILE;# done.return 1;}#------------------------------------------------------------------------------sub ValidateLocalSrcDirStructure## Description:# This sub-routine is used to check the existence the local dir# configuration items, these are stored in# %LocalSrcDirStructure.##------------------------------------------------------------------------------{# lets check the configured local direcotry structure#my ($i);foreach $i ( values %LocalSrcDirStructure ){my ($m_Dir) = "$SrcDir/$i";if ( ! -d "$m_Dir" ){LogWarn ("Local src dir [$m_Dir] does not exist.");}}return 1;}#------------------------------------------------------------------------------sub getLocalDirValue## Description:# This sub-routine is used to return the local dir value from# %LocalSrcDirStructure based on providing the# associated key.## If the value does not exist then it will return an error# and terminate processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."getLocalDirValue() function.");}my ($m_key, $m_type) = @_;if (exists $LocalSrcDirStructure{$m_key} ){if ( "$m_type" eq "A" ){return "$SrcDir/" ."$LocalSrcDirStructure{$m_key}";}else{return "$LocalSrcDirStructure{$m_key}";}}else{LogError("Local src tag [$m_key] does not exist in " ."LocalSrcDirStructure. " ."Check deploy configuration.");}return 1;}#------------------------------------------------------------------------------sub getTargetDstDirValue## Description:# This sub-routine is used to return the target dest dir value from# %TargetDstDirStructure based on providing the# associated key.## If the value does not exist then it will return an error# and terminate processing.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."getTargetDstDirValue() function.");}my ($m_key, $m_type) = @_;if (exists $TargetDstDirStructure{$m_key} ){if ( "$m_type" eq "A" ){return "$PkgBaseDir/$TargetBaseDir/" ."$TargetDstDirStructure{$m_key}";}if ( "$m_type" eq "R" ){return "$TargetBaseDir/$TargetDstDirStructure{$m_key}";}}else{LogError("Target destination dir tag [$m_key] does not exist in " ."TargetDstDirStructure. " ."Check deploy configuration.");}return 1;}#------------------------------------------------------------------------------sub createPatch## Description:# This sub-routine is used to create a solaris patch.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 0 ){LogError("Incorrect number of params passed to " ."createPatch() function. Check deploy config.");}# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "sparc" ){LogInfo("createPatch() not supported on this machine type.");return 1;}# lets just check to see if we can execute this function on# for this build.#if ( "x$PkgPatchNum" eq "x" ){LogWarn("createPatch() can only be called during a PATCH build.");return 1;}# we need to create the patch directory that contains#LogNorm("Creating patch ...");my ( $m_pkgmkCmd );my ( $m_pkgtransCmd );$m_pkgmkCmd = "pkgmk -o " ."-f $PkgBaseDir/prototype " ."-d $PkgBaseDir";# lets execute the package commands.my ($retVal);$retVal = system("$m_pkgmkCmd");if ( $retVal != 0 ){LogError("Failed to complete command [$m_pkgmkCmd].");}# we need to generate a README file to help during installation#generatePatchREADME();my ($m_Cmd) = "";my ($m_tmpDir) = "$PkgPatchTmpDir/$PkgPatchID";LogNorm("Creating staging area of patch...");$m_Cmd = "cd $PkgBaseDir && mkdir -p $m_tmpDir;";system($m_Cmd);LogNorm("Copying patch contents to staging area of patch...");$m_Cmd = "cd $PkgBaseDir && cp -r $PkgName $m_tmpDir;";system($m_Cmd);# we need to copy the patch install utility files from# their resting place.#my ($i);foreach $i ( @PATCH_UTIL_FILES ){if( File::Copy::copy("$PATCH_UTIL_DIR/$i", "$PkgPatchTmpDir") ){LogNorm("Copied [$PATCH_UTIL_DIR/$i] to [$PkgPatchTmpDir] ...");system("chmod 0755 $PkgPatchTmpDir/$i");}else{LogError("Failed to copy info file [$PATCH_UTIL_DIR/$i] to [$PkgPatchTmpDir] : $!");}}# Lets put the readme in place#if( File::Copy::copy("$PkgPatchReadme", "$PkgPatchTmpDir") ){LogNorm("Copied [$PkgPatchReadme] to [$PkgPatchTmpDir] ...");}else{LogError("Failed to copy info file [$PkgPatchReadme] to [$PkgPatchTmpDir] : $!");}LogNorm("Copying patch contents to staging area of patch...");$m_Cmd = "cd $PkgBaseDir && cp -r $PkgName $m_tmpDir;";system($m_Cmd);my ($m_oFile) = "$PkgPatchID-$ProjectAcronym\.tgz";LogNorm("Creating a gzip'd compressed tar (.tgz) output file [$m_oFile]...");my ($base) = File::Basename::basename($PkgPatchTmpDir);$m_Cmd = "cd $PkgBaseDir && tar cvf - $base | gzip > $m_oFile";system($m_Cmd);return 1;}#------------------------------------------------------------------------------sub generatePatchREADME## This function is used to generate a README text file to help the user# duing the patch installation.##------------------------------------------------------------------------------{local *FILE;open ( FILE, "> $PkgPatchReadme") orLogError("Failed to open file [$PkgPatchReadme].");printf FILE ("This is a patch for $PkgName $PkgVersion\n");printf FILE ("---------------------------------------------------------------\n");printf FILE ("\n");printf FILE ("Installing patch (as the 'root' user) :\n");printf FILE ("---------------------------------------------------------------\n");printf FILE ("./installpatch $PkgPatchID\n");printf FILE ("\n");printf FILE ("Backing Out patch:\n");printf FILE ("---------------------------------------------------------------\n");printf FILE ("./backoutpatch $PkgPatchID\n");printf FILE ("\n");printf FILE ("Patch contents of $PkgPatchID\n");printf FILE ("---------------------------------------------------------------\n");close FILE;# now we need to get the contents of the patch we are creating.#File::Find::find(\&getPatchContents, "$PkgBaseDir/$TargetBaseDir");return 1;}#------------------------------------------------------------------------------sub getPatchContents## This sub-routine adds an entry into the readme file for each# item in the patch delivery tree.##------------------------------------------------------------------------------{my($file)= "$File::Find::name";my($base)= File::Basename::basename($file);# we get the absolute path from the find, but we only require# a relative path from the starting dir.# so our start dir.my ($m_sfile) = $file;$file =~ s/$PkgBaseDir//;open ( FILE, ">> $PkgPatchReadme") orLogError("Failed to open file [$deplylib::PkgPatchReadme].");# lets populate the prototype file.printf FILE ("* $file\n");close (FILE);}#------------------------------------------------------------------------------sub createPackage## Description:# This sub-routine is used to create a solaris package.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 0 ){LogError("Incorrect number of params passed to " ."createPackage() function. Check deploy config.");}# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "sparc" ){LogInfo("createPackage() not supported on this machine type.");return 1;}# lets just check to see if we can execute this function on# for this build.#if ( "x$PkgPatchNum" ne "x" ){LogWarn("createPackage() can only be called during a RELEASE build.");return 1;}# we need to copy the package utility files from# their resting place.#my ($i);foreach $i ( @PKG_UTIL_FILES ){if( File::Copy::copy("$PKG_UTIL_DIR/$i", "$PkgBaseDir") ){LogNorm("Copied [$PKG_UTIL_DIR/$i] to [$PkgBaseDir] ...");updatePrototypeFileAddItem2("$i", "$i", "", "", "", "I");system("chmod 0755 $PkgBaseDir/$i");}else{LogError("Failed to copy info file [$PKG_UTIL_DIR/$i] to [$PkgBaseDir] : $!");}}my ( $m_pkgmkCmd );my ( $m_pkgtransCmd );$m_pkgmkCmd = "pkgmk -o " ."-f $PkgBaseDir/prototype " ."-d $PkgBaseDir";$m_pkgtransCmd = "pkgtrans -o " ."-s $PkgBaseDir " ."$PkgOutputFile " ."$PkgName";# lets execute the package commands.my ($retVal);$retVal = system("$m_pkgmkCmd");if ( $retVal != 0 ){LogError("Failed to complete command [$m_pkgmkCmd].");}$retVal = system("$m_pkgtransCmd");system("$m_pkgtransCmd");if ( $retVal != 0 ){LogError("Failed to complete command [$m_pkgtransCmd].");}# lets compress the output to save some space.#LogNorm("Compressing $PkgOutputFile");my ($m_compressCmd) = "cd $PkgBaseDir; gzip $PkgOutputFile";system($m_compressCmd);return 1;}#------------------------------------------------------------------------------sub createPrototypeFile## Description:# This sub-routine is used to create the required package prototye file# from a known directory struture using the search path method.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."createPrototypeFile() function. Check deploy config.");}# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "sparc" ){LogInfo("createPrototypeFile() not supported on this machine type.");return 1;}# lets take the passed in args.my ($uid, $gid) = @_;# we need to determine whiich file we are dealing withmy ($protoTypeFile);my ($targetBaseDir);my ($pkgBaseDir);$protoTypeFile = "$ProtoTypeFile";$targetBaseDir = "$PkgBaseDir/$TargetBaseDir";$pkgBaseDir = "$PkgBaseDir";# we need to locate the prototype fileif ( -f "$protoTypeFile" ){unlink("$protoTypeFile");LogInfo("Removing prototype file [$protoTypeFile].");}# lets open the prototype file.#local *FILE;open ( FILE, "> $protoTypeFile") orLogError("Failed to open file [$protoTypeFile].");# lets populate the prototype file.printf FILE ("i pkginfo\n");if ( "x$TargetBaseDir" ne "x." ){printf FILE ("!search $TargetBaseDir");}else{printf FILE ("!search ");}# now we need to add entries for each directory we will# be installingFile::Find::find(\&prototypeFind, "$targetBaseDir");# lets populate the prototype file with a newline.open ( FILE, ">> $protoTypeFile") orLogError("Failed to open file [$protoTypeFile].");printf FILE ("\n");close (FILE);# lets put the pre-deinfed generic entries into the# prototype file#if ( "x$PkgPatchNum" ne "x" ){addPatchInfo2ProtoTypeFile();}# we need to expand and complete the creation of the# prototype file# if targetbasedir is "." the pkgproto will pick up the pkginfo and# prototype files so we need to remove themmy ($m_cmd) = "pkgproto " ."$TargetBaseDir " ."| egrep -v \"($ProtoTypeFileName|$PkgInfoFileName)\"" ."| cut -f1-4 -d' ' | sed " . '"s/\$/ ' . "$uid $gid" . '/g"' ." >> $protoTypeFile";my ($retVal) = system("cd $pkgBaseDir; $m_cmd");if ( $retVal != 0 ){LogError("Failed to create prototype file [$protoTypeFile].");}LogNorm("Created prototype file [$protoTypeFile].");return 1;}#------------------------------------------------------------------------------sub prototypeFind## Description:# This subroutine is used to locate all associated package dirs.# It also adds an entry into the prototype file for each dir.##------------------------------------------------------------------------------{my($file)= "$File::Find::name";my($base)= File::Basename::basename($file);# we get the absolute path from the find, but we only require# a relative path from the starting dir.# so our start dir.# we need to determine whiich file we are dealing withmy ($pfile);my ($tDir);$pfile = "$ProtoTypeFile";$tDir = "$PkgBaseDir/$TargetBaseDir";if ( "$file" ne "$tDir" ){if ( -d "$file" ){my ($m_sfile) = $file;if ( "x$TargetBaseDir" eq "x." ){$tDir = $tDir . "/";$file =~ s/$tDir//;}else{$file =~ s/$tDir/$TargetBaseDir/;}open ( FILE, ">> $pfile") orLogError("Failed to open file [$pfile].");# lets populate the prototype file.printf FILE (" $file");close (FILE);}}}#------------------------------------------------------------------------------sub addPatchInfo2ProtoTypeFile## Description:# This sub-routine is used to add additonal genericinformation# used by the patch.##------------------------------------------------------------------------------{LogNorm("Adding patch information files to patch build...");# we need to determine whiich file we are dealing withmy ($protoTypeFile);$protoTypeFile = "$ProtoTypeFile";# lets open the prototype file.#local *FILE;open ( FILE, ">> $protoTypeFile") orLogError("Failed to open file [$protoTypeFile].");# we need to copy the install informational files from# their resting place.my ($i);foreach $i ( @PATCH_INFO_FILES ){if( File::Copy::copy("$PATCH_UTIL_DIR/$i", "$PkgBaseDir") ){LogNorm("Copied [$PATCH_UTIL_DIR/$i] to [$PkgBaseDir] ...");printf FILE ("i $i\n");}else{LogError("Failed to copy info file [$PATCH_UTIL_DIR/$i]: $!");}}close FILE;return 1;}#------------------------------------------------------------------------------sub useReplaceClass## Description:# This sub-routine is used to add replace class to the classes list and# include the i.replace file in the PKG_INFO_FILES List##------------------------------------------------------------------------------{LogNorm("useReplaceClass: Adding replace class to installer");$PkgInfoClasses = $PkgInfoClasses . " " . "replace";push(@PKG_UTIL_FILES, "i.replace");}#------------------------------------------------------------------------------sub addPkgInfoClasses## Description:# This sub-routine is used to add new classes to the pkginfo CLASSES variable.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) == 0 ){LogError("Incorrect number of params passed to " ."createPkginfoFile() function. Check deploy config.");}LogNorm("addPkgInfoClasses() Adding classes \"" . join(" ", @_) . "\" to CLASSES List");$PkgInfoClasses = $PkgInfoClasses . " " . join(" ", @_);}#------------------------------------------------------------------------------sub addPkgInfoField## Description:# This sub-routine is used to add new fields to already created pkginfo file# Acccepts any number of fields of format A=B as one string parameter.#------------------------------------------------------------------------------{# lets just check to see if we can execute this function on this machine.if ( "$MachType" ne "sparc" ){LogInfo("addPkgInfoField() not supported on this machine type.");return 1;}# lets open the pkginfo file.local *FILE;open ( FILE, ">> $PkgInfoFile") or LogError("Failed to open file [$PkgInfoFile].");foreach my $i ( @_ ){print FILE "$i\n";}close FILE;return 1;}#------------------------------------------------------------------------------sub updatePrototypeFileItemClass## Description:# This subroutine is used to change the class of a file already in the prototype file##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."updatePrototypeFileItemClass() function. Check deploy config.");}# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "sparc" ){LogInfo("updatePrototypeFileItemClass() not supported on this machine type.");return 1;}# lets setup the passed values.my ($m_item, $class) = @_;my ($tmpProtoTypeFile) = "/tmp/xx_prototypefile.$$";# lets open the prototype file if it exists#open (PFILE, "< $ProtoTypeFile") orLogError("Failed to open prototype file [$ProtoTypeFile].");open (PFILETMP, "> $tmpProtoTypeFile") orLogError("Failed to open tmp prototype file [$tmpProtoTypeFile].");while ( <PFILE> ){chomp;# The path section will normally contain "path [mode]" or path=path# The passed arg can be full path or can skip top level dirs# eg prototype can have line with path ergbpeod/etc/afcbp.ini# arg to match can be ergbpeod/etc/afcbp.ini, etc/afcbp.ini or afcbp.ini# therefore we need to match arg to the end of the path in line# so we append [= ] to args/^(\s*[bcdefilpsvx]\s*)[^\s]*(.*$)/$1$class$2/ if ( /$m_item[ =]/ );printf PFILETMP ("$_\n");}close PFILE;close PFILETMP;# now we need to copy the file.if(File::Copy::copy("$tmpProtoTypeFile", "$ProtoTypeFile")){LogNorm("Updated file $m_item to class $class");unlink($tmpProtoTypeFile);}else{LogError("Failed to copy lib [$tmpProtoTypeFile]: $!");}return 1;}#------------------------------------------------------------------------------sub setReplaceClassFiles## Description:# This subroutine is used to change the class of a file already in the prototype file##------------------------------------------------------------------------------{# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "sparc" ){LogInfo("updatePrototypeFileItemClass() not supported on this machine type.");return 1;}LogError("Must call useReplaceClass() before calling setReplaceClassFiles()") if ( $PkgInfoClasses !~ /replace/ );my ($tmpProtoTypeFile) = "/tmp/xx_prototypefile.$$";# lets open the prototype file if it exists#open (PFILE, "< $ProtoTypeFile") orLogError("Failed to open prototype file [$ProtoTypeFile].");open (PFILETMP, "> $tmpProtoTypeFile") orLogError("Failed to open tmp prototype file [$tmpProtoTypeFile].");my $line;while ( $line = <PFILE> ){chomp $line;# The path section will normally contain "path [mode]" or path=path# The passed args can be full path or can skip top level dirs# eg prototype can have line with path ergbpeod/etc/afcbp.ini# args to match can be ergbpeod/etc/afcbp.ini, etc/afcbp.ini or afcbp.ini# therefore we need to match each arg to the end of the path in line# so we append [= ] to end of each arg$line =~ s/^(\s*[bcdefilpsvx]\s*)[^\s]*(.*$)/$1replace$2/ if ( scalar(grep { $line =~ /$_[ =]/ } @_) > 0 );printf PFILETMP ("$line\n");}close PFILE;close PFILETMP;# now we need to copy the file.if(File::Copy::copy("$tmpProtoTypeFile", "$ProtoTypeFile")){LogNorm("Updated prototype file entries to class replace");unlink($tmpProtoTypeFile);}else{LogError("Failed to copy lib [$tmpProtoTypeFile]: $!");}return 1;}#------------------------------------------------------------------------------sub createPkginfoFile## Description:# This sub-routine is used to create the required package info.# Accepts any number of parameters, with each parameter taken as a literal# Field=Value string and inserted into the PkgInfo File#------------------------------------------------------------------------------{# lets check to see if our description has been setif ( $PkgDesc eq "" ){LogError("Package description not set. " ."Use setPkgDescription('my package description') function.");}# lets check to see if our long name has been setif ( $PkgNameLong eq "" ){LogError("Package name not set. Use setPkgName('my package long name') function.");}# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "sparc" ){generateIShieldIncludeFile();return 1;}# we need to determine whiich file we are dealing withmy ($pkginfoFile) = "$PkgInfoFile";# we need to locate the pkginfo fileif ( -f "$pkginfoFile" ){unlink("$pkginfoFile");LogInfo("Removing pkginfo file [$pkginfoFile].");}# lets open the pkginfo file.#local *FILE;open ( FILE, "> $pkginfoFile") orLogError("Failed to open file [$pkginfoFile].");# lets populate the pkginfo file.printf FILE ("PKG=$PkgName\n");# here we deal with the new version number format#printf FILE ("NAME=$PkgNameLong\n");printf FILE ("VERSION=$PkgVersion.$ProjectAcronym\n");printf FILE ("ARCH=$MachType\n");printf FILE ("VENDOR=$VENDOR_DESC\n");printf FILE ("DESC=$PkgDesc\n");printf FILE ("CATEGORY=$CATEGORY_DESC\n");printf FILE ("BASEDIR=$ERGAFC_BASEDIR\n");printf FILE ("TARGETBASEDIR=$TargetBaseDir\n");printf FILE ("CLASSES=$PkgInfoClasses\n");foreach my $param ( @_ ){printf FILE "$param\n";}if ( "x$PkgPatchNum" ne "x" ){my ($count)=1;my ($pRev)="";printf FILE ("MAXINST=$MAXINST\n");printf FILE ("SUNW_PATCHID=$PkgPatchID\n");printf FILE ("SUNW_REQUIRES=\n");printf FILE ("SUNW_INCOMPAT=\n");$count=1;$pRev="";printf FILE ("SUNW_OBSOLETES=");while ( $count < $PkgPatchNum ){$pRev = sprintf ("%02s", $count);printf FILE ("$PkgPatchName" ."$PkgVersionStr" ."-" ."$pRev ");$count++;}printf FILE ("\n");$count=1;$pRev="";printf FILE ("PATCH_OBSOLETES=");while ( $count < $PkgPatchNum ){$pRev = sprintf ("%02s", $count);printf FILE ("$PkgPatchName" ."$PkgVersionStr" ."-" ."$pRev ");$count++;}printf FILE ("\n");}# now we will list the build dependencies so# we can refer to them online#my ($i);my ($m_Str);# printf FILE ("\n");my ($count) = 1;foreach $i ( $BuildFileInfo->getDpkgArchiveList() ){my $moduleInfo = $BuildFileInfo->getDpkgArchiveInfo($i);printf FILE ( "$moduleInfo->{type}\_$count=$i $moduleInfo->{version}");# we shall print the project bit if we have oneif ( $moduleInfo->{proj} ne "" ){printf FILE ( "\.$moduleInfo->{proj}\n");}else{printf FILE ("\n");}$count++;}close FILE;# lets close the pkginfo file.close (FILE);LogNorm("Created pkginfo file [$pkginfoFile].");return 1;}#------------------------------------------------------------------------------sub updatePrototypeFileItemOwner## Description:# This sub-routine is used to change the ownership of a file item# in the prototype file.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 4 ){LogError("Incorrect number of params passed to " ."updatePrototypeFileItemOwner() function. Check deploy config.");}# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "sparc" ){LogInfo("chmod() not supported on this machine type.");return 1;}# lets setup the passed values.my ($m_item, $m_ownPerms, $m_ownUser, $m_ownGroup) = @_;my ($tmpProtoTypeFile) = "/tmp/xx_prototypefile.$$";# lets open the prototype file if it exists#open (PFILE, "< $ProtoTypeFile") orLogError("Failed to open prototype file [$ProtoTypeFile].");open (PFILETMP, "> $tmpProtoTypeFile") orLogError("Failed to open tmp prototype file [$tmpProtoTypeFile].");my ($inLine);while ( <PFILE> ){$inLine = $_;chomp($inLine);if ( "$inLine" =~ /^f / && "$inLine" =~ /$m_item/ ){my ($b1, $b2, $b3, $b4, $b5, $b6) = split (/ /, $inLine);printf PFILETMP ("$b1 $b2 $b3 $m_ownPerms $m_ownUser $m_ownGroup\n");}else{printf PFILETMP ("$inLine\n");}}close PFILE;close PFILETMP;# now we need to copy the file.if(File::Copy::copy("$tmpProtoTypeFile", "$ProtoTypeFile")){LogNorm("Copied [$tmpProtoTypeFile] to [$ProtoTypeFile] ...");unlink($tmpProtoTypeFile);}else{LogError("Failed to copy lib [$tmpProtoTypeFile]: $!");}return 1;}#------------------------------------------------------------------------------sub chmod## Description:# This sub-routine is used to change the ownership of a file or# directory structure.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 3 ){LogError("Incorrect number of params passed to " ."chmod() function. Check deploy config.");}# lets setup the passed values.my ($m_sDirTag, $m_sfile, $m_ownPerms) = @_;# lets just check to see if the perms are in correct format.#if ( "$m_ownPerms" !~ m/^[0-9][0-9][0-9][0-9]$/ ){LogError("chmod() does not support [$m_ownPerms] permission, use format 0755 etc.");return 1;}# lets get the absolute src dir valuemy ($m_sDirAbsoluteValue) = getTargetDstDirValue($m_sDirTag, "A");my($item);if ( "x$m_sfile" eq "x" ){$item = "$m_sDirAbsoluteValue";}else{$item = "$m_sDirAbsoluteValue/$m_sfile";}# check to see if item exists#if ( ! -f "$item" &&! -d "$item" ){LogError("Failed to find item [$item]. Check deploy config.");}LogNorm("chmod: Changing permisions of file [$m_sfile] in dirtag [$m_sDirTag] to [$m_ownPerms]");chmodFile("$item", $m_ownPerms);return 1;}#------------------------------------------------------------------------------sub chmodRecursive## Description:# This sub-routine is used to change the permissions recursively in# the target packgae.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."chmodRecursive() function. Check deploy config.");}# lets setup the passed values.my ($m_sDirTag, $m_ownPerms) = @_;# lets just check to see if the perms are in correct format.#if ( "$m_ownPerms" !~ m/^[0-9][0-9][0-9][0-9]$/ ){LogError("chmod() does not support [$m_ownPerms] permission, use format 0755 etc.");return 1;}# lets get the absolute src dir valuemy ($m_sDirAbsoluteValue) = getTargetDstDirValue($m_sDirTag, "A");# check to see if item exists#if ( ! -f "$m_sDirAbsoluteValue" &&! -d "$m_sDirAbsoluteValue" ){LogError("Failed to find item [$m_sDirAbsoluteValue]. " ."Check deploy config.");}# if its a not a dir#if ( ! -d "$m_sDirAbsoluteValue" && -f "$m_sDirAbsoluteValue" ){LogWarn("chmodRecursive: This should not happen as dirtag [$m_sDirTag] is a file, changings perms to [$m_ownPerms] anyway");chmodFile("$m_sDirAbsoluteValue", $m_ownPerms);}else{# it must be a dirLogNorm("chmodRecursive: Recursively setting perms on dirtag [$m_sDirTag] to [$m_ownPerms]");chmodDir("$m_sDirAbsoluteValue", $m_ownPerms);}return 1;}#------------------------------------------------------------------------------sub chmodDir## Description:# This sub-routine is used to change the permissions an entire directory tree.## It recurses from a starting point chmod'ing each item and if it# finds a dir it recurses into that dir chmod'ing it as well.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."chmodDir() function.");}my ($startingPoint, $perms) = @_;LogInfo("chmodDir: Recursively setting permsision of [$startingPoint] to [$perms]");local *DIR;opendir(DIR, $startingPoint) orLogError("can't opendir $startingPoint: $!");my ($item);while (defined($item = readdir(DIR))){if ( "$item" !~ /^\.$/ &&"$item" !~ /^\.\.$/ ){if ( -d "$startingPoint/$item" ){chmodDir("$startingPoint/$item", $perms);}else{chmodFile("$startingPoint/$item", $perms);}}}close (DIR);# lets deal with starting dir#chmodFile("$startingPoint", $perms);return 1;}#------------------------------------------------------------------------------sub chmodFile## this function is used to chmod the perms od an item# it is passed the absolute path to the item and the associated# perms.##------------------------------------------------------------------------------{my ($item, $perms) = @_;my ($cmd) = "CORE::chmod $perms, $item";my ($noItems) = CORE::chmod oct($perms), $item;if ( $noItems == 0 ){LogError("Failed to complete command [$cmd], retVal=[$noItems]");}else{LogDebug("Executed command: [$cmd]");}return 1;}#------------------------------------------------------------------------------sub createSymbolicLink## Description:# This sub-routine is used to copy a local deployment file into# the target destination dir.###------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 3 ){LogError("Incorrect number of params passed to " ."createSymbolicLink() function. Check deploy config.");}# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "sparc" ){LogInfo("createSymbolicLink() not supported on this machine type.");return 1;}# lets setup the passed values.my ($m_sDirTag, $m_srcStr, $m_linkStr) = @_;# lets get the absolute src dir valuemy ($m_sDirAbsoluteValue) = getTargetDstDirValue($m_sDirTag, "A");# lets see if the source item exists#if ( ! -f "$m_sDirAbsoluteValue/$m_srcStr" ){LogError("Failed to locate item [$m_sDirAbsoluteValue/$m_srcStr], link not created.");}my ($cmd) = "cd $m_sDirAbsoluteValue; ln -s $m_srcStr $m_linkStr";system("$cmd");if ( $? != 0 ){LogError("Failed to complete command: [$cmd]");}else{LogNorm("Executed command: [$cmd]");}return 1;}#------------------------------------------------------------------------------sub createPrototypeFile2## Description:# This sub-routine is used to create the required package prototype file# fom a known directory struture using the a=b format.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 3 ){LogError("Incorrect number of params passed to " ."createPrototypeFile2() function. Check deploy config.");}# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "sparc" ){LogInfo("createPrototypeFile2() not supported on this machine type.");return 1;}# lets take the passed in args.my ($uid, $gid, $mask) = @_;# we need to determine whiich file we are dealing withmy ($protoTypeFile);my ($targetBaseDir);my ($pkgBaseDir);$protoTypeFile = "$ProtoTypeFile";$targetBaseDir = "$PkgBaseDir/$TargetBaseDir";$pkgBaseDir = "$PkgBaseDir";# we need to locate the prototype fileif ( -f "$protoTypeFile" ){unlink("$protoTypeFile");LogInfo("Removing prototype file [$protoTypeFile].");}# lets open the prototype file.#local *FILE;open ( FILE, "> $protoTypeFile") orLogError("Failed to open file [$protoTypeFile].");# lets populate the prototype file.printf FILE ("!default $mask $uid $gid\n");printf FILE ("i pkginfo\n");close (FILE);# lets put the pre-deinfed generic entries into the# prototype file#if ( "x$PkgPatchNum" ne "x" ){addPatchInfo2ProtoTypeFile();}# lets set the associated uid, gid and mask# for the bits in the prototype file.#$m_UID = $uid;$m_GID = $gid;$m_MASK = $mask;# now we need to add entries for each directory we will# be installingFile::Find::find(\&prototype2Find, "$targetBaseDir");# lets populate the prototype file with a newline.open ( FILE, ">> $protoTypeFile") orLogError("Failed to open file [$protoTypeFile].");printf FILE ("\n");close (FILE);LogNorm("Created prototype file [$protoTypeFile].");return 1;}#------------------------------------------------------------------------------sub prototype2Find## Description:# This subroutine is used to locate all associated package dirs.# It also adds an entry into the prototype file for each dir.##------------------------------------------------------------------------------{my($file)= "$File::Find::name";my($base)= File::Basename::basename($file);# we get the absolute path from the find, but we only require# a relative path from the starting dir.# so our start dir.# we need to determine which file we are dealing withmy ($pfile);my ($tDir);$pfile = "$ProtoTypeFile";$tDir = "$PkgBaseDir/$TargetBaseDir";if ( "$file" ne "$tDir" ){my ($m_sfile) = $file;if ( "x$TargetBaseDir" eq "x." ){$tDir = $tDir . "/";$file =~ s/$tDir//;}else{$file =~ s/$tDir/$TargetBaseDir/;}# if TargetBaseDir is "." then find will find the pkginfo & prototype# files so we need to exclude themif ( "$file" ne "$ProtoTypeFileName" &&"$file" ne "$PkgInfoFileName"){open ( FILE, ">> $pfile") orLogError("Failed to open file [$pfile].");if ( -f "$m_sfile" ){printf FILE ("f none $file=$file $m_MASK $m_UID $m_GID\n");}if ( -d "$m_sfile" ){printf FILE ("d none $file $m_MASK $m_UID $m_GID\n");}close (FILE);}}}#------------------------------------------------------------------------------sub convertFile## Description:# This sub-routine is used to remove all carrage return\line feeds# from a line and replace them with the platform specific equivalent chars.## We let PERL determine what characters are written to the file base on the# platform you are running on.### i.e. LF for unix# CR\LF for win32##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 2 ){LogError("Incorrect number of params passed to " ."convertFile() function. Check deploy config.");}my ($m_targetDirTag, $m_nfile) = @_;# lets get the src dir valuemy ($m_targetDirValue) = getTargetDstDirValue($m_targetDirTag, "A");# this is our file that we want to clean.my ($m_ifileLoc) = "$m_targetDirValue/$m_nfile";my ($m_tfileLoc) = "$m_targetDirValue/$m_nfile\.tmp";# we will check to see if the file exists.#local *IFILE;local *TFILE;if ( -f "$m_ifileLoc" ){open (IFILE, "< $m_ifileLoc" ) orLogError("Failed to open file [$m_ifileLoc] : $!");open (TFILE, "> $m_tfileLoc" ) orLogError("Failed to open file [$m_tfileLoc] : $!");while ( <IFILE> ){chomp;print TFILE "$_\n";}}else{LogError("Deploy file [$m_ifileLoc] does not exist.");}close IFILE;close TFILE;# lets replace our original file with the new one#if(File::Copy::move("$m_tfileLoc", "$m_ifileLoc")){LogNorm("Renamed [$m_tfileLoc] to [$m_ifileLoc] ...");}else{LogError("Failed to crename file [$m_tfileLoc] to [$m_ifileLoc]: $!");}return 1;}#------------------------------------------------------------------------------sub installDeployFile## Description:# This sub-routine is used to copy a local deployment file into# the target destination dir.###------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 4 ){LogError("Incorrect number of params passed to " ."installDeployFile() function. Check deploy config.");}my ($m_srcDirTag, $m_sfile, $m_targetDirTag, $m_nfile) = @_;# lets get the src dir valuemy ($m_targetDirValue) = getTargetDstDirValue($m_targetDirTag, "A");# lets get the target dir valuemy ($m_srcDirValue) = getLocalDirValue($m_srcDirTag, "A");# we know where we are getting this from and where we# going to put them.my ($m_sfileLoc) = "$m_srcDirValue/$m_sfile";my ($m_nfileLoc) = "";# lets determine what we are going to call the new file.#if ( "x$m_nfile" eq "x" ){$m_nfileLoc = "$m_targetDirValue/$m_sfile";}else{$m_nfileLoc = "$m_targetDirValue/$m_nfile";}# we will check to see if the file exists.#if ( -f "$m_sfileLoc" ){# now we need to copy the file.if(File::Copy::copy("$m_sfileLoc", "$m_nfileLoc")){LogNorm("Copied [$m_sfile] to [$m_nfileLoc] ...");# now we need to ensure the item is writable as it# has come from our VOB that is by definition read-only#CORE::chmod oct("0755"), $m_nfileLoc;}else{LogError("Failed to copy lib [$m_sfileLoc]: $!");}}else{LogError("Deploy file [$m_sfileLoc] does not exist.");}return 1;}#------------------------------------------------------------------------------sub getGenericNameForLib## Description:# This sub-routine is used to determine the generic name for# a library. I.E remove the buildtype and version number.## It also checks if the name provided should be excluded from# the build.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 1 ){LogError("Incorrect number of params passed to " ."getGenericNameForLib() function. Check deploy config.");}# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "sparc" ){LogInfo("getGenericNameForLib() not supported on this machine type.");return "";}my($itemName) = @_;# first we need to check to see if it belongs in this build#my ($gName) = "";if(excludeItemFromBuild($itemName)){LogInfo("Excluding item [$itemName] from build as not compatible with build type " ."[$BuildType].");return ""; # file should be excluded.}else{$gName = removeBuildTypeFromItemName($itemName);$gName = removeVersionNumberFromItemName($gName);return "$gName";}return 1;}#------------------------------------------------------------------------------sub getGenericNameNoVersionForLib## Description:# This sub-routine is used to determine the generic name for# a library. I.E removes the version number.## It also checks if the name provided should be excluded from# the build.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 1 ){LogError("Incorrect number of params passed to " ."getGenericNameNoVersionForLib() function. Check deploy config.");}# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "sparc" ){LogInfo("getGenericNameNoVersionForLib() not supported on this machine type.");return "";}my($itemName) = @_;# first we need to check to see if it belongs in this build#my ($gName) = "";if(excludeItemFromBuild($itemName)){LogInfo("Excluding item [$itemName] from build as not compatible with build type " ."[$BuildType].");return ""; # file should be excluded.}else{$gName = removeVersionNumberFromItemName($itemName);return "$gName";}return 1;}#------------------------------------------------------------------------------sub getGenericNameNoVersionForXML## Description:# This sub-routine is used to determine the generic name for# an XML file. I.E removes the version number.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 1 ){LogError("Incorrect number of params passed to " ."getGenericNameNoVersionForXML() function. Check deploy config.");}my($itemName) = @_;my ($gName) = "";$gName = removeVersionNumberFromXMLItemName($itemName);return "$gName";return 1;}#------------------------------------------------------------------------------sub removeVersionNumberFromXMLItemName## Description:# This sub-routine is used to remove the version number from the item name.# i.e. myFile_1_2_3.xml ==> myFile.xml## INPUT:# item name## RETURN:# new item name.##------------------------------------------------------------------------------{my ($file) = @_;my ($nfile) = $file;if ( $nfile =~ m/_[0-9]+_[0-9]+_[0-9]+\.xml$/ ){# if we match lets deal with it.$nfile =~ s/_[0-9]+_[0-9]+_[0-9]+\.xml$/\.xml/;}else{LogWarn("Filename [$nfile] does not contain required format [myfile_N_N_N.xml].");}return "$nfile";}#------------------------------------------------------------------------------sub createDpkgArchive## Description:# This sub-routine is used to create a dpkg_archive directory# structure.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 1 ){LogError("Incorrect number of params passed to " ."createDpkgArchive() function. Check deploy config.");}my ($desc) = @_;# lets just check to see if we can execute this function on# for this build.#if ( "x$PkgPatchNum" ne "x" ){LogInfo("createDpkgArchive() can only be called during a RELEASE build.");return 1;}# 1. we create a dpkg_archive top level dir within the output directory#my ($m_tmpDir) = "$PkgBaseDir/dpkg_archive";if ( ! -d $m_tmpDir ){mkdir("$m_tmpDir", 0777);LogInfo("created [$m_tmpDir] dir...");}# 2. we create a sub-directory with the package name#$m_tmpDir = "$PkgBaseDir/dpkg_archive/$TargetBaseDir";if ( ! -d $m_tmpDir ){mkdir("$m_tmpDir", 0777);LogInfo("created [$m_tmpDir] dir...");}# 3. we create a sub-directory with the package version number#my ($m_tmpDir2) = "$PkgBaseDir/dpkg_archive/$TargetBaseDir/" ."$PkgVersion" . "." . "$ProjectAcronym";if ( ! -d $m_tmpDir2 ){mkdir("$m_tmpDir2", 0777);LogInfo("created [$m_tmpDir2] dir...");}# 4. we replacate the contents of the original outputdir/package name# to do this we shall execute a find starting within the original package target dir# any copy all items we find to the new location under the dpkg_archive/package/version dir.#File::Find::find( \&DpkgFind, "$PkgBaseDir/$TargetBaseDir");# 5. we create a descpkg file, with the Package Name, Version and Desc#my ($m_DescPkgFile) = "$PkgBaseDir/dpkg_archive/$TargetBaseDir/$PkgVersion\.$ProjectAcronym/descpkg";# now we need to update the prototype file#local *FILE;open ( FILE, ">> $m_DescPkgFile") orLogError("Failed to open file [$m_DescPkgFile].");printf FILE ("$PkgName, $PkgVersion.$ProjectAcronym - $desc\n");close (FILE);# done.LogNorm("createDpkgArchive() completed.");return 1;}#------------------------------------------------------------------------------sub DpkgFind## Description:# This subroutine is used to locate all associated items to# create a new dpkg_archive directory structure.##------------------------------------------------------------------------------{my($item)= "$File::Find::name";my($base)= File::Basename::basename($item);# we get the absolute path from the find, but we only require# a relative path from the starting dir.# we need to determine which file we are dealing withif ( ! -d "$item"){my ($m_sfile) = $item;$item =~ s/$PkgBaseDir\/$TargetBaseDir/$PkgBaseDir\/dpkg_archive\/$TargetBaseDir\/$PkgVersion\.$ProjectAcronym/;if(File::Copy::copy("$m_sfile", "$item")){LogNorm("Copied [$base] to [$item] ...");}else{LogError("Failed to copy pkg file [$m_sfile] to [$item]: $!");}}else{# we have found a dirmy ($m_sDir) = $item;$item =~ s/$PkgBaseDir\/$TargetBaseDir/$PkgBaseDir\/dpkg_archive\/$TargetBaseDir\/$PkgVersion\.$ProjectAcronym/;# if the dir does not exist lets create it#if ( ! -d $item){mkdir ( $item, 0777 );}}}#------------------------------------------------------------------------------sub getRmDetails## Description:# This is called to update the RM class objects with details from RM database#------------------------------------------------------------------------------{if ( ! defined($RmPkgDetails) ){# Set defaults for elements in RM if not foundDeployUtils::RmPkgInfo->DefaultDescription($PkgDesc);DeployUtils::RmPkgInfo->DefaultLabel($PkgLabel);$RmPkgDetails = DeployUtils::RmPkgInfo->new({ PKG_NAME => $PkgName,PKG_VERSION => ( "$PkgPatchNum" ne "" ) ? $PkgPatchID : $PkgVersionUser } );# lets check to see if we got somethingif ( $RmPkgDetails->foundPkg() ){$RmPvPkgDetails = DeployUtils::RmPkgInfo->new( { PKG_NAME => $PkgName,PKG_VERSION => $PkgPreviousVersionStr } );if ( $RmPvPkgDetails->foundDetails() ){LogNorm("Retrieved Package Details from Release Manager");LogInfo("RM pkg_name = [" . $RmPkgDetails->pkg_name() . "]");LogInfo("RM pkg_id = [" . $RmPkgDetails->pkg_id() . "]");LogInfo("RM pv_id = [" . $RmPkgDetails->pv_id() . "]");LogInfo("RM pv_description = [" . $RmPkgDetails->pv_description() . "]");LogInfo("RM pv_overview = [" . $RmPkgDetails->pv_overview() . "]");LogInfo("RM pv_reason = [" . $RmPkgDetails->pv_reason() . "]");LogInfo("RM pv_label = [" . $RmPkgDetails->pv_label() . "]");LogInfo("RM previousPv_id = [" . $RmPvPkgDetails->pv_id() . "]");LogInfo("RM pv_dlocked = [" . $RmPvPkgDetails->pv_dlocked() . "]");}else{# our package does not exist in release managerLogWarn("Could not retrieve package $PkgName $PkgVersionUser previous version " ."details from Release Manager.")}}else{# our package does not exist in release managerLogWarn("Package $PkgName $PkgVersionUser does not exist in the Release Manager. Please check configuration.")}}}# This is now depricatedsub generateReleaseNote{LogError("generateReleaseNote is depricated please use generateHtmlReleaseNote");return 1;}#------------------------------------------------------------------------------sub generateHtmlReleaseNote## Description:##------------------------------------------------------------------------------{## Ensure the Release directory is present#if ( ! -d $ReleaseDir ){mkpath ( $ReleaseDir, 0, 0777);LogInfo("created [$ReleaseDir] dir...");}if ( ! getRmReleaseNote() ){LogNorm("No Release Manager release note, lets attempt to create an internal version");if ( $RmPkgDetails->foundPkg() ){# internal versiongenerateInternalHtmlReleaseNote();}else{LogWarn("No Release Manager details, release note not generated.");}}}#------------------------------------------------------------------------------sub getRmReleaseNote## Description:##------------------------------------------------------------------------------{# lets get some details for our packagegetRmDetails();# now we need to ensure that our local build file dependencies are# the same as those we have entered in the Release Manager database.checkDependencies();# let's update the release contents now#generateProductContents();LogNorm("Retrieving Release Notes From Release Manager...Please wait...");my $user_agent = LWP::UserAgent->new( timeout => 30 );my $response = $user_agent->get('http://erg:8002/ManagerSuite/Release_Manager/_adhoc_release_notes.asp?pv_id='. $RmPkgDetails->pv_id(),':content_file' => "$PkgReleaseNote\.html");if ( $response->is_success ){LogNorm("Retrieved Release Manager HTML Release note [$PkgReleaseNote\.html]");return 1;}else{LogWarn("Unable to retrieve Release Manager Release Notes");return 0;}}#------------------------------------------------------------------------------sub generateInternalHtmlReleaseNote## Description:# This subroutine is used to generate a simple release note in HTML format# for the package.## The function populates various sections of the release note# with details that are available at the time of execution# and it also creates blank sections to be populated later by the user# when the information is available.##------------------------------------------------------------------------------{# correct number of parameters?if ( ($#_+1) != 0 ){LogError("Incorrect number of params passed to " ."generateReleaseNote2() function. Check deploy config.");}local *FILE;open ( FILE, "> $PkgReleaseNote\.html") orLogError("Failed to open file [$PkgReleaseNote\.html].");my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime();my $dateStr = sprintf ("%04u-%02u-%02u", $year + 1900, $mon+1, $mday);my $timeStr = sprintf ("%02u:%02u:%02u", $hour, $min, $sec);my ($i);# lets check to see if our package desc field has been set#if ( "$PkgDesc" eq "" ){LogError("Package description not set. Use setPkgDescription('my description') function.");}# lets get some details for our packagegetRmDetails();# now we need to ensure that our local build file dependencies are# the same as those we have entered in the Release Manager database.checkDependencies();print FILE ("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"\n");print FILE (" \"http://www.w3.org/TR/html4/loose.dtd\">\n");print FILE ("<html>\n");print FILE ("<head>\n");print FILE ("<title>Software Release Note: " ."$PkgName $PkgVersion.$ProjectAcronym</title>\n");print FILE ("</head>\n");print FILE ("<body>\n");print FILE ("<h1><font face=\"Arial\">Software Release Note</h1>\n");print FILE ("<hr>\n");print FILE ("<h2><font face=\"Arial\">Identification</h2>\n");print FILE ("<table width=\"100%\" >\n");print FILE ("<tr>\n");print FILE ("\t<td colspan=\"2\"><font face=\"Arial\">This release can be uniquely identified by,</font></td>\n");print FILE ("</tr>\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"20%\"><font face=\"Arial\"><b>Name:</b></font></td>\n");print FILE ("\t<td width=\"80%\"><font face=\"Arial\">" . $RmPkgDetails->pkg_name() . "</font></td>\n");print FILE ("</tr>\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"20%\"><font face=\"Arial\"><b>Description:</b></font></td>\n");print FILE ("\t<td width=\"80%\"><font face=\"Arial\">" . $RmPkgDetails->pv_description() . "</font></td>\n");print FILE ("</tr>\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"20%\"><font face=\"Arial\"><b>Version:</b></font></td>\n");print FILE ("\t<td width=\"80%\"><font face=\"Arial\">" ."$PkgVersion.$ProjectAcronym" . "</font></td>\n");print FILE ("</tr>\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"20%\"><font face=\"Arial\"><b>Platform:</b></font></td>\n");print FILE ("\t<td width=\"80%\"><font face=\"Arial\">$MachType</font></td>\n");print FILE ("</tr>\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"20%\"><font face=\"Arial\"><b>PkgLabel:</b></font></td>\n");print FILE ("\t<td width=\"80%\"><font face=\"Arial\">$PkgLabel</font></td>\n");print FILE ("</tr>\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"20%\"><font face=\"Arial\"><b>Date:</b></font></td>\n");print FILE ("\t<td width=\"80%\"><font face=\"Arial\">$dateStr $timeStr</font></td>\n");print FILE ("</tr>\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"20%\"><font face=\"Arial\"><b>Correspondence No:</b></font></td>\n");print FILE ("\t<td width=\"80%\"><font face=\"Arial\"> </font></td>\n");print FILE ("</tr>\n");print FILE ("</table>\n");print FILE ("<hr>\n");print FILE ("<h2><font face=\"Arial\">Package Overview</h2>\n");print FILE ("<table width=\"100%\">\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"100%\"><font face=\"Arial\">" . $RmPkgDetails->pv_overview() . "</font></td>\n");print FILE ("</tr>\n");print FILE ("</table>\n");print FILE ("<br>\n");print FILE ("<hr>\n");print FILE ("<h2><font face=\"Arial\">Release Summary</h2>\n");print FILE ("<table width=\"100%\">\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"100%\"><font face=\"Arial\">Reason for this release,</font></td>\n");print FILE ("</tr>\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"100%\"><font face=\"Arial\">" . $RmPkgDetails->pv_reason() . "</font></td>\n");print FILE ("</tr>\n");print FILE ("</table>\n");# here we will list any issues that have been associated with# the package#print FILE ("<br>\n");my ($j);my ($k);my ($m_str) = "";foreach $i ( $RmPkgDetails->getIssueTypes() ){print FILE ("<table width=\"100%\" border=\"1\" cellpadding=\"2\" cellspacing=\"0\" " ."bordercolordark=\"White\" bordercolorlight=\"Black\">\n");print FILE ("<tr>\n");print FILE ("<td colspan=\"6\"><font face=\"Arial\"><b>Issues - $i</b></font></td>\n");print FILE ("</tr>\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"10%\"><font face=\"Arial\"><b>Fixed</b></font></td>\n");print FILE ("\t<td width=\"10%\"><font face=\"Arial\"><b>Issue Id</b></font></td>\n");print FILE ("\t<td width=\"50%\"><font face=\"Arial\"><b>Summary</b></font></td>\n");print FILE ("\t<td width=\"10%\"><font face=\"Arial\"><b>Issue Type</b></font></td>\n");print FILE ("\t<td width=\"10%\"><font face=\"Arial\"><b>Status</b></font></td>\n");print FILE ("\t<td width=\"10%\"><font face=\"Arial\"><b>Priority</b></font></td>\n");print FILE ("</tr>\n");foreach $j ( $RmPkgDetails->getIssueNumbers($i) ){print FILE ("<tr>\n");if ( $RmPkgDetails->iss_state($i, $j) == 1 ){$m_str = "Yes";}else{$m_str = "No";}print FILE ("\t<td width=\"10%\"><font face=\"Arial\">$m_str</font></td>\n");print FILE ("\t<td width=\"10%\"><font face=\"Arial\">" . $RmPkgDetails->iss_numStr($i, $j) . "</font></td>\n");print FILE ("\t<td width=\"50%\"><font face=\"Arial\">" . $RmPkgDetails->iss_summary($i, $j) . "</font></td>\n");print FILE ("\t<td width=\"10%\"><font face=\"Arial\">" . $RmPkgDetails->iss_type($i, $j) . "</font></td>\n");print FILE ("\t<td width=\"10%\"><font face=\"Arial\">" . $RmPkgDetails->iss_status($i, $j) . "</font></td>\n");print FILE ("\t<td width=\"10%\"><font face=\"Arial\">" . $RmPkgDetails->iss_priority($i, $j) . "</font></td>\n");print FILE ("</tr>\n");}print FILE ("</table>\n");}print FILE ("<hr>\n");print FILE ("<h2><font face=\"Arial\">Build Dependencies</h2>\n");print FILE ("<table width=\"100%\">\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"100%\"><font face=\"Arial\">The release was built with the following " ."\"dpkg_archive\" modules,</font></td>\n");print FILE ("</tr>\n");print FILE ("</table>\n");print FILE ("<br>\n");my $depObj;foreach $i ( $RmPkgDetails->getDependencyNames() ){$depObj = $RmPkgDetails->getDependencyObject($i);print FILE ("<h4><font face=\"Arial\">" . $depObj->pkg_name() . " - " . $depObj->pkg_version() . "</h4>\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"100%\"><font face=\"Arial\">Reason for this release,</font></td>\n");print FILE ("</tr>\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"100%\"><font face=\"Arial\">" . $depObj->pv_reason() . "</font></td>\n");print FILE ("</tr>\n");print FILE ("</table>\n");print FILE ("<br><br>\n");foreach $j ( $depObj->getIssueTypes() ){print FILE ("<table width=\"100%\" border=\"1\" cellpadding=\"2\" cellspacing=\"0\" " ."bordercolordark=\"White\" bordercolorlight=\"Black\">\n");print FILE ("<tr>\n");print FILE ("<td colspan=\"6\"><font face=\"Arial\"><b>Issues - $j</b></font></td>\n");print FILE ("</tr>\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"10%\"><font face=\"Arial\"><b>Fixed</b></font></td>\n");print FILE ("\t<td width=\"10%\"><font face=\"Arial\"><b>Issue Id</b></font></td>\n");print FILE ("\t<td width=\"50%\"><font face=\"Arial\"><b>Summary</b></font></td>\n");print FILE ("\t<td width=\"10%\"><font face=\"Arial\"><b>Issue Type</b></font></td>\n");print FILE ("\t<td width=\"10%\"><font face=\"Arial\"><b>Status</b></font></td>\n");print FILE ("\t<td width=\"10%\"><font face=\"Arial\"><b>Priority</b></font></td>\n");print FILE ("</tr>\n");foreach $k ( $depObj->getIssueNumbers($j) ){if ( $depObj->iss_state($j, $k) == 1 ){$m_str = "Yes";}else{$m_str = "No";}print FILE ("\t<td width=\"10%\"><font face=\"Arial\">$m_str</font></td>\n");print FILE ("\t<td width=\"10%\"><font face=\"Arial\">" . $depObj->iss_numStr($j, $k) . "</font></td>\n");print FILE ("\t<td width=\"50%\"><font face=\"Arial\">" . $depObj->iss_summary($j, $k) . "</font></td>\n");print FILE ("\t<td width=\"10%\"><font face=\"Arial\">" . $depObj->iss_type($j, $k) . "</font></td>\n");print FILE ("\t<td width=\"10%\"><font face=\"Arial\">" . $depObj->iss_status($j, $k) . "</font></td>\n");print FILE ("\t<td width=\"10%\"><font face=\"Arial\">" . $depObj->iss_priority($j, $k) . "</font></td>\n");print FILE ("</tr>\n");}print FILE ("</table>\n");print FILE ("<br><br>\n");}print FILE ("</table>\n");}print FILE ("<hr>\n");print FILE ("<h2><font face=\"Arial\">System (Runtime) Dependencies</h2>\n");print FILE ("<table width=\"100%\">\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"100%\"><font face=\"Arial\">The release is dependent and requires the presence of the " ."following modules to operate correctly,</font></td>\n");print FILE ("</tr>\n");print FILE ("</table>\n");print FILE ("<br>\n");print FILE ("<table width=\"100%\" border=\"1\" cellpadding=\"2\" cellspacing=\"0\" " ."bordercolordark=\"White\" bordercolorlight=\"Black\">\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"20%\"><font face=\"Arial\"><b>Package</b></font></td>\n");print FILE ("\t<td width=\"20%\"><font face=\"Arial\"><b>Version</b></font></td>\n");print FILE ("\t<td width=\"60%\"><font face=\"Arial\"><b>Comments</b></font></td>\n");print FILE ("</tr>\n");my ($count) = 0;foreach $i ( $RmPkgDetails->getRtDepNames() ){print FILE ("<tr>\n");print FILE ("\t<td width=\"20%\"><font face=\"Arial\">$i</font></td>\n");print FILE ("\t<td width=\"20%\"><font face=\"Arial\">" . $RmPkgDetails->rt_version($i) . "</font></td>\n");print FILE ("\t<td width=\"60%\"><font face=\"Arial\">" . $RmPkgDetails->rt_comments($i) . "</font></td>\n");print FILE ("</tr>\n");$count++;}# if we have no RTDs lets add an empty row.if ( $count == 0 ){print FILE ("<tr>\n");print FILE ("\t<td width=\"20%\"><font face=\"Arial\"> </font></td>\n");print FILE ("\t<td width=\"20%\"><font face=\"Arial\"> </font></td>\n");print FILE ("\t<td width=\"60%\"><font face=\"Arial\"> </font></td>\n");print FILE ("</tr>\n");}print FILE ("</table>\n");print FILE ("<hr>\n");print FILE ("<h2><font face=\"Arial\">Files</h2>\n");print FILE ("<table width=\"100%\">\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"100%\">\n");print FILE ("\t\t<p><font face=\"Arial\">This release contains the following files,</font></p>\n");print FILE ("\t\t<p><font face=\"Arial\">(Note: checksums are derived using,</font></p>\n");print FILE ("\t\t<ul>\n");print FILE ("\t\t\t<li><font face=\"Arial\">The /usr/bin/cksum utility provided by the Solaris "."8 operating system, or</font></li>\n");print FILE ("<li><font face=\"Arial\">The ~/core_devl/BIN.win32/cksum.exe utility provided "."by the ERG JATS build tools.)</font></li>\n");print FILE ("\t\t</ul>\n");print FILE ("\t</td>\n");print FILE ("</tr>\n");print FILE ("</table>\n");print FILE ("<table width=\"100%\" border=\"1\" cellpadding=\"2\" cellspacing=\"0\" " ."bordercolordark=\"White\" bordercolorlight=\"Black\">\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"60%\"><font face=\"Arial\"><b>Name</b></font></td>\n");print FILE ("\t<td width=\"20%\"><font face=\"Arial\"><b>Size</b></font></td>\n");print FILE ("\t<td width=\"20%\"><font face=\"Arial\"><b>Checksum</b></font></td>\n");print FILE ("</tr>\n");my ($m_cksum, $m_size, $m_rest) = "";if ( "$MachType" eq "sparc" ){my $retStr = `cksum $PkgBaseDir/$PkgOutputFile\.gz`;chomp($retStr);$retStr =~ s/\s+/ /g;($m_cksum, $m_size, $m_rest) = split / /,$retStr;$m_cksum =~ s/\s+//g;$m_size =~ s/\s+//g;print FILE ("<tr>\n");print FILE ("\t<td width=\"60%\"><font face=\"Arial\">$PkgOutputFile\.gz</font></td>\n");print FILE ("\t<td width=\"20%\"><font face=\"Arial\">$m_size (bytes)</font></td>\n");print FILE ("\t<td width=\"20%\"><font face=\"Arial\">$m_cksum</font></td>\n");print FILE ("</tr>\n");}else{print FILE ("<tr>\n");print FILE ("\t<td width=\"60%\"><font face=\"Arial\"> </font></td>\n");print FILE ("\t<td width=\"20%\"><font face=\"Arial\"> </font></td>\n");print FILE ("\t<td width=\"20%\"><font face=\"Arial\"> </font></td>\n");print FILE ("</tr>\n");}print FILE ("</table>\n");print FILE ("<hr>\n");print FILE ("<h2><font face=\"Arial\">Installation Instructions</h2>\n");print FILE ("<table width=\"100%\">\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"100%\"><font face=\"Arial\">Please follow the instructions described below " ."when attempting to install the package,</font></td>\n");print FILE ("</tr>\n");print FILE ("</table>\n");print FILE ("<br>\n");print FILE ("<table width=\"100%\" border=\"1\" cellpadding=\"2\" cellspacing=\"0\" " ."bordercolordark=\"White\" bordercolorlight=\"Black\">\n");if ( "$MachType" eq "sparc" ){print FILE ("<tr>\n");print FILE ("\t<td width=\"5%\"><font face=\"Arial\"><b>1.</b></font></td>\n");print FILE ("\t<td width=\"95%\"><font face=\"Arial\">" ."Ensure the previous package has been removed by using the " ."\'pkginfo -l $PkgName\' command. " ."If the command returns that a package is cuurently installed you will " ."need to remove it by executing the \'pkgrm $PkgName\' command. " ."</font></td>\n");print FILE ("</tr>\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"5%\"><font face=\"Arial\"><b>2.</b></font></td>\n");print FILE ("\t<td width=\"95%\"><font face=\"Arial\">" ."Copy the new package \'$PkgOutputFile\.gz\' into the " ."'/tmp' directory as the 'root' user. " ."Uncompress the package (i.e. \'gzip -d $PkgOutputFile\.gz\')." ."</font></td>\n");print FILE ("</tr>\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"5%\"><font face=\"Arial\"><b>3.</b></font></td>\n");print FILE ("\t<td width=\"95%\"><font face=\"Arial\">" ."Install the package as the 'root' user (i.e. execute the following command " ."\'pkgadd -d $PkgOutputFile\'), providing all the information " ."required during the package install." ."</font></td>\n");print FILE ("</tr>\n");}else{print FILE ("<tr>\n");print FILE ("\t<td width=\"5%\"><font face=\"Arial\"><b>1.</b></font></td>\n");print FILE ("\t<td width=\"95%\"><font face=\"Arial\">" ."Ensure the previous package has been removed by using the Add-Remove " ."programs option in the Control Panel. " ."</font></td>\n");print FILE ("</tr>\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"5%\"><font face=\"Arial\"><b>2.</b></font></td>\n");print FILE ("\t<td width=\"95%\"><font face=\"Arial\">" ."Copy the installer into the /temp directory as a user with Administrator " ."privileges." ."</font></td>\n");print FILE ("</tr>\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"5%\"><font face=\"Arial\"><b>3.</b></font></td>\n");print FILE ("\t<td width=\"95%\"><font face=\"Arial\">" ."Execute the package and follow the prompts." ."</font></td>\n");print FILE ("</tr>\n");}print FILE ("</table>\n");print FILE ("<hr>\n");print FILE ("<h2><font face=\"Arial\">Additional Notes</h2>\n");print FILE ("<p><font face=\"Arial\">None</p>\n");print FILE ("<hr>\n");print FILE ("<h2><font face=\"Arial\">Dependency History</h2>\n");# lets check to see if we got somethingif ( $RmPkgDetails->foundPkg() ){if ( $RmPvPkgDetails->foundDetails() != 0 && $RmPvPkgDetails->pv_id() != $RmPkgDetails->pv_id() ){print FILE ("<table width=\"100%\">\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"100%\"><font face=\"Arial\">The table below describes the differences between " ."$PkgName $PkgVersionUser and " ."$PkgPreviousVersionStr,</font></td>\n");print FILE ("</tr>\n");print FILE ("</table>\n");print FILE ("<br>\n");print FILE ("<table width=\"100%\" border=\"1\" cellpadding=\"2\" cellspacing=\"0\" " ."bordercolordark=\"White\" bordercolorlight=\"Black\">\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"30%\"><font face=\"Arial\"><b>Dependency</b></font></td>\n");print FILE ("\t<td width=\"30%\"><font face=\"Arial\"><b>Status</b></font></td>\n");print FILE ("\t<td width=\"40%\"><font face=\"Arial\"><b>Previous Version</b></font></td>\n");print FILE ("</tr>\n");my $PvDepObj;foreach $i ( $RmPkgDetails->getDependencyNames() ){$PvDepObj = $RmPvPkgDetails->getDependencyObject($i);if ( defined($PvDepObj) ){if ( $PvDepObj->pkg_version() ne $RmPkgDetails->getDependencyObject($i)->pkg_version() ){print FILE ("<tr>\n");print FILE ("\t<td width=\"30%\"><font face=\"Arial\">$i</font></td>\n");print FILE ("\t<td width=\"30%\"><font face=\"Arial\">Updated</font></td>\n");print FILE ("\t<td width=\"40%\"><font face=\"Arial\">" . $PvDepObj->pkg_version() . "</font></td>\n");print FILE ("</tr>\n");}}else{print FILE ("<tr>\n");print FILE ("\t<td width=\"30%\"><font face=\"Arial\">$i</font></td>\n");print FILE ("\t<td width=\"30%\"><font face=\"Arial\">New</font></td>\n");print FILE ("\t<td width=\"40%\"><font face=\"Arial\"> </font></td>\n");print FILE ("</tr>\n");}}print FILE ("</table>\n");}else{print FILE ("<p><font face=\"Arial\">No history available.</p>\n");}}print FILE ("<hr>\n");print FILE ("<h2><font face=\"Arial\">Approval</h2>\n");print FILE ("<table width=\"100%\">\n");print FILE ("<tr>\n");print FILE ("\t<td colspan=\"4\"><font face=\"Arial\">This release requires the signature of the " ."following persons for approval,</font></td>\n");print FILE ("</tr>\n");print FILE ("</table>\n");print FILE ("<br>\n");print FILE ("<table width=\"100%\" border=\"1\" cellpadding=\"2\" cellspacing=\"0\" " ."bordercolordark=\"White\" bordercolorlight=\"Black\">\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"25%\"><font face=\"Arial\"><b>Tile</b></font></td>\n");print FILE ("\t<td width=\"25%\"><font face=\"Arial\"><b>Name</b></font></td>\n");print FILE ("\t<td width=\"25%\"><font face=\"Arial\"><b>Signature</b></font></td>\n");print FILE ("\t<td width=\"25%\"><font face=\"Arial\"><b>Date</b></font></td>\n");print FILE ("</tr>\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"25%\"><font face=\"Arial\">Software Engineer</font></td>\n");print FILE ("\t<td width=\"25%\"><font face=\"Arial\">$Username</font></td>\n");print FILE ("\t<td width=\"25%\"><font face=\"Arial\"> </font></td>\n");print FILE ("\t<td width=\"25%\"><font face=\"Arial\">$dateStr</font></td>\n");print FILE ("</tr>\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"25%\"><font face=\"Arial\">Team Leader</font></td>\n");print FILE ("\t<td width=\"25%\"><font face=\"Arial\"> </font></td>\n");print FILE ("\t<td width=\"25%\"><font face=\"Arial\"> </font></td>\n");print FILE ("\t<td width=\"25%\"><font face=\"Arial\"> </font></td>\n");print FILE ("</tr>\n");print FILE ("<tr>\n");print FILE ("\t<td width=\"25%\"><font face=\"Arial\">Manager</font></td>\n");print FILE ("\t<td width=\"25%\"><font face=\"Arial\"> </font></td>\n");print FILE ("\t<td width=\"25%\"><font face=\"Arial\"> </b></font></td>\n");print FILE ("\t<td width=\"25%\"><font face=\"Arial\"> </font></td>\n");print FILE ("</tr>\n");print FILE ("</table>\n");print FILE ("</head>\n");print FILE ("</body>\n");printf FILE ("</html>\n");# done.close FILE;LogNorm("Generated HTML Release note [$PkgReleaseNote\.html]");return 1;}#------------------------------------------------------------------------------sub checkDependencies##------------------------------------------------------------------------------{my ($i);my ($retValue) = 0;# first we want to loop through all our local build archives#my ($versionStr) = "";foreach $i ( $BuildFileInfo->getDpkgArchiveList() ){if ( "$i" eq "ishieldlibimg"|| "$i" eq "ishieldlibicon"|| "$i" eq "ishieldmodules"|| "$i" eq "deployfiles" ){# these three packages are a special case,# we do not include them in the dependecy check## This is BAD and should be removed.# We do have a dependancy ! Lets be honest about it.#next;}my $moduleInfo = $BuildFileInfo->getDpkgArchiveInfo($i);$versionStr = "$moduleInfo->{version}";$versionStr .= "\.$moduleInfo->{proj}" if ( $moduleInfo->{proj} ne "" );my $depObj = $RmPkgDetails->getDependencyObject($i);if ( defined ( $depObj ) ){if ( $depObj->pkg_version() ne "$versionStr" ){LogWarn("Dependency difference, [$i] local version $versionStr, RM version " . $depObj->pkg_version());$retValue = 1;}}else{LogWarn("Dependency difference, cannot locate archive [$i] in Release Manager database.");$retValue = 1;}}# lets check to see if we detected a differenceif ( $retValue != 0 ){LogError("Difference detected between the local build.pl and Release Manager config. " ."Please check Release Manager configuration.");}# now we check release manager details against our local ones#foreach $i ( $RmPkgDetails->getDependencyNames() ){if ( "$i" eq "ishieldlibimg" || "$i" eq "ishieldlibicon" ){# these two packages are a special case,# we do not include them in the dependecy check#next;}my $moduleInfo = $BuildFileInfo->getDpkgArchiveInfo($i);if ( defined ( $moduleInfo ) ){$versionStr = "$moduleInfo->{version}";$versionStr .= "\.$moduleInfo->{proj}" if ( $moduleInfo->{proj} ne "" );my $depObj = $RmPkgDetails->getDependencyObject($i);if ( $depObj->pkg_version() ne "$versionStr" ){LogWarn("Dependency difference, [$i] local version $versionStr, RM version " . $depObj->pkg_version());$retValue = 1;}}else{LogWarn("Dependency difference, cannot locate archive [$i] in local build.pl.");$retValue = 1;}}# lets check to see if we detected a differenceif ( $retValue != 0 ){LogError("Difference detected between Release Manager config and the local build.pl. " ."Please check the local configuration.");}return 1;}#------------------------------------------------------------------------------sub createPerlSvcWin32## Description:# This sub-routine is used to create a Win32 service# using a PERL script as the input.## note we assume here that you have installed ther ActiveState PERL# developement KIT and have also installed a valid license key.##------------------------------------------------------------------------------{# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "win32" ){LogNorm("createPerlSvcWin32() not supported on this machine type.");return 1;}my ($m_srcDirTag, $m_sfile, $m_targetDirTag, $m_ofile, @m_libDirTags) = @_;# lets get the src dir valuemy ($m_targetDirValue) = getTargetDstDirValue($m_targetDirTag, "A");# lets get the lib src dir valuemy (@m_libDirValue) = ();my $i;my ($_libStr) = "";foreach $i ( 0 .. $#m_libDirTags ){$m_libDirValue[$i] = getLocalDirValue($m_libDirTags[$i], "A");$_libStr = $_libStr . "$m_libDirValue[$i];"}if ( -d $DpkgScriptsDir ){$_libStr = $_libStr . "$DpkgScriptsDir";}LogNorm("additional places to look for perl modules, [$_libStr]");# lets get the target dir valuemy ($m_srcDirValue) = getLocalDirValue($m_srcDirTag, "A");# we know where we are getting this from and where we# going to put them.my ($m_sfileLoc) = "$m_srcDirValue/$m_sfile";my ($_cmdStr) = "perlsvc --verbose --lib $_libStr --exe $m_targetDirValue/$m_ofile $m_sfileLoc";# lets execute the package commands.my ($retVal);$retVal = system("$_cmdStr");if ( $retVal != 0 ){LogError("Failed to complete command [$_cmdStr].");}# done.return 1;}#------------------------------------------------------------------------------sub createPerlAppWin32## Description:# This sub-routine is used to create a Win32 free-standing application# using a PERL script as the input.## note we assume here that you have installed ther ActiveState PERL# developement KIT and have also installed a valid license key.##------------------------------------------------------------------------------{# lets just check to see if we can execute this function on# this machine.#if ( "$MachType" ne "win32" ){LogNorm("createPerlAppWin32() not supported on this machine type.");return 1;}my ($m_srcDirTag, $m_sfile, $m_targetDirTag, $m_ofile, @m_libDirTags) = @_;# lets get the src dir valuemy ($m_targetDirValue) = getTargetDstDirValue($m_targetDirTag, "A");# lets get the lib src dir valuemy (@m_libDirValue) = ();my $i;my ($_libStr) = "";foreach $i ( 0 .. $#m_libDirTags ){$m_libDirValue[$i] = getLocalDirValue($m_libDirTags[$i], "A");$_libStr = $_libStr . "$m_libDirValue[$i];"}if ( -d $DpkgScriptsDir ){$_libStr = $_libStr . "$DpkgScriptsDir";}LogNorm("additional places to look for perl modules, [$_libStr]");# lets get the target dir valuemy ($m_srcDirValue) = getLocalDirValue($m_srcDirTag, "A");# we know where we are getting this from and where we# going to put them.my ($m_sfileLoc) = "$m_srcDirValue/$m_sfile";my ($_cmdStr) = "perlapp --verbose --clean --force --lib $_libStr --exe $m_targetDirValue/$m_ofile --script $m_sfileLoc";# lets execute the package commands.my ($retVal);$retVal = system("$_cmdStr");if ( $retVal != 0 ){LogError("Failed to complete command [$_cmdStr].");}# done.return 1;}#------------------------------------------------------------------------------sub generateProductContents##------------------------------------------------------------------------------{if ( ! defined($RmPkgDetails) ){# Set defaults for elements in RM if not foundDeployUtils::RmPkgInfo->DefaultDescription($PkgDesc);DeployUtils::RmPkgInfo->DefaultLabel($PkgLabel);$RmPkgDetails = DeployUtils::RmPkgInfo->new({PKG_NAME => $PkgName,PKG_VERSION => ( "$PkgPatchNum" ne "" ) ? $PkgPatchID : $PkgVersionUser} );}# we only go on if we have a pkgif ( $RmPkgDetails->foundPkg() ){# lets zap the product contents# only if the release manager entry is not locked.if ( $RmPkgDetails->pv_dlocked() ne "Y" ){LogError("Failed to zap product contents.")if ( ! $RmPkgDetails->zapProductContents( $Platform ) );}# lets get a listing of the products contents#File::Find::find( \&ProductContentsFind, "$PkgBaseDir/$TargetBaseDir");}else{LogWarn("Unable to load product contents because we do not have a connection to Release Manager.");}# donereturn 1;}#------------------------------------------------------------------------------sub ProductContentsFind## Description:# This subroutine is used to locate all associated items that# have been designated for the product.##------------------------------------------------------------------------------{my($item)= "$File::Find::name";my($base)= File::Basename::basename($item);# we get the absolute path from the find, but we only require# a relative path from the starting dir.my ($_item) = $item;my ($_subStr) = "$PkgBaseDir\/$TargetBaseDir";$_item =~ s/$_subStr//;my $cksumStr;my $cksumValue;my $cksumSize;my $cksumName;my $_tmpStr;my $retVal;my $cksumPath;if ( "$base" ne "." && "$base" ne ".." && "x$_item" ne "x" ){$_item =~ s/^\///;$cksumPath = $_item;$cksumName = File::Basename::basename($_item);# we need to determine which file we are dealing withif ( ! -d "$item"){$cksumStr = `cksum "$item"`;$retVal = $? / 256;if ( $retVal != 0 ){LogError("Failed to determine cksum for product content item [$item].")}else{chomp($cksumStr);$cksumStr =~ s/^\s+|\s+$//g;if ( $cksumStr =~ m/^([0-9]*)\s*([0-9]*)\s*(.*)$/ ){($cksumValue, $cksumSize, $_tmpStr) = ($1, $2, $3);$cksumValue =~ s/^\s+|\s+$//g;$cksumSize =~ s/^\s+|\s+$//g;$_tmpStr =~ s/^\s+|\s+$//g;}else{$cksumValue = '';$cksumSize = 0;$_tmpStr = '';}}$cksumPath = File::Basename::dirname($_item);if ( $cksumPath eq "." ){$cksumPath = '';}else{$cksumPath =~ s/$/\//;}# we only mess with the product contents# if the package is not released.if ( $RmPkgDetails->pv_dlocked() ne "Y" ){LogError("Failed to insert product content item.")if ( ! $RmPkgDetails->insertProductContentItem( $Target, $cksumPath, $cksumName, '', $cksumSize, $cksumValue) );}else{LogInfo("product item - $Target, $cksumPath, $cksumName, '', $cksumSize, $cksumValue");}}else{$cksumPath =~ s/$/\//;if ( $RmPkgDetails->pv_dlocked() ne "Y" ){LogError("Failed to insert product content item.")if ( ! $RmPkgDetails->insertProductContentItem( $Target, $cksumPath, '', '', 0, '') );}else{LogInfo("product dir - $Target, $cksumPath, '', '', 0, ''");}}}}#------------------------------------------------------------------------------1;