Subversion Repositories DevTools

########################################################################

# Copyright (C) 1998-2013 Vix Technology, All rights reserved

#

# Module name   : DebianPackager.pl

# Module type   : Makefile system

# Compiler(s)   : Perl

# Environment(s): jats

#

# Description   : This program is invoked by the MakeDebianPackage

#                 directive, that is a part of this package

#

#                 The program will use a user-provided script in order

#                 to create a Debian Package.

#

#                 The user script may call a number of directives in order to

#                 construct an image of the package being installed.

#

#                 The script specifies Debian configuration scaripts that

#                 will be embedded in the package.

#

#                 This program will:

#                   Construct a filesystem image under control of the directives

#                   within the user script

#

#                   Massage the Debian control file

#

#                   Create a Debian Package

#

#                   Transfer it to the users 'BIN' directory, where it is

#                   available to be packaged.

#

#                 Summary of directives available to the user-script:

#                       Message                 - Display progress text

#                       AddInitScript           - Add an init script

#                       CatFile                 - Append to a file

#                       ConvertFile             - Convert file(s) to Unix or Dos Text

#                       CopyDir                 - Copy directory tree

#                       CopyFile                - Copy a file

#                       CopyBinFile             - Copy an executable file

#                       CopyLibFile             - Copy a library file

#                       CopyDebPackage          - Copy a Debian Package

#                       CreateDir               - Create a directory

#                       DebianFiles             - Specify control and script files

#                       DebianControlFile       - Specify control and script files

#                       DebianDepends           - Add Depends entry to control file

#                       EchoFile                - Place text into a file

#                       MakeSymLink             - Create a symbolic link

#                       PackageDescription      - Specify the package description

#                       ReplaceTags             - Replace Tags on target file

#                       SetFilePerms            - Set file permissions

#                       SetVerbose              - Control progress display

#                       IsProduct               - Flow control

#                       IsPlatform              - Flow control

#                       IsTarget                - Flow control

#                       IsVariant               - Flow control

#                       IsAlias                 - Flow control

#

#                 Thoughts for expansion:

#                       SrcDir                  - Extend path for resolving local files

#

#                   Less used:

#                        ExpandLinkFiles        - Expand .LINK files

#

#                   Internal Use:

#                        FindFiles              - Find a file

#                        ResolveFile            - Resolve a 'local' source file

#                        chmodItem              - Set file or directory permissions

#                        

#......................................................................#

require 5.006_001;

use strict;

use warnings;

use Getopt::Long;

use File::Path;

use File::Copy;

use File::Find;

use JatsSystem;

use FileUtils;

use JatsError;

use JatsLocateFiles;

use ReadBuildConfig;

use JatsCopy ();                            # Don't import anything

#

#   Globals

#

my $DebianWorkDirBase;                      # Workspace

my $DebianWorkDir;                          # Dir to create file system image within

#

#   Command line options

#

my $opt_debug   = $ENV{'GBE_DEBUG'};        # Allow global debug

my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose

my $opt_vargs;                              # Verbose arg

my $opt_help = 0;

my $opt_manual = 0;

my $opt_clean = 0;

my $opt_interfacedir;

my $opt_package_script;

my $opt_interfaceincdir;

my $opt_interfacelibdir;

my $opt_interfacebindir;

my $opt_libdir;

my $opt_bindir;

my $opt_localincdir;

my $opt_locallibdir;

my $opt_localbindir;

my $opt_pkgdir;

my $opt_pkglibdir;

my $opt_pkgbindir;

my $opt_pkgpkgdir;

my $opt_output;

my $opt_tarFile;

my $opt_noarch;

#

#   Options marked as 'our' so that they are visible within the users script

#   Don't give the user too much

#

our $opt_platform;

our $opt_type;

our $opt_buildname;

our $opt_buildversion;

our $opt_target;

our $opt_product;

our $opt_name;

our $opt_variant;

our $opt_pkgarch;

#

#   Options derived from script directives

#

my $opt_description;

#

#   Globals

#

my @ResolveFileList;                    # Cached Package File List

my @ResolveBinFileList;                 # Cached PackageBin File List

my @ResolveDebFileList;                 # Cached PackageDeb File List

my @ResolveLibFileList;                 # Cached PackageLib File List

my %DebianControlFiles;                 # Control Files

my %DebianControlFileNames;             # Control Files by name

my @DependencyList;                     # Package Dependencies

my @ConfigList;                         # Config Files

my %opt_aliases;                        # Cached Alias Names

#-------------------------------------------------------------------------------

# Function        : Main Entry point

#

# Description     : This function will be called when the package is initialised

#                   Extract arguments from the users environment

#

#                   Done here to greatly simplify the user script

#                   There should be no junk in the user script - keep it simple

#

# Inputs          :

#

# Returns         : 

#

main();

sub main

{

    my $result = GetOptions (

                "verbose:s"         => \$opt_vargs,

                "clean"             => \$opt_clean,

                "Type=s"            => \$opt_type,

                "BuildName=s"       => \$opt_buildname,                     # Raw Jats Package Name (Do not use)

                "Name=s"            => \$opt_name,                          # Massaged Debian Package Name

                "BuildVersion=s"    => \$opt_buildversion,

                "Platform=s"        => \$opt_platform,

                "Target=s"          => \$opt_target,

                "Product=s"         => \$opt_product,

                "DebianPackage=s"   => \$opt_package_script,

                "InterfaceDir=s"    => \$opt_interfacedir,

                "InterfaceIncDir=s" => \$opt_interfaceincdir,

                "InterfaceLibDir=s" => \$opt_interfacelibdir,

                "InterfaceBinDir=s" => \$opt_interfacebindir,

                "LibDir=s"          => \$opt_libdir,

                "BinDir=s"          => \$opt_bindir,

                "LocalIncDir=s"     => \$opt_localincdir,

                "LocalLibDir=s"     => \$opt_locallibdir,

                "LocalBinDir=s"     => \$opt_localbindir,

                "PackageDir=s"      => \$opt_pkgdir,

                "PackageLibDir=s"   => \$opt_pkglibdir,

                "PackageBinDir=s"   => \$opt_pkgbindir,

                "PackagePkgDir=s"   => \$opt_pkgpkgdir,

                "Output=s"          => \$opt_output,

                "tarFile=s"         => \$opt_tarFile,

                "Variant:s"         => \$opt_variant,

                "PkgArch:s"         => \$opt_pkgarch,

                "NoArch"            => \$opt_noarch,

    );

    $opt_verbose++ unless ( $opt_vargs eq '@' );

    ErrorConfig( 'name'    => 'DebianUtils',

                 'verbose' => $opt_verbose,

                 'debug'   => $opt_debug );

    #

    #   Init the FileSystem Uiltity interface

    #

    InitFileUtils();

    #

    #   Ensure that we have all required options

    #

    Error ("Platform not set")                  unless ( $opt_platform );

    Error ("Type not set")                      unless ( $opt_type );

    Error ("BuildName not set")                 unless ( $opt_buildname );

    Error ("Debian Package Name not set")       unless ( $opt_name );

    Error ("BuildVersion not set")              unless ( $opt_buildversion );

    Error ("InterfaceDir not set")              unless ( $opt_interfacedir );

    Error ("Target not set")                    unless ( $opt_target );

    Error ("Product not set")                   unless ( $opt_product );

    Error ("DebianPackage not set")             unless ( $opt_package_script );

    Error ("Ouput File not set")                unless ( $opt_output );

    #

    #   Read in relevent config information

    #

    ReadBuildConfig ($opt_interfacedir, $opt_platform, '--NoTest' );

    #

    #   Build the package image in a directory based on the target being created

    #

    $DebianWorkDirBase = uc("$opt_platform$opt_type.image");

    $DebianWorkDir = "$DebianWorkDirBase/$opt_name";

    #

    #   Configure the System command to fail on any error

    #

    SystemConfig ( ExitOnError => 1 );

    #

    #   Defaults

    #

    $opt_pkgarch = $opt_platform unless ( $opt_pkgarch );

    $opt_pkgarch = 'all' if ( $opt_noarch );

    #

    #   Display variables used

    #

    Message    ("=Building Debian Package =============================================");

    Message    ("Build $opt_name");

    Message    ("       Package: $opt_buildname");

    Message    ("       Variant: $opt_variant") if ($opt_variant);

    Message    ("       Version: $opt_buildversion");

    Message    ("  Building for: $opt_platform, $opt_target");

    Message    ("       Product: $opt_product");

    Message    ("          Type: $opt_type");

    Message    ("      Pkg Arch: $opt_pkgarch") if ($opt_pkgarch);

    Verbose    ("       Verbose: $opt_verbose");

    Verbose    ("  InterfaceDir: $opt_interfacedir");

    Message    ("       Package: " . StripDirExt($opt_output));

    Message    ("       TarFile: " . StripDirExt($opt_tarFile)) if ($opt_tarFile);

    Message    ("======================================================================");

    #

    #   Perform Clean up

    #   Invoked during "make clean" or "make clobber"

    #

    if ( $opt_clean )

    {

        Message ("Remove packaging directory: $DebianWorkDir");

        #

        #   Remove the directory for this package

        #   Remove the general work dir - if all packages have been cleaned

        #

        rmtree( $DebianWorkDir );

        rmdir( $DebianWorkDirBase );

        rmtree ($opt_output) if ( -f $opt_output );

        exit;

    }

    #

    #   NoArch sanity test

    #   MUST only build no-arch for production

    #   User MUST do this in the build.pl file

    #

    if ($opt_noarch && $opt_type ne 'P')

    {

        Error ("Debian Packages marked as NoArch (all) must be built ONLY for production",

               "This must be configured in the build.pl" );

    }

    #

    #   Clean  out the WORK directory

    #   Always start with a clean slate

    #

    #   Ensure that the base of the directory tree does not have 'setgid'

    #       This will upset the debian packager

    #       This may be an artifact from the users directory and not expected

    #

    rmtree( $DebianWorkDir );

    mkpath( $DebianWorkDir );

    my $perm = (stat $DebianWorkDir)[2] & 0777;

    chmod ( $perm & 0777, $DebianWorkDir );

    #

    #   Invoke the user script to do the hard work

    #

    unless (my $return = do $opt_package_script) {

            Error ("Couldn't parse $opt_package_script: $@") if $@;

            Error ("Couldn't do $opt_package_script: $!")    unless defined $return;

        }

    #

    #   Complete the building of the package

    #

    if ($opt_tarFile)

    {

        BuildTarFile();

        Message ("Created TGZ file");

    }

    BuildDebianPackage ();

    Message ("Created Debian Package");

}

#-------------------------------------------------------------------------------

# Function        : BuildDebianPackage

#

# Description     : This function will create the Debian Package

#                   and transfer it to the target directory

#

# Inputs          : None

#

# Returns         : Nothing

#

sub BuildDebianPackage

{

    Error ("BuildDebianPackage: No Control File or Package Description")

        unless ( exists($DebianControlFiles{'control'}) || $opt_description );

    #

    #   Convert the FileSystem Image into a Debian Package

    #       Insert Debian control files

    #

    Verbose ("Copy in the Debian Control Files");

    mkdir ( "$DebianWorkDir/DEBIAN" );

    #

    #   Copy in all the named Debian Control files

    #       Ignore any control file. It will be done next

    #

    foreach my $key ( keys %DebianControlFiles )

    {

        next if ($key eq 'control');

        CopyFile ( $DebianControlFiles{$key}, '/DEBIAN', $key  );

    }

    #

    #   Create 'conffiles'

    #       Append to any user provided file

    if ( @ConfigList )

    {

        my $conffiles = "$DebianWorkDir/DEBIAN/conffiles";

        Warning("Appending user specified entries to conffiles") if ( -f $conffiles);

        FileAppend( $conffiles, @ConfigList );

    }

    #

    #   Massage the 'control' file

    #

    UpdateControlFile ($DebianControlFiles{'control'} );

    #

    #   Mark all files in the debian folder as read-execute

    #

    System ( 'chmod', '-R', 'a+rx', "$DebianWorkDir/DEBIAN" );

    System ( 'build_dpkg.sh', '-b', $DebianWorkDir);

    System ( 'mv', '-f', "$DebianWorkDir.deb", $opt_output );

    System ("build_dpkg.sh", '-I', $opt_output) if (IsVerbose(1));

}

#-------------------------------------------------------------------------------

# Function        : BuildTarFile 

#

# Description     : This function will create a TGZ file of the constructed package

#                   Not often used 

#

# Inputs          : None

#

# Returns         : Nothing

#

sub BuildTarFile

{

    Verbose ("Create TGZ file containing body of the package");

    System ('tar', 

            '--create',

            '--auto-compress',

            '--owner=0' ,

            '--group=0' ,

            '--one-file-system' ,

            '--exclude=./DEBIAN' ,

            '-C', $DebianWorkDir,  

            '--file', $opt_tarFile,

            '.'

            );

}

#-------------------------------------------------------------------------------

# Function        : UpdateControlFile

#

# Description     : Update the Debian 'control' file to fix up various fields

#                   within the file.

#

#                   If the files has not been specified, then a basic control

#                   file will be provided.

#

#                   This routine knows where the control file will be placed

#                   within the output work space.

#

# Inputs          : $src            - Path to source file

#                   Uses global variables

#

# Returns         : Nothing

#

sub UpdateControlFile

{

    my($src) = @_;

    my $dst = "$DebianWorkDir/DEBIAN/control";

    unless ( $src )

    {

        CreateControlFile();

        return;

    }

    #

    #   User has provided a control file

    #       Tweak the internals

    #

    Verbose ("UpdateControlFile: $dst" );

    $src = ResolveFile( 0, $src );

    #   Calc depends line

    my $depData = join (', ', @DependencyList );

    open (SF, '<', $src) || Error ("UpdateControlFile: Cannot open:$src, $!");

    open (DF, '>', $dst) || Error ("UpdateControlFile: Cannot create:$dst, $!");

    while ( <SF> )

    {

        s~\s*$~~;

        if ( m~^Package:~ ) {

            $_ = "Package: $opt_name";

        } elsif ( m~^Version:~ ) {

            $_ = "Version: $opt_buildversion";

        } elsif ( m~^Architecture:~ ) {

            $_ = "Architecture: $opt_pkgarch";

        } elsif ( $opt_description && m~^Description:~ ) {

            $_ = "Description: $opt_description";

        } elsif ( m~^Depends:~ ) {

            $_ = "Depends: $depData";

            $depData = '';

        }

        print DF $_ , "\n";

    }

    close (SF);

    close (DF);

    #

    #   Warn if Depends section is needed

    #

    Error ("No Depends section seen in user control file") 

        if ($depData);

}

#-------------------------------------------------------------------------------

# Function        : CreateControlFile

#

# Description     : Craete a basic debian control file

#

# Inputs          : Uses global variables

#

# Returns         : 

#

sub CreateControlFile

{

    my $dst = "$DebianWorkDir/DEBIAN/control";

    Verbose ("CreateControlFile: $dst" );

    my $depData = join (', ', @DependencyList );

    open (DF, '>', $dst) || Error ("CreateControlFile: Cannot create:$dst");

    print DF "Package: $opt_name\n";

    print DF "Version: $opt_buildversion\n";

    print DF "Section: main\n";

    print DF "Priority: standard\n";

    print DF "Architecture: $opt_pkgarch\n";

    print DF "Essential: No\n";

    print DF "Maintainer: Vix Technology\n";

    print DF "Description: $opt_description\n";

    print DF "Depends: $depData\n" if ($depData);

    close (DF);

}

#-------------------------------------------------------------------------------

# Function        : SetVerbose

#

# Description     : Set the level of verbosity

#                   Display activity

#

# Inputs          : Verbosity level

#                       0 - Use makefile verbosity (Default)

#                       1..2

#

# Returns         : 

#

sub SetVerbose

{

    my ($level) = @_;

    $level = $opt_verbose unless ( $level );

    $opt_verbose = $level;

    ErrorConfig( 'verbose' => $level);

}

#-------------------------------------------------------------------------------

# Function        : DebianFiles

#

# Description     : Name Debian builder control files

#                   May be called multiple times

#

# Inputs          : Options

#                       --Control=file

#                       --PreRm=file

#                       --PostRm=file

#                       --PreInst=file

#                       --PostInst=file

#                         

#

# Returns         : Nothing

#

sub DebianFiles

{

    #

    #   Extract names

    #

    Verbose ("Specify Debian Control Files and Scripts");

    foreach  ( @_ )

    {

        if ( m/^--Control=(.+)/i ) {

            DebianControlFile('control',$1)

        } elsif ( m/^--PreRm=(.+)/i ) {

            DebianControlFile('prerm',$1)

        } elsif ( m/^--PostRm=(.+)/i ) {

            DebianControlFile('postrm',$1)

        } elsif ( m/^--PreInst=(.+)/i ) {

            DebianControlFile('preinst',$1)

        } elsif ( m/^--PostInst=(.+)/i ) {

            DebianControlFile('postinst',$1)

        } else {

            Error ("DebianFiles: Unknown option: $_");

        }

    }

}

#-------------------------------------------------------------------------------

# Function        : DebianControlFile 

#

# Description     : Add special control files to the Debian Installer 

#                   Not useful for embedded installers

#

#                   More general than DebianFiles()

#

# Inputs          : name            - Target Name

#                                     If the name starts with 'package.' then it will be replaced

#                                     with the name of the current package

#                   file            - Source File Name

#                   options         - Options include

#                                       --FromPackage

#

# Returns         : 

#

sub DebianControlFile

{

    my ($name, $file, @options) = @_;

    my $fromPackage = 0;

    #

    #   Process options

    foreach ( @options)

    {

        if (m~^--FromPackage~) {

            $fromPackage = 1;

        }

        else  {

            ReportError(("DebianControlFile: Unknown argument: $_"));

        }

    }

    ErrorDoExit();

    #

    #   Some control files need to have the package name prepended

    #

    $name =~ s~^package\.~$opt_name.~;

    #

    #   Only allow one file of each type

    #       Try to protect the user by testing for names by lowercase

    #

    my $simpleName = lc($name);

    Error("DebianControlFile: Multiple definitions for '$name' not allowed")

        if (exists $DebianControlFileNames{$simpleName});

    my $filePath = ResolveFile($fromPackage, $file);

    #

    #   Add info to data structures

    #

    $DebianControlFiles{$name} = $filePath;

    $DebianControlFileNames{$simpleName} = $name;

}

#-------------------------------------------------------------------------------

# Function        : DebianDepends 

#

# Description     : This directive allows simple dependency information to be  

#                   inserted into the control file

#

#                   Not useful in embedded system

#

# Inputs          : Entry             - A dependency entry

#                   ...               - More entries

#                   

#

# Returns         : Nothing

#

sub DebianDepends

{

    push @DependencyList, @_;

}

#-------------------------------------------------------------------------------

# Function        : PackageDescription

#

# Description     : Specify the Package Description

#                   Keep it short

#

# Inputs          : $description

#

# Returns         : 

#

sub PackageDescription

{

    ($opt_description) = @_;

}

#-------------------------------------------------------------------------------

# Function        : MakeSymLink

#

# Description     : Create a symlink - with error detection

#

# Inputs          : old_file    - Link Target

#                                 Path to the link target

#                                 If an ABS path is provided, the routine will

#                                 attempt to create a relative link.

#                   new_file    - Relative to the output work space

#                                 Path to where the 'link' file will be created

#                   Options     - Must be last

#                                 --NoClean         - Don't play with links

#                                 --NoDotDot        - Don't create symlinks with ..

#

# Returns         : Nothing

#

sub MakeSymLink

{

    my $no_clean;

    my $no_dot;

    my @args;

    #

    #   Extract options

    #

    foreach ( @_ )

    {

        if ( m/^--NoClean/i ) {

            $no_clean = 1;

        } elsif ( m/^--NoDotDot/i ) {

            $no_dot = 1;

        } elsif ( m/^--/ ) {

            Error ("MakeSymLink: Unknown option: $_");

        } else {

            push @args, $_;

        }

    }

    my ($old_file, $new_file) = @args;

    my $tfile = $DebianWorkDir . '/' . $new_file;

    $tfile =~ s~//~/~;

    Verbose ("Symlink $old_file -> $new_file" );

    #

    #   Create the directory in which the link will be placed

    #   Remove any existing file of the same name

    #

    my $dir = StripFileExt( $tfile );

    mkpath( $dir) unless -d $dir;

    unlink $tfile;

    #

    #   Determine a good name of the link

    #   Convert to a relative link in an attempt to prune them

    #

    my $sfile = $old_file;

    unless ( $no_clean )

    {

        $sfile = CalcRelPath( StripFileExt( $new_file ), $old_file );

        $sfile = $old_file if ( $no_dot && $sfile =~ m~^../~ );

    }

    my $result = symlink $sfile, $tfile;

    Error ("Cannot create symlink. $old_file -> $new_file") unless ( $result );

}

#-------------------------------------------------------------------------------

# Function        : CopyFile

#

# Description     : Copy a file to a target dir

#                   Used for text files, or files with fixed names

#

# Inputs          : $src

#                   $dst_dir    - Within the output workspace

#                   $dst_name   - Output Name [Optional]

#                   Options     - Common Copy Options

#

# Returns         : Full path to destination file

#

sub CopyFile

{

    CopyFileCommon( \&ResolveFile, @_ );

}

#-------------------------------------------------------------------------------

# Function        : CopyBinFile

#

# Description     : Copy a file to a target dir

#                   Used for executable programs. Will look in places where

#                   programs are stored.

#

# Inputs          : $src

#                   $dst_dir    - Within the output workspace

#                   $dst_name   - Output Name [Optional]

#

#                   Options:

#                       --FromPackage

#                       --SoftLink=xxxx

#                       --LinkFile=xxxx

#

#

# Returns         : Full path to destination file

#

sub CopyBinFile

{

    CopyFileCommon( \&ResolveBinFile, @_ );

}

#-------------------------------------------------------------------------------

# Function        : CopyLibFile

#

# Description     : Copy a file to a target dir

#                   Used for shared programs. Will look in places where

#                   shared libraries are stored.

#

# Inputs          : $src        - Base for 'realname' (no lib, no extension)

#                   $dst_dir    - Within the output workspace

#                   $dst_name   - Output Name [Optional, but not suggested]

#

# Returns         : Full path to destination file

#

# Notes           : Copying 'lib' files

#                   These are 'shared libaries. There is no provision for copying

#                   static libraries.

#

#                   The tool will attempt to copy a well-formed 'realname' library

#                   The soname of the library should be constructed on the target

#                   platform using ldconfig.

#                   There is no provision to copy the 'linker' name

#

#                   Given a request to copy a library called 'fred', then the

#                   well formed 'realname' will be:

#                           libfred[P|D|]].so.nnnnn

#                   where:

#                           nnnn is the library version

#                           [P|D|] indicates Production, Debug or None

#

#                   The 'soname' is held within the realname form of the library

#                   and will be created by lsconfig.

#

#                   The 'linkername' would be libfred[P|D|].so. This is only

#                   needed when linking against the library.

#

#

#                   The routine will also recognize Windows DLLs

#                   These are of the form fred[P|D|].nnnnn.dll

#

sub CopyLibFile

{

    CopyFileCommon( \&ResolveLibFile, @_ );

}

#-------------------------------------------------------------------------------

# Function        : CopyDebianPackage

#

# Description     : Copy a Debian Package to a target dir

#                   Will look in places where Debian Packages are stored.

#

# Inputs          : $src        - BaseName for 'Debian Package' (no version, no extension)

#                   $dst_dir    - Within the output workspace

#                   Optional arguments embedded into the BaseName

#                   --Arch=XXXX         - Architecture - if not current

#                   --Product=XXXX      - Product - if required

#                   --Debug             - If not the current type

#                   --Prod              - If not the current type

#

# Returns         : Full path to destination file

#

# Notes           : Copying Debian Packages from external packages

#

#                   The tool will attempt to copy a well-formed debian packages

#                   These are:

#                   

#                       "BaseName_VersionString[_Product]_Arch${PkgType}.deb";

#                   

#                   Where 'Product' is optional (and rare)

#                   Where 'PkgType' is P or D or nothing

#                   Where 'Arch' may be 'all'

#                   

#                   The routine will locate Debian packages in

#                       - The root of the package

#                       - bin/TARGET[P|D/]

#                       - bin/Arch[P|D]

#

#

sub CopyDebianPackage

{

    CopyFileCommon( \&ResolveDebPackage, '--FromPackage', @_ );

}

#-------------------------------------------------------------------------------

# Function        : CopyFileCommon

#

# Description     : Common ( internal File Copy )

#

# Inputs          : $resolver           - Ref to function to resolve source file

#                   $src                - Source File Name

#                   $dst_dir            - Target Dir

#                   $dst_name           - Target Name (optional)

#                   Options

#                   Options:

#                       --FromPackage

#                       --FromBuild

#                       --SoftLink=xxxx

#                       --LinkFile=xxxx

#                       --ConfigFile

#

# Returns         : 

#

sub CopyFileCommon

{

    my $from_package = 0;

    my $isa_linkfile = 0;

    my $isa_configFile = 0;

    my @llist;

    my @args;

    #

    #   Parse options

    #

    foreach ( @_ )

    {

        if ( m/^--FromPackage/ ) {

            $from_package = 1;

        } elsif ( m/^--FromBuild/ ) {

            $from_package = 0;

        } elsif ( m/^--LinkFile/ ) {

            $isa_linkfile = 1;

        } elsif ( m/^--ConfFile/i ) {

            $isa_configFile = 1;

        } elsif ( m/^--SoftLink=(.+)/ ) {

            push @llist, $1;

        } elsif ( m/^--/ ) {

            Error ("FileCopy: Unknown option: $_");

        } else {

            push @args, $_;

        }

    }

    #

    #   Extract non-options.

    #   These are the bits that are left over

    #

    my ($resolver, $src, $dst_dir, $dst_name ) = @args;

    #

    #   Clean up dest_dir. Must start with a / and not end with one

    #

    $dst_dir = "/$dst_dir/";

    $dst_dir =~ s~/+~/~g;

    $dst_dir =~ s~/$~~;

    Verbose ("CopyFile: $src, $dst_dir, " . ($dst_name || ''));

    foreach $src ( &$resolver( $from_package, $src ) )

    {

        my $dst_fname = $dst_name ? $dst_name : StripDir($src);

        my $dst_file = "$dst_dir/$dst_fname";

        Verbose ("CopyFile: Copy $src, $dst_file" );

        #

        #   LinkFiles are special

        #   They get concatenated to any existing LINKS File

        #

        if ( $isa_linkfile )

        {

            CatFile ( $src, "$dst_dir/.LINKS" );

        }

        else

        {

            mkpath( "$DebianWorkDir$dst_dir", 0, 0775);

            unlink ("$DebianWorkDir$dst_file");

            System ('cp','-f', $src, "$DebianWorkDir$dst_file" );

            foreach my $lname ( @llist )

            {

                $lname = $dst_dir . '/' . $lname unless ( $lname =~ m ~^/~ );

                MakeSymLink( $dst_file ,$lname);

            }

        }

        #

        #   ConfigFiles are marked so that they can be handled by the debain installer

        #

        if ($isa_configFile)

        {

            push @ConfigList, $dst_file;

        }

    }

}

#-------------------------------------------------------------------------------

# Function        : CopyDir

#

# Description     : Copy a directory to a target dir

#

# Inputs          : $src_dir    - Local to the user