WebSVN – DevTools – Blame – /debian_packager/branches/alewis_packagedbg/src/tools/scripts/DebianPackager.pl

Rev	Author	Line No.	Line
407	dpurdie	1	`########################################################################`
3921	dpurdie	2	`# Copyright (C) 1998-2013 Vix Technology, All rights reserved`
407	dpurdie	3	`#`
3921	dpurdie	4	`# Module name : DebianPackager.pl`
407	dpurdie	5	`# Module type : Makefile system`
3921	dpurdie	6	`# Compiler(s) : Perl`
407	dpurdie	7	`# Environment(s): jats`
		8	`#`
		9	`# Description : This program is invoked by the MakeDebianPackage`
		10	`# directive, that is a part of this package`
		11	`#`
		12	`# The program will use a user-provided script in order`
		13	`# to create a Debian Package.`
		14	`#`
		15	`# The user script may call a number of directives in order to`
		16	`# construct an image of the package being installed.`
		17	`#`
		18	`# The script specifies Debian configuration scaripts that`
		19	`# will be embedded in the package.`
		20	`#`
		21	`# This program will:`
		22	`# Construct a filesystem image under control of the directives`
		23	`# within the user script`
		24	`#`
		25	`# Massage the Debian control file`
		26	`#`
		27	`# Create a Debian Package`
		28	`#`
		29	`# Transfer it to the users 'BIN' directory, where it is`
		30	`# available to be packaged.`
		31	`#`
		32	`# Summary of directives available to the user-script:`
		33	`# AddInitScript - Add an init script`
		34	`# CatFile - Append to a file`
		35	`# CopyDir - Copy directory tree`
		36	`# CopyFile - Copy a file`
		37	`# CopyBinFile - Copy an executable file`
		38	`# CopyLibFile - Copy a library file`
		39	`# CreateDir - Create a directory`
		40	`# DebianFiles - Specify control and script files`
4636	dpurdie	41	`# DebianControlFile - Specify control and script files`
		42	`# DebianDepends - Add Depends entry to control file`
407	dpurdie	43	`# EchoFile - Place text into a file`
		44	`# MakeSymLink - Create a symbolic link`
		45	`# PackageDescription - Specify the package description`
		46	`# SetFilePerms - Set file permissions`
		47	`# SetVerbose - Control progress display`
		48	`# IsProduct - Flow control`
		49	`# IsPlatform - Flow control`
		50	`# IsTarget - Flow control`
427	dpurdie	51	`# IsVariant - Flow control`
407	dpurdie	52	`#`
		53	`# Thoughts for expansion:`
		54	`# ConvertFile - Option to convert file(s) to Unix Text`
		55	`# ReplaceTags - Replace Tags on target file`
		56	`# SrcDir - Extend path for resolving local files`
		57	`#`
		58	`# Less used:`
		59	`# ExpandLinkFiles - Expand .LINK files`
		60	`#`
		61	`# Internal Use:`
		62	`# FindFiles - Find a file`
		63	`# ResolveFile - Resolve a 'local' source file`
		64	`#`
		65	`#......................................................................#`
		66
411	dpurdie	67	`require 5.006_001;`
407	dpurdie	68	`use strict;`
		69	`use warnings;`
		70
		71	`use Getopt::Long;`
		72	`use File::Path;`
		73	`use File::Copy;`
		74	`use File::Find;`
		75	`use JatsSystem;`
		76	`use FileUtils;`
		77	`use JatsError;`
4636	dpurdie	78	`use JatsLocateFiles;`
407	dpurdie	79	`use ReadBuildConfig;`
423	dpurdie	80	`use JatsCopy (); # Don't import anything`
407	dpurdie	81
		82	`#`
		83	`# Globals`
		84	`#`
425	dpurdie	85	`my $DebianWorkDirBase; # Workspace`
407	dpurdie	86	`my $DebianWorkDir; # Dir to create file system image within`
		87
		88	`#`
		89	`# Command line options`
		90	`#`
		91	`my $opt_debug = $ENV{'GBE_DEBUG'}; # Allow global debug`
		92	`my $opt_verbose = $ENV{'GBE_VERBOSE'}; # Allow global verbose`
		93	`my $opt_vargs; # Verbose arg`
		94	`my $opt_help = 0;`
		95	`my $opt_manual = 0;`
		96	`my $opt_clean = 0;`
		97	`my $opt_platform;`
		98	`my $opt_type;`
		99	`my $opt_buildname;`
		100	`my $opt_buildversion;`
		101	`my $opt_interfacedir;`
		102	`my $opt_target;`
		103	`my $opt_product;`
		104	`my $opt_package_script;`
		105	`my $opt_interfaceincdir;`
		106	`my $opt_interfacelibdir;`
		107	`my $opt_interfacebindir;`
		108	`my $opt_libdir;`
		109	`my $opt_bindir;`
		110	`my $opt_localincdir;`
		111	`my $opt_locallibdir;`
		112	`my $opt_localbindir;`
		113	`my $opt_pkgdir;`
		114	`my $opt_pkglibdir;`
		115	`my $opt_pkgbindir;`
		116	`my $opt_pkgpkgdir;`
		117	`my $opt_output;`
417	dpurdie	118	`my $opt_name;`
427	dpurdie	119	`my $opt_variant;`
3921	dpurdie	120	`my $opt_pkgarch;`
407	dpurdie	121
		122	`#`
		123	`# Options derived from script directives`
		124	`#`
		125	`my $opt_description;`
		126
415	dpurdie	127	`#`
		128	`# Globals`
		129	`#`
		130	`my @ResolveFileList; # Cached Package File List`
		131	`my @ResolveBinFileList; # Cached PackageBin File List`
		132	`my @ResolveLibFileList; # Cached PackageLib File List`
4635	dpurdie	133	`my %DebianControlFiles; # Control Files`
		134	`my %DebianControlFileNames; # Control Files by name`
		135	`my @DependencyList; # Package Dependencies`
407	dpurdie	136
		137	`#-------------------------------------------------------------------------------`
		138	`# Function : Main Entry point`
		139	`#`
		140	`# Description : This function will be called when the package is initialised`
		141	`# Extract arguments from the users environment`
		142	`#`
		143	`# Done here to greatly simplify the user script`
		144	`# There should be no junk in the user script - keep it simple`
		145	`#`
		146	`# Inputs :`
		147	`#`
		148	`# Returns :`
		149	`#`
		150	`main();`
		151	`sub main`
		152	`{`
		153	`my $result = GetOptions (`
		154	`"verbose:s" => \$opt_vargs,`
		155	`"clean" => \$opt_clean,`
		156	`"Type=s" => \$opt_type,`
4105	dpurdie	157	`"BuildName=s" => \$opt_buildname, # Raw Jats Package Name (Do not use)`
		158	`"Name=s" => \$opt_name, # Massaged Debian Package Name`
407	dpurdie	159	`"BuildVersion=s" => \$opt_buildversion,`
		160	`"Platform=s" => \$opt_platform,`
		161	`"Target=s" => \$opt_target,`
		162	`"Product=s" => \$opt_product,`
		163	`"DebianPackage=s" => \$opt_package_script,`
		164	`"InterfaceDir=s" => \$opt_interfacedir,`
		165	`"InterfaceIncDir=s" => \$opt_interfaceincdir,`
		166	`"InterfaceLibDir=s" => \$opt_interfacelibdir,`
		167	`"InterfaceBinDir=s" => \$opt_interfacebindir,`
		168	`"LibDir=s" => \$opt_libdir,`
		169	`"BinDir=s" => \$opt_bindir,`
		170	`"LocalIncDir=s" => \$opt_localincdir,`
		171	`"LocalLibDir=s" => \$opt_locallibdir,`
		172	`"LocalBinDir=s" => \$opt_localbindir,`
		173	`"PackageDir=s" => \$opt_pkgdir,`
		174	`"PackageLibDir=s" => \$opt_pkglibdir,`
		175	`"PackageBinDir=s" => \$opt_pkgbindir,`
		176	`"PackagePkgDir=s" => \$opt_pkgpkgdir,`
		177	`"Output=s" => \$opt_output,`
427	dpurdie	178	`"Variant:s" => \$opt_variant,`
3921	dpurdie	179	`"PkgArch:s" => \$opt_pkgarch,`
407	dpurdie	180	`);`
		181	`$opt_verbose++ unless ( $opt_vargs eq '@' );`
		182
		183	`ErrorConfig( 'name' => 'DebianUtils',`
		184	`'verbose' => $opt_verbose,`
		185	`'debug' => $opt_debug );`
		186
		187	`#`
		188	`# Init the FileSystem Uiltity interface`
		189	`#`
		190	`InitFileUtils();`
		191
		192	`#`
		193	`# Ensure that we have all required options`
		194	`#`
		195	`Error ("Platform not set") unless ( $opt_platform );`
		196	`Error ("Type not set") unless ( $opt_type );`
		197	`Error ("BuildName not set") unless ( $opt_buildname );`
4105	dpurdie	198	`Error ("Debian Package Name not set") unless ( $opt_name );`
407	dpurdie	199	`Error ("BuildVersion not set") unless ( $opt_buildversion );`
		200	`Error ("InterfaceDir not set") unless ( $opt_interfacedir );`
		201	`Error ("Target not set") unless ( $opt_target );`
		202	`Error ("Product not set") unless ( $opt_product );`
		203	`Error ("DebianPackage not set") unless ( $opt_package_script );`
		204	`Error ("Ouput File not set") unless ( $opt_output );`
		205
		206	`#`
		207	`# Read in relevent config information`
		208	`#`
		209	`ReadBuildConfig ($opt_interfacedir, $opt_platform, '--NoTest' );`
		210
		211	`#`
		212	`# Build the package image in a directory based on the target being created`
		213	`#`
425	dpurdie	214	`$DebianWorkDirBase = "$opt_platform$opt_type.image";`
		215	`$DebianWorkDir = "$DebianWorkDirBase/$opt_name";`
407	dpurdie	216
		217	`#`
		218	`# Configure the System command to fail on any error`
		219	`#`
		220	`SystemConfig ( ExitOnError => 1 );`
		221
		222	`#`
		223	`# Extract the 'name' of the package from the output path`
		224	`# Display purposes only`
		225	`#`
		226	`my $DebianPkgName = StripDirExt($opt_output);`
		227
		228	`#`
		229	`# Display variables used`
		230	`#`
		231	`Message "=Building Debian Package =============================================";`
417	dpurdie	232	`Message "Build $opt_name";`
407	dpurdie	233	`Message " Package: $opt_buildname";`
427	dpurdie	234	`Message " Variant: $opt_variant" if ($opt_variant);`
407	dpurdie	235	`Message " Version: $opt_buildversion";`
		236	`Message " Building for: $opt_platform, $opt_target";`
		237	`Message " Product: $opt_product";`
		238	`Message " Type: $opt_type";`
3921	dpurdie	239	`Message " Pkg Arch: $opt_pkgarch" if ($opt_pkgarch);`
407	dpurdie	240	`Verbose " Verbose: $opt_verbose";`
		241	`Verbose " InterfaceDir: $opt_interfacedir";`
		242	`Message " Package: $DebianPkgName";`
		243	`Message "======================================================================";`
		244
		245	`#`
3921	dpurdie	246	`# Defaults`
		247	`#`
		248	`$opt_pkgarch = $opt_platform unless ( $opt_pkgarch );`
		249
		250	`#`
407	dpurdie	251	`# Perform Clean up`
		252	`# Invoked during "make clean" or "make clobber"`
		253	`#`
		254	`if ( $opt_clean )`
		255	`{`
		256	`Message ("Remove packaging directory: $DebianWorkDir");`
425	dpurdie	257
		258	`#`
		259	`# Remove the directory for this package`
		260	`# Remove the general work dir - if all packages have been cleaned`
		261	`#`
407	dpurdie	262	`rmtree( $DebianWorkDir );`
425	dpurdie	263	`rmdir( $DebianWorkDirBase );`
407	dpurdie	264	`rmtree ($opt_output) if ( -f $opt_output );`
		265	`exit;`
		266	`}`
		267
		268	`#`
		269	`# Clean out the WORK directory`
		270	`# Always start with a clean slate`
		271	`#`
		272	`# Ensure that the base of the directory tree does not have 'setgid'`
		273	`# This will upset the debian packager`
		274	`# This may be an artifact from the users directory and not expected`
		275	`#`
		276	`rmtree( $DebianWorkDir );`
		277	`mkpath( $DebianWorkDir );`
		278
		279	`my $perm = (stat $DebianWorkDir)[2] & 0777;`
		280	`chmod ( $perm & 0777, $DebianWorkDir );`
		281
		282	`#`
		283	`# Invoke the user script to do the hard work`
		284	`#`
4139	dpurdie	285	`unless (my $return = do $opt_package_script) {`
		286	`Error ("Couldn't parse $opt_package_script: $@") if $@;`
		287	`Error ("Couldn't do $opt_package_script: $!") unless defined $return;`
		288	`}`
407	dpurdie	289
		290	`#`
		291	`# Complete the building of the package`
		292	`#`
		293	`BuildDebianPackage ();`
		294	`Message ("Created Debian Package");`
		295	`}`
		296
		297	`#-------------------------------------------------------------------------------`
		298	`# Function : BuildDebianPackage`
		299	`#`
		300	`# Description : This function will create the Debian Package`
		301	`# and transfer it to the target directory`
		302	`#`
		303	`# Inputs : None`
		304	`#`
		305	`# Returns : Nothing`
		306	`#`
		307	`sub BuildDebianPackage`
		308	`{`
		309	`Error ("BuildDebianPackage: No Control File or Package Description")`
4635	dpurdie	310	`unless ( exists($DebianControlFiles{'control'}) \|\| $opt_description );`
407	dpurdie	311
		312	`#`
		313	`# Convert the FileSystem Image into a Debian Package`
		314	`# Insert Debian control files`
		315	`#`
		316	`Verbose ("Copy in the Debian Control Files");`
		317	`mkdir ( "$DebianWorkDir/DEBIAN" );`
		318
4635	dpurdie	319	`#`
		320	`# Copy in all the named Debian Control files`
		321	`# Ignore any control file. It will be done next`
		322	`#`
		323	`foreach my $key ( keys %DebianControlFiles )`
		324	`{`
		325	`next if ($key eq 'control');`
		326	`CopyFile ( $DebianControlFiles{$key}, "/DEBIAN", $key );`
		327	`}`
		328
		329	`#`
		330	`# Massage the 'control' file`
		331	`#`
		332	`UpdateControlFile ($DebianControlFiles{'control'} );`
407	dpurdie	333
4635	dpurdie	334	`#`
		335	`# Mark all files in the debian folder as read-execute`
		336	`#`
407	dpurdie	337	`System ( 'chmod', '-R', 'a+rx', "$DebianWorkDir/DEBIAN" );`
		338	`System ( 'build_dpkg.sh', '-b', $DebianWorkDir);`
		339	`System ( 'mv', '-f', "$DebianWorkDir.deb", $opt_output );`
		340
		341	`System ("build_dpkg.sh", '-I', $opt_output) if (IsVerbose(1));`
		342
		343	`}`
		344
		345	`#-------------------------------------------------------------------------------`
		346	`# Function : UpdateControlFile`
		347	`#`
4188	dpurdie	348	`# Description : Update the Debian 'control' file to fix up various fields`
407	dpurdie	349	`# within the file.`
		350	`#`
		351	`# If the files has not been specified, then a basic control`
		352	`# file will be provided.`
		353	`#`
		354	`# This routine knows where the control file will be placed`
		355	`# within the output work space.`
		356	`#`
		357	`# Inputs : $src - Path to source file`
		358	`# Uses global variables`
		359	`#`
		360	`# Returns : Nothing`
		361	`#`
		362	`sub UpdateControlFile`
		363	`{`
		364	`my($src) = @_;`
		365	`my $dst = "$DebianWorkDir/DEBIAN/control";`
		366
		367	`unless ( $src )`
		368	`{`
		369	`CreateControlFile();`
		370	`return;`
		371	`}`
		372
4635	dpurdie	373	`#`
		374	`# User has provided a control file`
		375	`# Tweak the internals`
		376	`#`
407	dpurdie	377	`Verbose ("UpdateControlFile: $dst" );`
		378	`$src = ResolveFile( 0, $src );`
		379
4635	dpurdie	380	`# Calc depends line`
4636	dpurdie	381	`my $depData = join (', ', @DependencyList );`
4635	dpurdie	382
		383	`open (SF, '<', $src) \|\| Error ("UpdateControlFile: Cannot open:$src, $!");`
		384	`open (DF, '>', $dst) \|\| Error ("UpdateControlFile: Cannot create:$dst, $!");`
407	dpurdie	385	`while ( <SF> )`
		386	`{`
		387	`s~\s*$~~;`
		388	`if ( m~^Package:~ ) {`
4105	dpurdie	389	`$_ = "Package: $opt_name";`
407	dpurdie	390
		391	`} elsif ( m~^Version:~ ) {`
		392	`$_ = "Version: $opt_buildversion";`
		393
		394	`} elsif ( m~^Architecture:~ ) {`
3921	dpurdie	395	`$_ = "Architecture: $opt_pkgarch";`
407	dpurdie	396
		397	`} elsif ( $opt_description && m~^Description:~ ) {`
		398	`$_ = "Description: $opt_description";`
4635	dpurdie	399
		400	`} elsif ( m~^Depends:~ ) {`
		401	`$_ = "Depends: $depData";`
		402	`$depData = '';`
407	dpurdie	403	`}`
		404	`print DF $_ , "\n";`
		405	`}`
4635	dpurdie	406
407	dpurdie	407	`close (SF);`
		408	`close (DF);`
4635	dpurdie	409
		410	`#`
		411	`# Warn if Depends section is needed`
		412	`#`
		413	`Error ("No Depends section seen in user control file")`
		414	`if ($depData);`
407	dpurdie	415	`}`
		416
		417	`#-------------------------------------------------------------------------------`
		418	`# Function : CreateControlFile`
		419	`#`
		420	`# Description : Craete a basic debian control file`
		421	`#`
		422	`# Inputs : Uses global variables`
		423	`#`
		424	`# Returns :`
		425	`#`
		426	`sub CreateControlFile`
		427	`{`
		428	`my $dst = "$DebianWorkDir/DEBIAN/control";`
		429
		430	`Verbose ("CreateControlFile: $dst" );`
		431
4636	dpurdie	432	`my $depData = join (', ', @DependencyList );`
4635	dpurdie	433
407	dpurdie	434	`open (DF, '>', $dst) \|\| Error ("CreateControlFile: Cannot create:$dst");`
4105	dpurdie	435	`print DF "Package: $opt_name\n";`
407	dpurdie	436	`print DF "Version: $opt_buildversion\n";`
		437	`print DF "Section: main\n";`
		438	`print DF "Priority: standard\n";`
3921	dpurdie	439	`print DF "Architecture: $opt_pkgarch\n";`
		440	`print DF "Essential: No\n";`
		441	`print DF "Maintainer: Vix Technology\n";`
407	dpurdie	442	`print DF "Description: $opt_description\n";`
4635	dpurdie	443	`print DF "Depends: $depData\n" if ($depData);`
		444
407	dpurdie	445	`close (DF);`
		446	`}`
		447
		448	`#-------------------------------------------------------------------------------`
		449	`# Function : SetVerbose`
		450	`#`
		451	`# Description : Set the level of verbosity`
		452	`# Display activity`
		453	`#`
		454	`# Inputs : Verbosity level`
		455	`# 0 - Use makefile verbosity (Default)`
		456	`# 1..2`
		457	`#`
		458	`# Returns :`
		459	`#`
		460	`sub SetVerbose`
		461	`{`
		462	`my ($level) = @_;`
		463
		464	`$level = $opt_verbose unless ( $level );`
		465	`$opt_verbose = $level;`
		466	`ErrorConfig( 'verbose' => $level);`
		467	`}`
		468
		469
		470	`#-------------------------------------------------------------------------------`
		471	`# Function : DebianFiles`
		472	`#`
		473	`# Description : Name Debian builder control files`
		474	`# May be called multiple times`
		475	`#`
		476	`# Inputs : Options`
		477	`# --Control=file`
		478	`# --PreRm=file`
		479	`# --PostRm=file`
		480	`# --PreInst=file`
		481	`# --PostInst=file`
4635	dpurdie	482	`#`
407	dpurdie	483	`#`
		484	`# Returns : Nothing`
		485	`#`
		486	`sub DebianFiles`
		487	`{`
		488	`#`
4635	dpurdie	489	`# Extract names`
407	dpurdie	490	`#`
		491	`Verbose ("Specify Debian Control Files and Scripts");`
		492	`foreach ( @_ )`
		493	`{`
4635	dpurdie	494	`if ( m/^--Control=(.+)/i ) {`
		495	`DebianControlFile('control',$1)`
407	dpurdie	496
4635	dpurdie	497	`} elsif ( m/^--PreRm=(.+)/i ) {`
		498	`DebianControlFile('prerm',$1)`
407	dpurdie	499
4635	dpurdie	500	`} elsif ( m/^--PostRm=(.+)/i ) {`
		501	`DebianControlFile('postrm',$1)`
407	dpurdie	502
4635	dpurdie	503	`} elsif ( m/^--PreInst=(.+)/i ) {`
		504	`DebianControlFile('preinst',$1)`
407	dpurdie	505
4635	dpurdie	506	`} elsif ( m/^--PostInst=(.+)/i ) {`
		507	`DebianControlFile('postinst',$1)`
407	dpurdie	508
		509	`} else {`
		510	`Error ("DebianFiles: Unknown option: $_");`
		511	`}`
		512	`}`
		513	`}`
		514
		515	`#-------------------------------------------------------------------------------`
4635	dpurdie	516	`# Function : DebianControlFile`
		517	`#`
		518	`# Description : Add special control files to the Debian Installer`
		519	`# Not useful for embedded installers`
		520	`#`
		521	`# More general than DebianFiles()`
		522	`#`
		523	`# Inputs : name - Target Name`
		524	`# If the name starts with 'package.' then it will be replaced`
		525	`# with the name of the current package`
		526	`# file - Source File Name`
		527	`#`
		528	`# Returns :`
		529	`#`
		530	`sub DebianControlFile`
		531	`{`
		532	`my ($name, $file, $misc) = @_;`
		533	`Error ("DebianControlFile: Unknown argument: $misc") if defined $misc;`
		534
		535	`#`
		536	`# Some control files need to have the package name prepended`
		537	`#`
		538	`$name =~ s~^package\.~$opt_name.~;`
		539
		540	`#`
		541	`# Only allow one file of each type`
		542	`# Try to protect the user by testing for names by lowercase`
		543	`#`
		544	`my $simpleName = lc($name);`
		545	`Error("DebianControlFile: Multiple definitions for '$name' not allowed")`
		546	`if (exists $DebianControlFileNames{$simpleName});`
		547
		548	`Error("DebianControlFile: $name. File not found", "Control target: $name", "File not found: $file")`
		549	`unless (-f $file);`
		550
		551	`#`
		552	`# Add info to data structures`
		553	`#`
		554	`$DebianControlFiles{$name} = $file;`
		555	`$DebianControlFileNames{$simpleName} = $name;`
		556	`}`
		557
		558	`#-------------------------------------------------------------------------------`
		559	`# Function : DebianDepends`
		560	`#`
		561	`# Description : This directive allows simple dependency information to be`
		562	`# inserted into the control file`
		563	`#`
4636	dpurdie	564	`# Not useful in embedded system`
4635	dpurdie	565	`#`
		566	`# Inputs : Entry - A dependency entry`
		567	`# ... - More entries`
		568	`#`
		569	`#`
		570	`# Returns : Nothing`
		571	`#`
		572	`sub DebianDepends`
		573	`{`
		574	`push @DependencyList, @_;`
		575	`}`
		576
		577
		578	`#-------------------------------------------------------------------------------`
407	dpurdie	579	`# Function : PackageDescription`
		580	`#`
		581	`# Description : Specify the Package Description`
		582	`# Keep it short`
		583	`#`
		584	`# Inputs : $description`
		585	`#`
		586	`# Returns :`
		587	`#`
		588	`sub PackageDescription`
		589	`{`
		590	`($opt_description) = @_;`
		591	`}`
		592
		593	`#-------------------------------------------------------------------------------`
		594	`# Function : MakeSymLink`
		595	`#`
		596	`# Description : Create a symlink - with error detection`
		597	`#`
		598	`# Inputs : old_file - Link Target`
		599	`# Path to the link target`
		600	`# If an ABS path is provided, the routine will`
		601	`# attempt to create a relative link.`
		602	`# new_file - Relative to the output work space`
		603	`# Path to where the 'link' file will be created`
		604	`# Options - Must be last`
		605	`# --NoClean - Don't play with links`
		606	`# --NoDotDot - Don't create symlinks with ..`
		607	`#`
		608	`# Returns : Nothing`
		609	`#`
		610	`sub MakeSymLink`
		611	`{`
		612	`my $no_clean;`
		613	`my $no_dot;`
		614	`my @args;`
		615
		616	`#`
		617	`# Extract options`
		618	`#`
		619	`foreach ( @_ )`
		620	`{`
		621	`if ( m/^--NoClean/i ) {`
		622	`$no_clean = 1;`
		623
		624	`} elsif ( m/^--NoDotDot/i ) {`
		625	`$no_dot = 1;`
		626
		627	`} elsif ( m/^--/ ) {`
		628	`Error ("MakeSymLink: Unknown option: $_");`
		629
		630	`} else {`
		631	`push @args, $_;`
		632	`}`
		633	`}`
		634
		635	`my ($old_file, $new_file) = @args;`
		636
		637	`my $tfile = $DebianWorkDir . '/' . $new_file;`
		638	`$tfile =~ s~//~/~;`
		639	`Verbose ("Symlink $old_file -> $new_file" );`
		640
		641	`#`
		642	`# Create the directory in which the link will be placed`
		643	`# Remove any existing file of the same name`
		644	`#`
		645	`my $dir = StripFileExt( $tfile );`
		646	`mkpath( $dir) unless -d $dir;`
		647	`unlink $tfile;`
		648
		649	`#`
		650	`# Determine a good name of the link`
		651	`# Convert to a relative link in an attempt to prune them`
		652	`#`
		653	`my $sfile = $old_file;`
		654	`unless ( $no_clean )`
		655	`{`
		656	`$sfile = CalcRelPath( StripFileExt( $new_file ), $old_file );`
		657	`$sfile = $old_file if ( $no_dot && $sfile =~ m~^../~ );`
		658	`}`
		659
		660	`my $result = symlink $sfile, $tfile;`
		661	`Error ("Cannot create symlink. $old_file -> $new_file") unless ( $result );`
		662	`}`
		663
		664	`#-------------------------------------------------------------------------------`
		665	`# Function : CopyFile`
		666	`#`
		667	`# Description : Copy a file to a target dir`
		668	`# Used for text files, or files with fixed names`
		669	`#`
		670	`# Inputs : $src`
		671	`# $dst_dir - Within the output workspace`
		672	`# $dst_name - Output Name [Optional]`
		673	`# Options - Common Copy Options`
		674	`#`
		675	`# Returns : Full path to destination file`
		676	`#`
		677	`sub CopyFile`
		678	`{`
		679	`CopyFileCommon( \&ResolveFile, @_ );`
		680	`}`
		681
		682	`#-------------------------------------------------------------------------------`
		683	`# Function : CopyBinFile`
		684	`#`
		685	`# Description : Copy a file to a target dir`
		686	`# Used for executable programs. Will look in places where`
		687	`# programs are stored.`
		688	`#`
		689	`# Inputs : $src`
		690	`# $dst_dir - Within the output workspace`
		691	`# $dst_name - Output Name [Optional]`
		692	`#`
		693	`# Options:`
		694	`# --FromPackage`
		695	`# --SoftLink=xxxx`
		696	`# --LinkFile=xxxx`
		697	`#`
		698	`#`
		699	`# Returns : Full path to destination file`
		700	`#`
		701	`sub CopyBinFile`
		702	`{`
		703	`CopyFileCommon( \&ResolveBinFile, @_ );`
		704	`}`
		705
		706	`#-------------------------------------------------------------------------------`
		707	`# Function : CopyLibFile`
		708	`#`
		709	`# Description : Copy a file to a target dir`
		710	`# Used for shared programs. Will look in places where`
		711	`# shared libraries are stored.`
		712	`#`
		713	`# Inputs : $src - Base for 'realname' (no lib, no extension)`
		714	`# $dst_dir - Within the output workspace`
		715	`# $dst_name - Output Name [Optional, but not suggested]`
		716	`#`
		717	`# Returns : Full path to destination file`
		718	`#`
		719	`# Notes : Copying 'lib' files`
		720	`# These are 'shared libaries. There is no provision for copying`
		721	`# static libraries.`
		722	`#`
		723	`# The tool will attempt to copy a well-formed 'realname' library`
		724	`# The soname of the library should be constructed on the target`
		725	`# platform using ldconfig.`
		726	`# There is no provision to copy the 'linker' name`
		727	`#`
		728	`# Given a request to copy a library called 'fred', then the`
		729	`# well formed 'realname' will be:`
		730	`# libfred[P\|D\|]].so.nnnnn`
		731	`# where:`
		732	`# nnnn is the library version`
		733	`# [P\|D\|] indicates Production, Debug or None`
		734	`#`
		735	`# The 'soname' is held within the realname form of the library`
		736	`# and will be created by lsconfig.`
		737	`#`
		738	`# The 'linkername' would be libfred[P\|D\|].so. This is only`
		739	`# needed when linking against the library.`
		740	`#`
		741	`#`
		742	`# The routine will also recognize Windows DLLs`
		743	`# These are of the form fred[P\|D\|].nnnnn.dll`
		744	`#`
		745	`sub CopyLibFile`
		746	`{`
		747	`CopyFileCommon( \&ResolveLibFile, @_ );`
		748	`}`
		749
		750	`#-------------------------------------------------------------------------------`
		751	`# Function : CopyFileCommon`
		752	`#`
		753	`# Description : Common ( internal File Copy )`
		754	`#`
		755	`# Inputs : $resolver - Ref to function to resolve source file`
		756	`# $src - Source File Name`
		757	`# $dst_dir - Target Dir`
		758	`# $dst_name - Target Name (optional)`
		759	`# Options`
		760	`# Options:`
		761	`# --FromPackage`
		762	`# --SoftLink=xxxx`
		763	`# --LinkFile=xxxx`
		764	`#`
		765	`# Returns :`
		766	`#`
		767	`sub CopyFileCommon`
		768	`{`
		769	`my $from_package = 0;`
		770	`my $isa_linkfile = 0;`
		771	`my @llist;`
		772	`my @args;`
		773
		774	`#`
		775	`# Parse options`
		776	`#`
		777	`foreach ( @_ )`
		778	`{`
		779	`if ( m/^--FromPackage/ ) {`
		780	`$from_package = 1;`
		781
		782	`} elsif ( m/^--LinkFile/ ) {`
		783	`$isa_linkfile = 1;`
		784
		785	`} elsif ( m/^--SoftLink=(.+)/ ) {`
		786	`push @llist, $1;`
		787
		788	`} elsif ( m/^--/ ) {`
		789	`Error ("FileCopy: Unknown option: $_");`
		790
		791	`} else {`
		792	`push @args, $_;`
		793	`}`
		794	`}`
		795
		796	`#`
		797	`# Extract non-options.`
		798	`# These are the bits that are left over`
		799	`#`
		800	`my ($resolver, $src, $dst_dir, $dst_name ) = @args;`
		801
		802	`#`
		803	`# Clean up dest_dir. Must start with a / and not end with one`
		804	`#`
		805	`$dst_dir = "/$dst_dir/";`
		806	`$dst_dir =~ s~/+~/~g;`
		807	`$dst_dir =~ s~/$~~;`
		808
		809	`Verbose ("CopyFile: $src, $dst_dir, " . ($dst_name \|\| ''));`
		810	`foreach $src ( &$resolver( $from_package, $src ) )`
		811	`{`
		812	`my $dst_fname = $dst_name ? $dst_name : StripDir($src);`
		813	`my $dst_file = "$dst_dir/$dst_fname";`
		814	`Verbose ("CopyFile: Copy $src, $dst_file" );`
		815
		816
		817	`#`
		818	`# LinkFiles are special`
		819	`# They get concatenated to any existing LINKS File`
		820	`#`
		821	`if ( $isa_linkfile )`
		822	`{`
		823	`CatFile ( $src, "$dst_dir/.LINKS" );`
		824	`}`
		825	`else`
		826	`{`
		827	`mkpath( "$DebianWorkDir$dst_dir", 0, 0775);`
		828	`unlink ("$DebianWorkDir$dst_file");`
		829	`System ('cp','-f', $src, "$DebianWorkDir$dst_file" );`
		830
		831	`foreach my $lname ( @llist )`
		832	`{`
		833	`$lname = $dst_dir . '/' . $lname unless ( $lname =~ m ~^/~ );`
		834	`MakeSymLink( $dst_file ,$lname);`
		835	`}`
		836	`}`
		837	`}`
		838	`}`
		839
		840	`#-------------------------------------------------------------------------------`
		841	`# Function : CopyDir`
		842	`#`
		843	`# Description : Copy a directory to a target dir`
		844	`#`
		845	`# Inputs : $src_dir - Local to the user`
		846	`# Symbolic Name`
		847	`# $dst_dir - Within the output workspace`
		848	`# Options`
423	dpurdie	849	`# --Merge - Don't delete first`
		850	`# --Source=Name - Source via Symbolic Name`
4147	dpurdie	851	`# --FromPackage - Source via package roots`
4152	dpurdie	852	`# --NoIgnoreDbgFiles - Do not ignore .dbg and .debug files in dir copy`
		853	`# --IfPresent - Not an error if the path cannot be found`
407	dpurdie	854	`#`
		855	`# Returns :`
		856	`#`
		857	`sub CopyDir`
		858	`{`
		859	`my ($src_dir, $dst_dir, @opts) = @_;`
		860	`my $opt_merge;`
		861	`my $opt_base;`
411	dpurdie	862	`my $from_interface = 0;`
4152	dpurdie	863	`my $ignoreDbg = 1;`
		864	`my $ignoreNoDir;`
		865	`my $user_src_dir = $src_dir;`
		866	`my $opt_source;`
		867	`my $opt_package;`
407	dpurdie	868
		869	`$dst_dir = $DebianWorkDir . '/' . $dst_dir;`
		870	`$dst_dir =~ s~//~/~;`
		871
		872	`#`
4152	dpurdie	873	`# Scan and collect user options`
407	dpurdie	874	`#`
		875	`foreach ( @opts )`
		876	`{`
4152	dpurdie	877	`Verbose2 ("CopyDir: $_");`
407	dpurdie	878	`if ( m/^--Merge/ ) {`
		879	`$opt_merge = 1;`
4152	dpurdie	880
407	dpurdie	881	`} elsif ( m/^--Source=(.+)/ ) {`
425	dpurdie	882	`Error ("Source directory can only be specified once")`
4152	dpurdie	883	`if ( defined $opt_source );`
		884	`$opt_source = $1;`
425	dpurdie	885
4152	dpurdie	886	`} elsif ( m/^--FromPackage/ ) {`
		887	`Error ("FromPackage can only be specified once")`
		888	`if ( defined $opt_package );`
		889	`$opt_package = 1;`
		890
		891	`} elsif ( m/^--NoIgnoreDbgFiles/ ) {`
		892	`$ignoreDbg = 0;`
		893
		894	`} elsif ( m/^--IfPresent/ ) {`
		895	`$ignoreNoDir = 1;`
407	dpurdie	896
4152	dpurdie	897	`} else {`
		898	`Error ("CopyDir: Unknown option: $_" );`
		899	`}`
		900	`}`
411	dpurdie	901
4152	dpurdie	902	`#`
		903	`# All options have been gathered. Now process some of them`
		904	`#`
		905	`Error ("CopyDir: Cannot use both --Source and --FromPackage: $src_dir") if ($opt_source && $opt_package);`
425	dpurdie	906
4152	dpurdie	907	`#`
		908	`# Convert a symbolic path into a physical path`
		909	`#`
		910	`if ($opt_source)`
		911	`{`
		912	`Verbose2 ("CopyDir: Determine Source: $opt_source");`
425	dpurdie	913
4152	dpurdie	914	`$opt_source = lc($opt_source);`
		915	`my %CopyDirSymbolic = (`
		916	`'interfaceincdir' => $opt_interfaceincdir,`
		917	`'interfacelibdir' => $opt_interfacelibdir,`
		918	`'interfacebindir' => $opt_interfacebindir,`
		919	`'libdir' => $opt_libdir,`
		920	`'bindir' => $opt_bindir,`
		921	`'localincdir' => $opt_localincdir,`
		922	`'locallibdir' => $opt_locallibdir,`
		923	`'localbindir' => $opt_localbindir,`
		924	`'packagebindir' => $opt_pkgbindir,`
		925	`'packagelibdir' => $opt_pkglibdir,`
		926	`'packagepkgdir' => $opt_pkgpkgdir,`
		927	`'packagedir' => $opt_pkgdir,`
		928	`);`
425	dpurdie	929
4152	dpurdie	930	`if ( exists $CopyDirSymbolic{$opt_source} )`
		931	`{`
		932	`$opt_base = $CopyDirSymbolic{$opt_source};`
425	dpurdie	933
		934	`#`
4152	dpurdie	935	`# If sourceing from interface, then follow`
		936	`# symlinks in the copy. All files will be links anyway`
425	dpurdie	937	`#`
		938	`$from_interface = 1`
4152	dpurdie	939	`if ( $opt_source =~ m~^interface~ );`
		940	`}`
		941	`else`
		942	`{`
		943	`DebugDumpData ("CopyDirSymbolic", \%CopyDirSymbolic);`
		944	`Error ("CopyDir: Unknown Source Name: $opt_source" );`
		945	`}`
		946	`}`
425	dpurdie	947
4152	dpurdie	948	`#`
		949	`# Locate the path within an external package`
		950	`#`
		951	`if ($opt_package)`
		952	`{`
		953	`Verbose2 ("CopyDir: FromPackage: $src_dir");`
4147	dpurdie	954
4152	dpurdie	955	`my @path;`
		956	`foreach my $entry ( getPackageList() )`
		957	`{`
		958	`my $base = $entry->getBase(3);`
		959	`next unless ( defined $base );`
		960	`if ( -d $base . '/' . $src_dir )`
		961	`{`
		962	`push @path, $base;`
		963	`$from_interface = 1`
		964	`if ( $entry->{'TYPE'} eq 'interface' );`
		965	`}`
407	dpurdie	966	`}`
4152	dpurdie	967
		968	`if ( $#path < 0 )`
		969	`{`
		970	`Error ("CopyDir: Cannot find source dir in any package: $user_src_dir") unless ($ignoreNoDir);`
		971	`Message ("CopyDir: Optional path not found: $user_src_dir");`
		972	`return;`
		973	`}`
		974
		975	`Error ("CopyDir: Requested path found in mutiple packages: $user_src_dir",`
		976	`@path ) if ( $#path > 0 );`
		977	`$opt_base = pop @path;`
		978
		979	`#`
		980	`# If sourceing from interface, then follow symlinks in the copy.`
		981	`# All files will be links anyway`
		982	`#`
		983	`# This is a very ugly test for 'interface'`
		984	`#`
		985	`$from_interface = 1`
		986	`if ( $opt_base =~ m~/interface/~ );`
		987
407	dpurdie	988	`}`
		989
4152	dpurdie	990	`#`
		991	`# Create the full source path`
		992	`# May be: from a package, from a known directoru, from a local directory`
		993	`#`
		994
407	dpurdie	995	`$src_dir = $opt_base . '/' . $src_dir if ( $opt_base );`
		996	`$src_dir =~ s~//~/~g;`
		997	`$src_dir =~ s~/$~~;`
		998
		999	`Verbose ("CopyDir: $src_dir, $dst_dir");`
4152	dpurdie	1000	`unless ( -d $src_dir )`
		1001	`{`
		1002	`Error ("CopyDir: Directory not found: $user_src_dir") unless ($ignoreNoDir);`
		1003	`Message ("CopyDir: Optional path not found: $user_src_dir");`
		1004	`return;`
		1005	`}`
407	dpurdie	1006
		1007	`#`
423	dpurdie	1008	`# Setup the copy options`
407	dpurdie	1009	`#`
423	dpurdie	1010	`my %copyOpts;`
4101	dpurdie	1011	`$copyOpts{'IgnoreDirs'} = ['.svn', '.git', '.cvs', '.hg'];`
		1012	`$copyOpts{'Ignore'} = ['.gbedir', '_gbedir'];`
4147	dpurdie	1013	`push (@{$copyOpts{'Ignore'}}, '.debug', '.dbg') if $ignoreDbg;`
423	dpurdie	1014	`$copyOpts{'EmptyDirs'} = 1;`
		1015	`$copyOpts{'DeleteFirst'} = 1 unless $opt_merge;`
		1016	`$copyOpts{'Log'} = 1 if ( $opt_verbose > 1 );`
		1017	`$copyOpts{'DuplicateLinks'} = 1 unless ( $from_interface );`
407	dpurdie	1018
		1019	`#`
423	dpurdie	1020	`# Transfer the directory`
407	dpurdie	1021	`#`
423	dpurdie	1022	`JatsCopy::CopyDir ( $src_dir, $dst_dir, \%copyOpts );`
407	dpurdie	1023
		1024	`#`
		1025	`# Expand link files that may have been copied in`
		1026	`#`
		1027	`Verbose ("Locate LINKFILES in $DebianWorkDir");`
		1028	`ExpandLinkFiles();`
		1029	`}`
		1030
		1031	`#-------------------------------------------------------------------------------`
		1032	`# Function : AddInitScript`
		1033	`#`
		1034	`# Description : Add an Init Script to the target`
		1035	`# Optionally create start and stop links`
		1036	`#`
		1037	`# Inputs : $script - Name of the init script`
		1038	`# $start - Start Number`
		1039	`# $stop - Stop Number`
		1040	`# Options:`
		1041	`# --NoCopy - Don't copy the script, just add links`
		1042	`# --Afc - Place in AFC init area`
		1043	`# --FromPackage - Source is in a package`
		1044	`#`
		1045	`# Returns :`
		1046	`#`
		1047	`sub AddInitScript`
		1048	`{`
		1049	`my $no_copy;`
		1050	`my $basedir = "";`
		1051	`my @args;`
		1052	`my $from_package = 0;`
		1053
4302	dpurdie	1054	`# This directive is only available on the VIX platforms`
		1055	`# Kludgey test - at the moment`
407	dpurdie	1056	`#`
4302	dpurdie	1057	`if ($opt_pkgarch =~ m~i386~)`
		1058	`{`
		1059	`Error ("AddInitScript is not supported on this platform");`
		1060	`}`
		1061
		1062	`#`
407	dpurdie	1063	`# Process and Remove options`
		1064	`#`
		1065	`foreach ( @_ )`
		1066	`{`
		1067	`if ( m/^--NoCopy/ ) {`
		1068	`$no_copy = 1;`
		1069
		1070	`} elsif ( m/^--Afc/ ) {`
		1071	`$basedir = "/afc";`
		1072
		1073	`} elsif ( m/^--FromPackage/ ) {`
		1074	`$from_package = 1;`
		1075
		1076	`} elsif ( m/^--/ ) {`
		1077	`Error ("AddInitScript: Unknown option: $_");`
		1078
		1079	`} else {`
		1080	`push @args, $_;`
		1081
		1082	`}`
		1083	`}`
		1084
		1085	`my( $script, $start, $stop ) = @args;`
		1086	`Error ("No script file specified") unless ( $script );`
		1087	`Warning("AddInitScript: No start or stop index specified") unless ( $start \|\| $stop );`
		1088	`Verbose ("AddInitScript: $script, " . ($start \|\| 'No Start') . ", " . ($stop \|\| 'No Stop'));`
		1089	`$script = ResolveFile($from_package, $script );`
		1090
		1091	`my $tdir = $basedir . "/etc/init.d/init.d";`
		1092	`my $base = StripDir($script);`
		1093
		1094	`CopyFile( $script, $tdir ) unless $no_copy;`
		1095
		1096	`my $link;`
		1097	`if ( $start )`
		1098	`{`
		1099	`$link = sprintf ("${basedir}/etc/init.d/S%2.2d%s", $start, $base );`
		1100	`MakeSymLink( "$tdir/$base", $link);`
		1101	`}`
		1102
		1103	`if ( $stop )`
		1104	`{`
		1105	`$link = sprintf ("${basedir}/etc/init.d/K%2.2d%s", $stop, $base );`
		1106	`MakeSymLink( "$tdir/$base", $link);`
		1107	`}`
		1108	`}`
		1109
		1110	`#-------------------------------------------------------------------------------`
		1111	`# Function : CatFile`
		1112	`#`
		1113	`# Description : Copy a file to the end of a file`
		1114	`#`
		1115	`# Inputs : $src`
		1116	`# $dst - Within the output workspace`
		1117	`#`
		1118	`# Returns :`
		1119	`#`
		1120	`sub CatFile`
		1121	`{`
		1122	`my ($src, $dst) = @_;`
		1123
		1124	`$dst = $DebianWorkDir . '/' . $dst;`
		1125	`$dst =~ s~//~/~;`
		1126	`Verbose ("CatFile: $src, $dst");`
		1127	`$src = ResolveFile(0, $src );`
		1128
		1129	`open (SF, '<', $src) \|\| Error ("CatFile: Cannot open $src");`
		1130	`open (DF, '>>', $dst) \|\| Error ("CatFile: Cannot create:$dst");`
		1131	`while ( <SF> )`
		1132	`{`
		1133	`print DF $_;`
		1134	`}`
		1135	`close (SF);`
		1136	`close (DF);`
		1137	`}`
		1138
		1139	`#-------------------------------------------------------------------------------`
		1140	`# Function : EchoFile`
		1141	`#`
		1142	`# Description : Echo simple text to a file`
		1143	`#`
		1144	`# Inputs : $file - Within the output workspace`
		1145	`# $text`
		1146	`#`
		1147	`# Returns :`
		1148	`#`
		1149	`sub EchoFile`
		1150	`{`
		1151	`my ($file, $text) = @_;`
		1152	`Verbose ("EchoFile: $file");`
		1153
		1154	`$file = $DebianWorkDir . '/' . $file;`
		1155	`$file =~ s~//~/~;`
		1156
		1157	`unlink $file;`
		1158	`open (DT, ">", $file ) \|\| Error ("Cannot create $file");`
		1159	`print DT $text \|\| Error ("Cannot print to $file");`
		1160	`close DT;`
		1161	`}`
		1162
		1163	`#-------------------------------------------------------------------------------`
4640	dpurdie	1164	`# Function : ConvertFiles`
		1165	`#`
		1166	`# Description : This sub-routine is used to remove all carrage return\line`
		1167	`# feeds from a line and replace them with the platform`
		1168	`# specific equivalent chars.`
		1169	`#`
		1170	`# We let PERL determine what characters are written to the`
		1171	`# file base on the platform you are running on.`
		1172	`#`
		1173	`# i.e. LF for unix`
		1174	`# CR\LF for win32`
		1175	`#`
		1176	`# Inputs : outPath - Output directory`
		1177	`# flist - List of files in that directory`
		1178	`# or`
		1179	`# SearchOptions - Search options to find files`
		1180	`# --Recurse`
		1181	`# --NoRecurse`
		1182	`# --FilterIn=xxx`
		1183	`# --FilterInRe=xxx`
		1184	`# --FilterOut=xxx`
		1185	`# --FilterOutRe=xxx`
		1186	`# Common options`
		1187	`# --Dos`
		1188	`# --Unix`
		1189	`#`
		1190	`#`
		1191	`# Returns : 1`
		1192	`#`
		1193	`sub ConvertFiles`
		1194	`{`
		1195	`my @uargs;`
		1196	`my $lineEnding = "\n";`
		1197	`my ($dosSet, $unixSet);`
		1198	`my $search = JatsLocateFiles->new( '--NoRecurse' );`
		1199
		1200	`#`
		1201	`# Process user arguments extracting options`
		1202	`#`
		1203	`foreach ( @_ )`
		1204	`{`
		1205	`if ( m~^--Recurse~ ) {`
		1206	`$search->recurse(1);`
		1207
		1208	`} elsif ( m~^--NoRecurse~) {`
		1209	`$search->recurse(0);`
		1210
		1211	`} elsif ( /^--FilterOut=(.*)/ ) {`
		1212	`$search->filter_out($1);`
		1213
		1214	`} elsif ( /^--FilterOutRe=(.*)/ ) {`
		1215	`$search->filter_out_re($1);`
		1216
		1217	`} elsif ( /^--FilterIn=(.*)/ ) {`
		1218	`$search->filter_in($1);`
		1219
		1220	`} elsif ( /^--FilterInRe=(.*)/ ) {`
		1221	`$search->filter_in_re($1);`
		1222
		1223	`} elsif ( m~^--Dos~) {`
		1224	`$lineEnding = "\r\n";`
		1225	`$dosSet = 1;`
		1226
		1227	`} elsif ( m~^--Unix~) {`
		1228	`$lineEnding = "\n";`
		1229	`$unixSet = 1;`
		1230
		1231	`} elsif ( m~^--~) {`
		1232	`Error ("ConvertFile: Unknown option: $_");`
		1233
		1234	`} else {`
		1235	`push @uargs, $_;`
		1236	`}`
		1237	`}`
		1238
		1239	`#`
		1240	`# Process non-option arguments`
		1241	`# - Base dir`
		1242	`# - List of files`
		1243	`#`
		1244	`my ($outPath, @flist) = @uargs;`
		1245	`Error ("ConvertFiles: Target Dir must be specified" ) unless ( $outPath );`
		1246
		1247	`#`
		1248	`# Sanity Tests`
		1249	`#`
		1250	`Error ("ConvertFiles: --Dos and --Unix are mutually exclusive" ) if ( $dosSet && $unixSet );`
		1251
		1252
		1253	`#`
		1254	`# Convert output path to physical path`
		1255	`#`
		1256	`my $topDir = catdir($DebianWorkDir, $outPath);`
		1257	`Verbose("ConvertFiles: topDir: $topDir");`
		1258	`Error ("ConvertFiles: Path does not exist", $topDir) unless ( -e $topDir );`
		1259	`Error ("ConvertFiles: Path is not a directory", $topDir) unless ( -d $topDir );`
		1260
		1261	`#`
		1262	`# Need to determine if we are searching or simply using a file list`
		1263	`# There are two forms of the functions. If any of the search options have`
		1264	`# been used then we assume that we are searchine`
		1265	`#`
		1266	`if ( $search->has_filter() )`
		1267	`{`
		1268	`Error ("ConvertFiles: Cannot mix search options with named files") if ( @flist );`
		1269	`@flist = $search->search($topDir);`
		1270	`}`
		1271	`Error ("ConvertFiles: No files specified") unless ( @flist );`
		1272
		1273	`#`
		1274	`# Process all named files`
		1275	`#`
		1276	`foreach my $file ( @flist )`
		1277	`{`
		1278
		1279	`# this is our file that we want to clean.`
		1280	`my ($ifileLoc) = "$topDir/$file";`
		1281	`my ($tfileLoc) = "$topDir/$file\.tmp";`
		1282	`Verbose("ConvertFile: $file");`
		1283
		1284	`# we will check to see if the file exists.`
		1285	`#`
		1286	`my $ifile;`
		1287	`my $tfile;`
		1288	`if ( -f "$ifileLoc" )`
		1289	`{`
		1290	`open ($ifile, "< $ifileLoc" ) or`
		1291	`Error("Failed to open file [$ifileLoc] : $!");`
		1292
		1293	`open ($tfile, "> $tfileLoc" ) or`
		1294	`Error("Failed to open file [$tfileLoc] : $!");`
		1295	`binmode $tfile;`
		1296
		1297	`while ( <$ifile> )`
		1298	`{`
		1299	`s~[\n\r]+$~~; # Chomp`
		1300	`print $tfile "$_" . $lineEnding;`
		1301	`}`
		1302	`}`
		1303	`else`
		1304	`{`
		1305	`Error("ConvertFiles [$ifileLoc] does not exist.");`
		1306	`}`
		1307
		1308	`close $ifile;`
		1309	`close $tfile;`
		1310
		1311
		1312	`# lets replace our original file with the new one`
		1313	`#`
		1314	`if(File::Copy::move("$tfileLoc", "$ifileLoc"))`
		1315	`{`
		1316	`Verbose2("ConvertFiles: Renamed [$tfileLoc] to [$ifileLoc] ...");`
		1317	`}`
		1318	`else`
		1319	`{`
		1320	`Error("ConvertFiles: Failed to rename file [$tfileLoc] to [$ifileLoc]: $!");`
		1321	`}`
		1322	`}`
		1323
		1324	`return 1;`
		1325	`}`
		1326
		1327	`#-------------------------------------------------------------------------------`
407	dpurdie	1328	`# Function : SetFilePerms`
		1329	`#`
		1330	`# Description : Set file permissions on one or more files or directories`
		1331	`#`
		1332	`# Inputs : $perm - Perm Mask`
		1333	`# @paths - List of paths/files to process`
		1334	`# Options`
		1335	`# --Recurse - Recurse subdirs`
		1336	`#`
		1337	`# Returns :`
		1338	`#`
		1339	`sub SetFilePerms`
		1340	`{`
		1341
		1342	`my @args;`
		1343	`my $perms;`
		1344	`my $recurse = 0;`
		1345
		1346	`#`
		1347	`# Process and Remove options`
		1348	`#`
		1349	`foreach ( @_ )`
		1350	`{`
		1351	`if ( m/^--Recurse/ ) {`
		1352	`$recurse = 1;`
		1353
		1354	`} elsif ( m/^--/ ) {`
		1355	`Error ("SetFilePerms: Unknown option: $_");`
		1356
		1357	`} else {`
		1358	`push @args, $_;`
		1359
		1360	`}`
		1361	`}`
		1362
		1363	`$perms = shift @args;`
		1364	`Error ("SetFilePerms: No Permissions" ) unless ( $perms );`
		1365
		1366	`foreach my $path ( @args )`
		1367	`{`
		1368	`Verbose ("Set permissions; $perms, $path");`
		1369	`my $full_path = $DebianWorkDir . '/' . $path;`
		1370	`if ( -f $full_path )`
		1371	`{`
		1372	`System ('chmod', $perms, $full_path );`
		1373	`}`
		1374	`elsif ( -d $full_path )`
		1375	`{`
		1376	`System ('chmod', '-R', $perms, $full_path ) if ($recurse);`
		1377	`System ('chmod', $perms, $full_path ) unless ($recurse);`
		1378	`}`
		1379	`else`
		1380	`{`
		1381	`Warning("SetFilePerms: Path not found: $path");`
		1382	`}`
		1383	`}`
		1384	`}`
		1385
		1386	`#-------------------------------------------------------------------------------`
4636	dpurdie	1387	`# Function : SetPermissions`
		1388	`#`
		1389	`# Description : Called to set permissions of files/dirs in a directory structure.`
		1390	`# With no options sets DirTag and all files/dirs in it to perms`
		1391	`#`
		1392	`# Inputs : path - The directory tag to start setting permissions on`
		1393	`# Options - See below`
		1394	`#`
		1395	`# Required Options:`
		1396	`# One or both of`
		1397	`# --FilePerms= Sets the permissions of files to this permission.`
		1398	`# If not supplied then no files have their permissions changed`
		1399	`# --DirPerms= Sets the permissions of directories to this permission`
		1400	`# If not supplied then no directories have their permissions changed`
		1401	`# OR`
		1402	`# --Perms= Sets the permissions of both files and directories to this permissions`
		1403	`# Equivalent to supplying both --FilePerms=X && --DirPerms=X`
		1404	`#`
		1405	`# Options:`
		1406	`# --RootOnly Only sets the permissions on the 'path' directory/file,`
		1407	`# all other options ignored`
		1408	`# --SkipRoot Does not set permissions on the 'path' directory/file,`
		1409	`# obviously mutually exlusive with --RootOnly`
		1410	`#`
		1411	`# Any option supported by JatsLocateFiles.`
		1412	`# Some of these include:`
		1413	`#`
		1414	`# --Recurse Recurse the directory tree. Does a depth first recurse so that all`
		1415	`# dir entries are processed before the dir itself (default)`
		1416	`# --NoRecurse Dont recurse`
		1417	`# --FilterIn= Apply permissions to files/directories that matches this value.`
		1418	`# --FilterInRe= Perl RE's can be used (Not Shell wildcards) and this option`
		1419	`# can be supplied mulitple times`
		1420	`# --FilterOut= Dont apply permissions to any files/directories matching this value`
		1421	`# --FilterOutRe= Perl RE's can be used (Not Shell wildcards) and this option`
		1422	`# can be supplied mulitple times`
		1423	`#`
		1424	`# FilterIn is applied before FilterOut. If Recurse is specified`
		1425	`# the directory will be recursed regardless of these filters, however`
		1426	`# the filter will be applied when it comes time to chmod the dir`
		1427	`#`
		1428	`#------------------------------------------------------------------------------`
		1429	`sub SetPermissions`
		1430	`{`
		1431	`my ( $path, $filePerms, $dirPerms, $someDone );`
		1432	`my ( $rootOnly, $skipRoot ) = ( 0, 0 );`
		1433
		1434	`my $search = JatsLocateFiles->new( '--Recurse', '--DirsToo' );`
		1435
		1436	`foreach ( @_ )`
		1437	`{`
		1438	`if ( m/^--Perms=(.*)/ ) {`
		1439	`$filePerms = $1;`
		1440	`$dirPerms = $1;`
		1441
		1442	`} elsif (m/^--FilePerms=(.*)/ ) {`
		1443	`$filePerms = $1;`
		1444
		1445	`} elsif ( m/^--DirPerms=(.*)/ ) {`
		1446	`$dirPerms = $1;`
		1447
		1448	`} elsif ( m/^--RootOnly/ ) {`
		1449	`$rootOnly = 1;`
		1450
		1451	`} elsif ( m/^--SkipRoot/ ) {`
		1452	`$skipRoot = 1;`
		1453
		1454	`} elsif ( m/^--Filter/ && $search->option( $_ ) ) {`
		1455	`Verbose2 ("Search Option: $_" );`
		1456
		1457	`} elsif ( m/^--Recurse\|--NoRecurse/ && $search->option( $_ ) ) {`
		1458	`Verbose2 ("Search Option: $_" );`
		1459
		1460	`} elsif (m/^--/ ) {`
		1461	`Error ("SetPermissions: Unknown option: $_");`
		1462
		1463	`} else {`
		1464	`Error("SetPermissions 'path' already set", "Path: $_") if ( $path );`
		1465	`$path = $_;`
		1466	`}`
		1467	`}`
		1468
		1469	`#`
		1470	`# Sanity test`
		1471	`#`
		1472	`Error("SetPermissions called with out a 'path' parameter") if ( !defined($path) );`
		1473	`Error("SetPermissions called with out any Permissions specified") if ( !defined($filePerms) && !defined($dirPerms) );`
		1474	`Error("SetPermissions: Options --RootOnly & --SkipRoot are mutually exclusive" ) if ( $rootOnly && $skipRoot );`
		1475
		1476
		1477	`# Convert the target directory name into a physical path`
		1478	`# User specifies '/' as the root of the image`
		1479	`# User specifies 'name' as relateve to the root of the image`
		1480	`#`
		1481	`my $topDir = $DebianWorkDir . '/' . $path;`
		1482	`$topDir =~ s~/+$~~;`
		1483
		1484	`Verbose("SetPermissions: Called with options " . join(", ", @_));`
		1485
		1486	`#`
		1487	`# Only set perms on the root directory`
		1488	`# This is a trivial operation`
		1489	`#`
		1490	`if ( $rootOnly )`
		1491	`{`
		1492	`$someDone += chmodItem( $topDir, $filePerms, $dirPerms );`
		1493	`}`
		1494	`else`
		1495	`{`
		1496	`#`
		1497	`# Create a list of files/dirs to process`
		1498	`#`
		1499	`my @elements = $search->search( $topDir );`
		1500
		1501	`foreach my $dirEntry ( @elements )`
		1502	`{`
		1503	`my $fullPath = "$topDir/$dirEntry";`
		1504
		1505	`# A dir and we dont have dirperms, so skip`
		1506	`if ( -d $fullPath && !defined($dirPerms) )`
		1507	`{`
		1508	`Verbose2("SetPermissions: Skipping dir $fullPath as we have no dir permissions");`
		1509	`next;`
		1510	`}`
		1511
		1512	`# A file and we dont have fileperms, so skip`
		1513	`if ( -f $fullPath && !defined($filePerms) )`
		1514	`{`
		1515	`Verbose2("SetPermissions: Skipping file $fullPath as we have no file permissions");`
		1516	`next;`
		1517	`}`
		1518
		1519	`# a file or a dir and have the right permissions and we are not recursing`
		1520	`if ( -f $fullPath \|\| -d $fullPath )`
		1521	`{`
		1522	`$someDone += chmodItem( $fullPath, $filePerms, $dirPerms );`
		1523	`}`
		1524	`else`
		1525	`{`
		1526	`Warning("SetPermissions: Skipping $fullPath as its not a file or directory");`
		1527	`}`
		1528	`}`
		1529
		1530	`#`
		1531	`# Process the topDir`
		1532	`# May not be modified if --SkipRoot has been requested`
		1533	`#`
		1534	`if ( !$skipRoot && -e $topDir )`
		1535	`{`
		1536	`$someDone += chmodItem( $topDir, $filePerms, $dirPerms );`
		1537	`}`
		1538	`}`
		1539
		1540	`# Final warning`
		1541	`#`
		1542	`Warning ("SetPermissions: No files located", "Args: @_") unless ( $someDone );`
		1543	`}`
		1544
		1545	`#-------------------------------------------------------------------------------`
		1546	`# Function : chmodItem`
		1547	`#`
		1548	`# Description : Internal`
		1549	`# chmod a file or a folder`
		1550	`#`
		1551	`# Inputs : item - Item to mod`
		1552	`# filePerms - File perms`
		1553	`# dirPerms - dire perms`
		1554	`#`
		1555	`# Returns : 1 - Item modified`
		1556	`# 0 - Item not modified`
		1557	`#`
		1558	`sub chmodItem`
		1559	`{`
		1560	`my ($item, $filePerms, $dirPerms) = @_;`
		1561
		1562	`if ( -d $item && defined $dirPerms)`
		1563	`{`
		1564	`Verbose("SetPermissions: $dirPerms : $item");`
		1565	`System ('chmod', $dirPerms, $item );`
		1566	`return 1;`
		1567	`}`
		1568
		1569	`if ( -f $item && defined $filePerms)`
		1570	`{`
		1571	`Verbose("SetPermissions: $filePerms : $item");`
		1572	`System ('chmod', $filePerms, $item );`
		1573	`return 1;`
		1574	`}`
		1575
		1576	`return 0;`
		1577	`}`
		1578
		1579
		1580	`#-------------------------------------------------------------------------------`
407	dpurdie	1581	`# Function : CreateDir`
		1582	`#`
		1583	`# Description : Create a directory within the target workspace`
		1584	`#`
		1585	`# Inputs : $path - Name of the target directory`
		1586	`#`
		1587	`# Returns : Nothing`
		1588	`#`
		1589	`sub CreateDir`
		1590	`{`
		1591	`my ($path) = @_;`
		1592
		1593	`Verbose ("Create Dir: $path");`
		1594	`mkpath( $DebianWorkDir . '/' . $path );`
		1595	`}`
		1596
		1597	`#-------------------------------------------------------------------------------`
		1598	`# Function : IsProduct`
		1599	`# IsPlatform`
		1600	`# IsTarget`
427	dpurdie	1601	`# IsVariant`
407	dpurdie	1602	`#`
		1603	`# Description : This function allows some level of control in the`
		1604	`# packaging scripts. It will return true if the current`
		1605	`# product is listed.`
		1606	`#`
		1607	`# Ugly after thought`
		1608	`#`
		1609	`# Intended use:`
		1610	`# Xxxxxx(...) if (IsProduct( 'aaa',bbb' );`
		1611	`#`
		1612	`# Inputs : products - a list of products to compare against`
		1613	`#`
		1614	`# Returns : True if the current build is for one of the listed products`
		1615	`#`
		1616	`sub IsProduct`
		1617	`{`
		1618	`foreach ( @_ )`
		1619	`{`
		1620	`return 1 if ( $opt_product eq $_ );`
		1621	`}`
		1622	`return 0;`
		1623	`}`
		1624
		1625	`sub IsPlatform`
		1626	`{`
		1627	`foreach ( @_ )`
		1628	`{`
		1629	`return 1 if ( $opt_platform eq $_ );`
		1630	`}`
		1631	`return 0;`
		1632	`}`
		1633
		1634	`sub IsTarget`
		1635	`{`
		1636	`foreach ( @_ )`
		1637	`{`
		1638	`return 1 if ( $opt_target eq $_ );`
		1639	`}`
		1640	`return 0;`
		1641	`}`
		1642
427	dpurdie	1643	`sub IsVariant`
		1644	`{`
		1645	`foreach ( @_ )`
		1646	`{`
		1647	`return 1 if ( $opt_variant eq $_ );`
		1648	`}`
		1649	`return 0;`
		1650	`}`
407	dpurdie	1651
		1652	`#-------------------------------------------------------------------------------`
		1653	`# Function : FindFiles`
		1654	`#`
		1655	`# Description : Locate files within a given dir tree`
		1656	`#`
		1657	`# Inputs : $root - Base of the search`
		1658	`# $match - Re to match`
		1659	`#`
		1660	`# Returns : A list of files that match`
		1661	`#`
		1662	`my @FIND_LIST;`
		1663	`my $FIND_NAME;`
		1664
		1665	`sub FindFiles`
		1666	`{`
		1667	`my ($root, $match ) = @_;`
		1668	`Verbose2("FindFiles: Root: $root, Match: $match");`
		1669
		1670	`#`
		1671	`# Becareful of closure, Must use globals`
		1672	`#`
		1673	`@FIND_LIST = ();`
		1674	`$FIND_NAME = $match;`
		1675	`File::Find::find( \&find_files, $root);`
		1676
		1677	`#`
		1678	`# Find callback program`
		1679	`#`
		1680	`sub find_files`
		1681	`{`
		1682	`my $item = $File::Find::name;`
		1683
		1684	`return if ( -d $File::Find::name );`
		1685	`return unless ( $_ =~ m~$FIND_NAME~ );`
		1686	`push @FIND_LIST, $item;`
		1687	`}`
		1688	`return @FIND_LIST;`
		1689	`}`
		1690
		1691	`#-------------------------------------------------------------------------------`
		1692	`# Function : CalcRelPath`
		1693	`#`
		1694	`# Description : Return the relative path to the current working directory`
		1695	`# as provided in $Cwd`
		1696	`#`
		1697	`# Inputs : $Cwd - Base dir`
		1698	`# $base - Path to convert`
		1699	`#`
		1700	`# Returns : Relative path from the $Cwd`
		1701	`#`
		1702	`sub CalcRelPath`
		1703	`{`
		1704	`my ($Cwd, $base) = @_;`
		1705
		1706	`my @base = split ('/', $base );`
		1707	`my @here = split ('/', $Cwd );`
		1708	`my $result;`
		1709
		1710	`Debug("RelPath: Source: $base");`
		1711
		1712	`return $base unless ( $base =~ m~^/~ );`
		1713
		1714	`#`
		1715	`# Remove common bits from the head of both lists`
		1716	`#`
		1717	`while ( $#base >= 0 && $#here >= 0 && $base[0] eq $here[0] )`
		1718	`{`
		1719	`shift @base;`
		1720	`shift @here;`
		1721	`}`
		1722
		1723	`#`
		1724	`# Need to go up some directories from here and then down into base`
		1725	`#`
		1726	`$result = '../' x ($#here + 1);`
		1727	`$result .= join ( '/', @base);`
		1728	`$result = '.' unless ( $result );`
		1729	`$result =~ s~//~/~g;`
		1730	`$result =~ s~/$~~;`
		1731
		1732	`Debug("RelPath: Result: $result");`
		1733	`return $result;`
		1734	`}`
		1735
		1736	`#-------------------------------------------------------------------------------`
		1737	`# Function : ExpandLinkFiles`
		1738	`#`
		1739	`# Description : Look for .LINK files in the output image and expand`
		1740	`# the links into softlinks`
		1741	`#`
		1742	`# Inputs : None`
		1743	`# The rouine works on the $DebianWorkDir directory tree`
		1744	`#`
		1745	`# Returns : Nothing`
		1746	`# Will remove .LINKS files that are processed`
		1747	`#`
		1748	`sub ExpandLinkFiles`
		1749	`{`
		1750	`foreach my $linkfile ( FindFiles( $DebianWorkDir, ".LINKS" ))`
		1751	`{`
		1752	`next if ( $linkfile =~ m~/\.svn/~ );`
		1753	`my $BASEDIR = StripFileExt( $linkfile );`
		1754	`$BASEDIR =~ s~^$DebianWorkDir/~~;`
		1755	`Verbose "Expand links: $BASEDIR";`
		1756
		1757	`open (LF, "<", $linkfile ) \|\| Error ("Cannot open link file: $linkfile" );`
		1758	`while ( <LF> )`
		1759	`{`
		1760	`chomp;`
		1761	`next if ( m~^#~ );`
		1762	`next unless ( $_ );`
		1763	`my ($link, $file) = split;`
		1764
		1765	`MakeSymLink($file ,"$BASEDIR/$link", '--NoDotDot' );`
		1766	`}`
		1767	`close (LF);`
		1768	`unlink $linkfile;`
		1769	`}`
		1770	`}`
		1771
		1772	`#-------------------------------------------------------------------------------`
		1773	`# Function : ResolveFile`
		1774	`#`
		1775	`# Description : Determine where the source for a file is`
415	dpurdie	1776	`# Will look in (default):`
407	dpurdie	1777	`# Local directory`
		1778	`# Local Include`
415	dpurdie	1779	`# Or (FromPackage)`
		1780	`# Our Package directory`
		1781	`# Interface directory (BuildPkgArchives)`
		1782	`# Packages (LinkPkgArchive)`
		1783	`#`
407	dpurdie	1784	`# Will scan 'parts' subdirs`
		1785	`#`
		1786	`# Inputs : $from_package - 0 - Local File`
		1787	`# $file`
		1788	`#`
		1789	`# Returns : Path`
		1790	`#`
		1791	`sub ResolveFile`
		1792	`{`
		1793	`my ($from_package, $file) = @_;`
		1794	`my $wildcard = ($file =~ /[*?]/);`
415	dpurdie	1795	`my @path;`
407	dpurdie	1796
		1797	`#`
415	dpurdie	1798	`# Determine the paths to search`
		1799	`#`
		1800	`if ( $from_package )`
		1801	`{`
		1802	`unless ( @ResolveFileList )`
		1803	`{`
		1804	`push @ResolveFileList, $opt_pkgdir;`
		1805	`foreach my $entry ( getPackageList() )`
		1806	`{`
		1807	`push @ResolveFileList, $entry->getBase(3);`
		1808	`}`
		1809	`}`
		1810	`@path = @ResolveFileList;`
		1811	`}`
		1812	`else`
		1813	`{`
		1814	`@path = ('.', $opt_localincdir);`
		1815	`}`
		1816
		1817	`#`
407	dpurdie	1818	`# Determine a full list of 'parts' to search`
		1819	`# This is provided within the build information`
		1820	`#`
		1821	`my @parts = getPlatformParts ();`
		1822	`push @parts, '';`
		1823
		1824	`my @done;`
		1825	`foreach my $root ( @path )`
		1826	`{`
		1827	`foreach my $subdir ( @parts )`
		1828	`{`
		1829	`my $sfile;`
415	dpurdie	1830	`$sfile = "$root/$subdir/$file";`
		1831	`$sfile =~ s~//~/~g;`
		1832	`$sfile =~ s~^./~~g;`
		1833	`Verbose2("LocateFile: $sfile, $root, $subdir");`
		1834	`if ( $wildcard )`
		1835	`{`
		1836	`push @done, glob ( $sfile );`
		1837	`}`
		1838	`else`
		1839	`{`
		1840	`push @done, $sfile if ( -f $sfile \|\| -l $sfile )`
		1841	`}`
407	dpurdie	1842	`}`
		1843	`}`
		1844
415	dpurdie	1845	`Error ("ResolveFile: File not found: $file", "Search Path:", @path)`
407	dpurdie	1846	`unless ( @done );`
		1847
		1848	`Warning ("ResolveFile: Multiple instances of file found. Only first is used", @done)`
		1849	`if ( $#done > 0 && ! $wildcard && !wantarray );`
		1850
		1851	`return wantarray ? @done : $done[0];`
		1852	`}`
		1853
		1854	`#-------------------------------------------------------------------------------`
		1855	`# Function : ResolveBinFile`
		1856	`#`
415	dpurdie	1857	`# Description : Determine where the source for a BIN file is`
		1858	`# Will look in (default):`
		1859	`# Local directory`
		1860	`# Local Include`
		1861	`# Or (FromPackage)`
		1862	`# Our Package directory`
		1863	`# Interface directory (BuildPkgArchives)`
		1864	`# Packages (LinkPkgArchive)`
407	dpurdie	1865	`# Will scan 'parts' subdirs`
		1866	`#`
		1867	`# Inputs : $from_package - 0 - Local File`
415	dpurdie	1868	`# $file`
407	dpurdie	1869	`#`
		1870	`# Returns : Path`
		1871	`#`
		1872	`sub ResolveBinFile`
		1873	`{`
		1874	`my ($from_package, $file) = @_;`
		1875	`my @path;`
		1876	`my @types;`
		1877	`my $wildcard = ($file =~ /[*?]/);`
		1878
415	dpurdie	1879	`#`
		1880	`# Determine the paths to search`
		1881	`#`
407	dpurdie	1882	`if ( $from_package )`
		1883	`{`
415	dpurdie	1884	`unless ( @ResolveBinFileList )`
		1885	`{`
		1886	`push @ResolveBinFileList, $opt_pkgdir . '/bin';`
		1887	`foreach my $entry ( getPackageList() )`
		1888	`{`
		1889	`if ( my $path = $entry->getBase(3) )`
		1890	`{`
		1891	`$path .= '/bin';`
		1892	`push @ResolveBinFileList, $path if ( -d $path );`
		1893	`}`
		1894	`}`
		1895	`}`
		1896	`@path = @ResolveBinFileList;`
407	dpurdie	1897	`@types = ($opt_type, '');`
		1898	`}`
		1899	`else`
		1900	`{`
		1901	`@path = ($opt_bindir, $opt_localbindir);`
		1902	`@types = '';`
		1903	`}`
		1904
		1905	`#`
		1906	`# Determine a full list of 'parts' to search`
		1907	`# This is provided within the build information`
		1908	`#`
		1909	`my @parts = getPlatformParts ();`
		1910	`push @parts, '';`
		1911
		1912	`my @done;`
		1913	`foreach my $root ( @path )`
		1914	`{`
		1915	`foreach my $subdir ( @parts )`
		1916	`{`
		1917	`foreach my $type ( @types )`
		1918	`{`
		1919	`my $sfile;`
		1920	`$sfile = "$root/$subdir$type/$file";`
		1921	`$sfile =~ s~//~/~g;`
		1922	`Verbose2("LocateBinFile: $sfile");`
		1923	`if ( $wildcard )`
		1924	`{`
429	dpurdie	1925	`foreach ( glob ( $sfile ) )`
		1926	`{`
4143	dpurdie	1927	`# Ignore .dbg (vix) and .debug (qt) files.`
429	dpurdie	1928	`next if ( m~\.dbg$~ );`
4143	dpurdie	1929	`next if ( m~\.debug$~ );`
429	dpurdie	1930	`push @done, $_;`
		1931	`}`
407	dpurdie	1932	`}`
		1933	`else`
		1934	`{`
415	dpurdie	1935	`push @done, $sfile if ( -f $sfile \|\| -l $sfile )`
407	dpurdie	1936	`}`
		1937	`}`
		1938	`}`
		1939	`}`
		1940
415	dpurdie	1941	`Error ("ResolveBinFile: File not found: $file", "Search Path:", @path)`
407	dpurdie	1942	`unless ( @done );`
		1943
		1944	`Warning ("ResolveBinFile: Multiple instances of file found. Only first is used", @done)`
		1945	`if ( $#done > 0 && ! $wildcard && !wantarray );`
		1946	`return wantarray ? @done : $done[0];`
		1947	`}`
		1948
		1949	`#-------------------------------------------------------------------------------`
		1950	`# Function : ResolveLibFile`
		1951	`#`
415	dpurdie	1952	`# Description : Determine where the source for a LIB file is`
		1953	`# Will look in (default):`
		1954	`# Local directory`
		1955	`# Local Include`
		1956	`# Or (FromPackage)`
		1957	`# Our Package directory`
		1958	`# Interface directory (BuildPkgArchives)`
		1959	`# Packages (LinkPkgArchive)`
407	dpurdie	1960	`# Will scan 'parts' subdirs`
		1961	`#`
		1962	`# Inputs : $from_package - 0 - Local File`
415	dpurdie	1963	`# $file - Basename for a 'realname'`
407	dpurdie	1964	`# Do not provide 'lib' or '.so' or version info`
		1965	`# May contain embedded options`
		1966	`# --Dll - use Windows style versioned DLL`
		1967	`# --VersionDll - USe the versioned DLL`
		1968	`#`
		1969	`# Returns : Path`
		1970	`#`
		1971	`sub ResolveLibFile`
		1972	`{`
		1973	`my ($from_package, $file) = @_;`
		1974	`my $wildcard = ($file =~ /[*?]/);`
		1975	`my @options;`
		1976	`my $num_dll;`
415	dpurdie	1977	`my @path;`
407	dpurdie	1978	`#`
		1979	`# Extract options from file`
		1980	`#`
409	alewis	1981	`$num_dll = 0;`
407	dpurdie	1982	`($file, @options) = split ( ',', $file);`
		1983	`foreach ( @options )`
		1984	`{`
		1985	`if ( m/^--Dll/ ) {`
		1986	`$num_dll = 1;`
		1987	`} elsif ( m/^--VersionDll/ ) {`
		1988	`$num_dll = 2;`
		1989	`} else {`
		1990	`Error ("Unknown suboption to ResolveLibFile: $_" );`
		1991	`}`
		1992	`}`
		1993
		1994	`#`
415	dpurdie	1995	`# Determine the paths to search`
		1996	`#`
		1997	`if ( $from_package )`
		1998	`{`
		1999	`unless ( @ResolveLibFileList )`
		2000	`{`
		2001	`push @ResolveLibFileList, $opt_pkgdir . '/lib';`
		2002	`foreach my $entry ( getPackageList() )`
		2003	`{`
		2004	`push @ResolveLibFileList, $entry->getLibDirs(3);`
		2005	`}`
		2006	`}`
		2007	`@path = @ResolveLibFileList;`
		2008	`}`
		2009	`else`
		2010	`{`
		2011	`@path = ($opt_libdir, $opt_locallibdir);`
		2012	`}`
		2013
		2014	`#`
407	dpurdie	2015	`# Determine a full list of 'parts' to search`
		2016	`# This is provided within the build information`
		2017	`#`
		2018	`my @parts = getPlatformParts ();`
		2019	`push @parts, '';`
		2020
		2021	`my @done;`
		2022	`foreach my $root ( @path )`
		2023	`{`
		2024	`foreach my $type ( $opt_type, '' )`
		2025	`{`
		2026	`foreach my $subdir ( @parts )`
		2027	`{`
		2028	`my $sfile;`
		2029	`my $exact;`
		2030	`if ( $num_dll == 2 ) {`
		2031	`$sfile = $file . $type . '.*.dll' ;`
		2032	`} elsif ( $num_dll == 1 ) {`
		2033	`$sfile = $file . $type . '.dll' ;`
		2034	`$exact = 1;`
		2035	`} else {`
		2036	`$sfile = "lib" . $file . $type . '.so.*';`
		2037	`}`
		2038
		2039	`$sfile = "$root/$subdir/$sfile";`
		2040	`$sfile =~ s~//~/~g;`
		2041	`Verbose2("LocateLibFile: $sfile");`
		2042	`if ( $exact )`
		2043	`{`
415	dpurdie	2044	`push @done, $sfile if ( -f $sfile \|\| -l $sfile );`
407	dpurdie	2045	`}`
419	dpurdie	2046	`elsif ($num_dll)`
407	dpurdie	2047	`{`
		2048	`push @done, glob ( $sfile );`
		2049	`}`
419	dpurdie	2050	`else`
		2051	`{`
		2052	`#`
		2053	`# Looking for .so files`
		2054	`# Filter out the soname so files`
		2055	`# Assume that the soname is shorter than the realname`
4143	dpurdie	2056	`# Ignore .dbg (vix) and .debug (qt) files.`
419	dpurdie	2057	`#`
		2058	`my %sieve;`
		2059	`foreach ( glob ( $sfile ) )`
		2060	`{`
429	dpurdie	2061	`next if ( m~\.dbg$~ );`
4143	dpurdie	2062	`next if ( m~\.debug$~ );`
421	alewis	2063	`m~(.\.so\.)([\d\.]\d)$~;`
		2064	`if ( $1 )`
		2065	`{`
		2066	`my $file = $1;`
		2067	`my $len = exists $sieve{$file} ? length($sieve{$file}) : 0;`
		2068	`$sieve{$file} = $_`
		2069	`if ( $len == 0 \|\| length($_) > $len );`
		2070	`}`
419	dpurdie	2071	`}`
		2072
		2073	`push @done, values %sieve;`
		2074	`}`
407	dpurdie	2075	`}`
		2076	`}`
		2077	`}`
		2078
415	dpurdie	2079	`Error ("ResolveLibFile: File not found: $file", "Search Path:", @path)`
407	dpurdie	2080	`unless ( @done );`
		2081
		2082	`Warning ("ResolveLibFile: Multiple instances of file found. Only first is used", @done)`
		2083	`if ( $#done > 0 && ! $wildcard && !wantarray );`
		2084
		2085	`return wantarray ? @done : $done[0];`
		2086	`}`
		2087
		2088
		2089	`#-------------------------------------------------------------------------------`
		2090	`# Function : AUTOLOAD`
		2091	`#`
		2092	`# Description : Intercept bad user directives and issue a nice error message`
		2093	`# This is a simple routine to report unknown user directives`
		2094	`# It does not attempt to distinguish between user errors and`
		2095	`# programming errors. It assumes that the program has been`
		2096	`# tested. The function simply report filename and line number`
		2097	`# of the bad directive.`
		2098	`#`
		2099	`# Inputs : Original function arguments ( not used )`
		2100	`#`
		2101	`# Returns : This function does not return`
		2102	`#`
		2103	`our $AUTOLOAD;`
		2104	`sub AUTOLOAD`
		2105	`{`
		2106	`my $fname = $AUTOLOAD;`
		2107	`$fname =~ s~^main::~~;`
		2108	`my ($package, $filename, $line) = caller;`
		2109
		2110	`Error ("Directive not known or not allowed in this context: $fname",`
		2111	`"Directive: $fname( @_ );",`
		2112	`"File: $filename, Line: $line" );`
		2113	`}`
		2114
		2115
		2116	`1;`
		2117

Subversion Repositories DevTools

(root)/debian_packager/branches/alewis_packagedbg/src/tools/scripts/DebianPackager.pl – Rev 4640