Subversion Repositories DevTools

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

# COPYRIGHT - VIX IP PTY LTD ("VIX"). 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 and MakeRpmPackage

#                 directive that is a part of this package

#

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

#                 to create the output 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/RPM configuration scripts that

#                 will be embedded in the package.

#

#                 This program will:

#                   Construct a filesystem image under control of the directives

#                   within the user script

#

#                   Debian:

#                       Massage the Debian control file

#                       Create a Debian Package

#                       Transfer it to the users 'BIN' directory, where it is available to be packaged.

#                       

#                   RedHat Package:    

#                       Generate rpmBuilder control files

#                       Create the RPM image

#                       Transfer it to the users 'BIN' directory, where it is available to be packaged.

#                   

#                   TarFile:

#                       Tar Gzip the image

#                       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

#                       Verbose                 - 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

#                       AllFiles                - Specify control and script files 

#                       DebianFiles             - Specify control and script files (Debian Only)

#                       RpmFiles                - Specify control and script files (RPM Only)

#                       AllControlFile          - Specify control and script files

#                       DebianControlFile       - Specify control and script files (Debian Only)

#                       RpmControlFile          - Specify control and script files (RPM Only)

#                       AllDepends               - Add Depends entry to control file

#                       DebianDepends           - Add Depends entry to control file (Debian Only)

#                       RpmDepends              - Add Depends entry to control file (RPM Only)

#                       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

#                       RpmSetDefAttr           - Specify default file properties (RPM Only)

#                       RpmSetAttr              - Specify file properties (RPM Only)    

#                       SetBaseDir              - Sets base for installed files (RPM Hint for directory ownership)

#                       Section                 - Set current section

#

#                 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 ArrayHashUtils;

use JatsError;

use JatsLocateFiles;

use ReadBuildConfig;

use JatsCopy ();                            # Don't import anything

use PackagerUtils;

#

#   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_noarch;

my $opt_tarFile;

my $opt_tarOnly;

my $opt_rpm = 0;

my $opt_debian = 0;

my $opt_output;

#

#   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;

our $opt_rpmRelease = '';

#

#   Options derived from script directives

#

my $opt_description;

my $opt_specFile;

#

#   Globals

#

my $WorkDirBase;                            # Workspace

my $WorkDirInit;                            # Initial Dir to create file system image within

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

my $WorkSubDir = '';                        # Diff between $WorkDirInit and $WorkDir

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 %ControlFiles;                           # Control Files

my %ControlFileNames;                       # Control Files by name

my @DependencyList;                         # Package Dependencies

my @ConfigList;                             # Config Files

my %opt_aliases;                            # Cached Alias Names

my @RpmDefAttr = ('-','root','root','-');   # RPM: Default File Attributes

my @RpmAttrList;                            # RPM: File attributes

my %OwnedDirs;                              # RPM: Dirs marked as owned

my $ActiveSection = 1;                      # Indicates if the section is active

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

# 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,

                '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,

                'Variant:s'         => \$opt_variant,

                'PkgArch:s'         => \$opt_pkgarch,

                'NoArch'            => \$opt_noarch,

                'tarFile=s'         => \$opt_tarFile,

                'tarOnly'           => \$opt_tarOnly,

                'genRpm'            => \$opt_rpm,

                'genDeb'            => \$opt_debian,

                'output=s'          => \$opt_output,

                'script=s'          => \$opt_package_script,

                'rpmRelease=s'      => \$opt_rpmRelease,

    );

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

    ErrorConfig( 'name'    => 'PackagerUtils',

                 '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 ("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 ("Packaging Script not set")          unless ( $opt_package_script );

    #

    #   Read in relevent config information

    #

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

    #

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

    #

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

    $WorkDirInit = "$WorkDirBase/$opt_name";

    $WorkDir = $WorkDirInit;

    #

    #   Configure the System command to fail on any error

    #

    SystemConfig ( ExitOnError => 1 );

    #

    #   Defaults

    #

    $opt_pkgarch = $opt_platform unless ( $opt_pkgarch );

    #

    #   Determine build operations

    #   

    my $genDebian = $opt_debian;

    my $genRpm = $opt_rpm;

    if ($opt_tarOnly) {

        $genDebian = $genRpm = 0; 

    }

    #

    #   Display variables used

    #

    Message    ("= Building Installer ================================================");

    Message    ("        Format: Debian") if ($genDebian);

    Message    ("        Format: RPM") if ($genRpm);

    Message    ("        Format: TGZ") if ($opt_tarFile);

    Message    ("          Name: $opt_name");

    Message    ("       Package: $opt_buildname");

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

    Message    ("       Version: $opt_buildversion");

    Message    ("  Building for: $opt_platform");

    Message    ("        Target: $opt_target") if ( $opt_platform ne $opt_target);

    Message    ("       Product: $opt_product") if ($opt_product ne $opt_platform);

    Message    ("          Type: $opt_type");

    Message    ("   RPM Release: $opt_rpmRelease") if ($opt_rpmRelease);

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

    Verbose    ("       Verbose: $opt_verbose");

    Verbose    ("  InterfaceDir: $opt_interfacedir");

    Message    ("        Output: " . StripDir($opt_output))  if ($genDebian || $genRpm);

    Message    ("        Output: " . StripDir($opt_tarFile)) if $opt_tarFile;

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

    #

    #   Perform Clean up

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

    #

    if ( $opt_clean )

    {

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

        #

        #   Remove the directory for this package

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

        #

        rmtree( $WorkDirBase );

        rmtree ($opt_tarFile) if ( defined($opt_tarFile) && -f $opt_tarFile );

        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 ("Installer 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( $WorkDirInit );

    mkpath( $WorkDirInit );

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

    chmod ( $perm & 0777, $WorkDirInit );

    #

    #   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;

        };

    $ActiveSection = 1;

    #

    #   Now have an image of the directory that we wish to package

    #   Complete the building of the package

    #

    if ($opt_tarFile) {

        BuildTarFile();

        Message ("Created TGZ file");

    }

    #

    #   Create an RPM

    #

    if ($genRpm) {

        BuildRPM ();

        Message ("Created RPM");

    }

    #

    #   Create a Debian Package

    #

    if ($genDebian) {

        BuildDebianPackage ();

        Message ("Created Debian Package");

    }

}

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

# Function        : BuildRPM 

#

# Description     : This function will create the Debian Package

#                   and transfer it to the target directory

#

# Inputs          : None

#

# Returns         : Nothing

# 

sub BuildRPM

{

    #

    #   Sanity Checks

    #

    Error ("BuildRPM: Release")

        unless ( $opt_rpmRelease );

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

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

    #

    #   Massage the 'control' file

    #   Generate or Massage

    #

    $opt_specFile = catfile($WorkDirBase, 'RPM.spec' );

    UpdateRedHatControlFile ($ControlFiles{'control'} );

    #   Generate a dummy rc file

    my $rcFile = catdir($WorkDirBase,'tmprc');

    TouchFile($rcFile);

    #

    #   Run the RPM builder

    #   Expect it to be installed on the build machine

    #

    my $prog = LocateProgInPath( 'rpmbuild', '--All');

    Error ("RPM Packager: The rpmbuild utility is not installed") unless $prog;

    System ($prog, '-bb', $opt_specFile, 

                   '--buildroot', AbsPath($WorkDirInit) ,

                   '--define', '_rpmdir ' . StripFileExt($opt_output),

                   '--define', '_rpmfilename ' .  StripDir($opt_output),

                   '--define', '_topdir ' . catfile($WorkDirBase, 'RPMBUILD' ),

                   '--noclean',

                   $opt_verbose ? '-v' : '--quiet',

                   $opt_noarch ?  '--target=noarch' : undef,

                   '--rcfile', $rcFile ,

                   );

}

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

# 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($ControlFiles{'control'}) || $opt_description );

    #

    #   Convert the FileSystem Image into a Debian Package

    #       Insert Debian control files

    #

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

    mkdir ( "$WorkDirInit/DEBIAN" );

    #

    #   Copy in all the named Debian Control files

    #       Ignore any control file. It will be done next

    #

    foreach my $key ( keys %ControlFiles )

    {

        next if ($key eq 'control');

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

    }

    #

    #   Create 'conffiles'

    #       Append to any user provided file

    if ( @ConfigList )

    {

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

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

        FileAppend( $conffiles, @ConfigList );

    }

    #

    #   Massage the 'control' file

    #

    UpdateDebianControlFile ($ControlFiles{'control'} );

    #

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

    #

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

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

    System ( 'mv', '-f', "$WorkDirInit.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', $WorkDirInit,  

            '--file', $opt_tarFile,

            '.'

            );

}

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

# Function        : Section 

#

# Description     : Allows the Package file to be split into section

#                   This direcive is always active.

#

# Inputs          : Selector

#                       ALL     - Active

#                       RPM     - Active section when building an RPM

#                       DEBIAN  - Active section if build a Debian package

#                       TAR     - Active section if building a TAR

#

# Returns         : Nothing

#                   Will fkag to indicate if directives are active. 

#

sub Section

{

    my $newActiveSection;

    my $flip = sub {

        my ($val, $mode) = @_;

        if ( defined $mode) {

            return $val ? 0 : 1;

        }

        return $val;

    };

    $newActiveSection = 1 unless (@_);

    foreach my $arg ( @_)

    {

        if ($arg =~ m/^(!)*DEBIAN/i) {

            $newActiveSection = 1 if  $flip->($opt_debian, $1);

        } elsif ($arg =~ m/^(!)*RPM/i) {

            $newActiveSection = 1 if  $flip->($opt_rpm, $1);

        } elsif ($arg =~ m/^(!)*TAR/i) {

            $newActiveSection = 1 if $flip->($opt_tarFile, $1);

        } elsif (uc($arg) eq 'ALL') {

            $newActiveSection = 1;

        } elsif ( $arg eq 1  ) {

                $newActiveSection = 1;

        } elsif ( $arg eq 0  ) {

        } else {

            Warning ("Section: Unknown argument $arg");

        }

    }

    $ActiveSection = $newActiveSection ? 1: 0;

    Verbose ("Section State: $ActiveSection");

}

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

# Function        : UpdateDebianControlFile

#

# 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 UpdateDebianControlFile

{

    my($src) = @_;

    return 1 unless ($ActiveSection);

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

    unless ( $src )

    {

        CreateDebianControlFile();

        return;

    }

    #

    #   User has provided a control file

    #       Tweak the internals

    #

    Verbose ("UpdateDebianControlFile: $dst" );

    $src = ResolveFile( 0, $src );

    #   Calc depends line

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

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

    open (DF, '>', $dst) || Error ("UpdateDebianControlFile: 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        : CreateDebianControlFile

#

# Description     : Create a basic debian control file

#

# Inputs          : Uses global variables

#

# Returns         : 

#

sub CreateDebianControlFile

{

    return 1 unless ($ActiveSection);

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

    Verbose ("CreateDebianControlFile: $dst" );

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

    open (DF, '>', $dst) || Error ("CreateDebianControlFile: 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        : UpdateRedHatControlFile 

#

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

#                   within the file.

#

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

#                   (spec) file will be provided.

#                   Various tags will be replaced

#                       tag_name

#                       tag_version

#                       tag_buildarch

#                       tag_release

#                       tag_description

#                       tag_requires

#                       tag_filelist

#

# Inputs          : $src            - Path to source file

#                   Uses global variables

#

# Returns         : Nothing

#

sub UpdateRedHatControlFile

{

    my($src) = @_;

    return 1 unless ($ActiveSection);

    my $dst = $opt_specFile;

    unless ( $src )

    {

        CreateRedHatControlFile();

        return;

    }

    #

    #   User has provided a control file

    #       Tweak the internals

    #

    Verbose ("UpdateRedHatControlFile: $dst" );

    $src = ResolveFile( 0, $src );

    my @depList = @DependencyList;

    my $cleanSeen;

    open (my $sf, '<', $src) || Error ("UpdateRedHatControlFile: Cannot open:$src, $!");

    open (my $df, '>', $dst) || Error ("UpdateRedHatControlFile: Cannot create:$dst, $!");

    while ( <$sf> )

    {

        s~\s*$~~;

        if ( m~^tag_Name~i ) {

            $_ = "Name: $opt_name";

        } elsif ( m~^tag_Version~i ) {

            $_ = "Version: $opt_buildversion";

        } elsif ( m~^tag_BuildArch~i ) {

            $_ = "BuildArch: $opt_pkgarch";

        } elsif ( m~^tag_Release~i ) {

            $_ = "Release: $opt_rpmRelease";

        } elsif ( $opt_description && m~^tag_Description~i ) {

            print $df "%description\n";

            print $df "$opt_description\n";

            $_ = undef;

        } elsif ( m~^tag_Requires~i ) {

            foreach my $item (@depList) {

                print $df "Requires:       $item\n";

            }

            $_ = undef;

            @depList = ();

        } elsif ( m~^tag_filelist~i ) {

            GenerateRedHatFileList ($df);

            $_ = undef;

        } elsif ( m~^%clean~i ) {

            $cleanSeen  = 1;

        }

        print $df ($_ , "\n") if defined ($_);

    }

    close ($sf);

    close ($df);

    #

    #   Warn if Depends section is needed

    #

    Error ("No %clean section seen in user control file") unless $cleanSeen; 

    Error ("No Requires tag seen in user control file") if (@depList);

}

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

# Function        : CreateRedHatControlFile

#

# Description     : Create a binary RedHat spec file

#

# Inputs          : Uses global variables

#

# Returns         : 

#

sub CreateRedHatControlFile

{

    #

    #   Generate the RPM spec file

    #

    open (my $sf, '>', $opt_specFile) || Error ("RPM Spec File: Cannot create: $opt_specFile, $!");

    # Standard tags

    print $sf ("# Standard SPEC Tags\n");

    print $sf "Summary:        Installer for the $opt_name Package\n";

    print $sf "Name:           $opt_name\n";

    print $sf "Version:        $opt_buildversion\n";

    print $sf "Release:        $opt_rpmRelease\n";

    print $sf "License:        COPYRIGHT - VIX IP PTY LTD (\"VIX\"). ALL RIGHTS RESERVED.\n";

    print $sf "Source:         None\n";

    print $sf "BuildArch:      $opt_pkgarch\n";

    print $sf "Group:          VIX/System\n";

    print $sf "Vendor:         Vix Technology\n";

    print $sf "Autoreq:        No\n";

    #

    #   Requires tags

    #

    print $sf "\n# Dependencies\n" if @DependencyList;

    foreach my $item (@DependencyList) {

        print $sf "Requires:       $item\n";

    }

    print $sf "\n";

    print $sf "%description\n";

    print $sf "$opt_description\n";

    print $sf "\n";

    print $sf "%clean\n";

    #

    #   Insert various scripts

    #

    my $insertRpmControlFile = sub {

        my ($sname, $cname) = @_;

        if ( my $src = $ControlFiles{$cname} ) {

            print $sf "\n";

            print $sf '%' . $sname . "\n";

            open ( my $cf, '<', $src ) || Error ("BuildRPM: Cannot open:$src, $!");

            while ( <$cf> ) {

                $_ =~ s~\%~%%~g;

                print $sf $_;

            }

            close ($cf);

            print $sf "\n";

        }

    };

    #   Run the PreInstall script as %pretrans

    #       %pretrans is the only script that can terminate the RPM installation

    &$insertRpmControlFile ('pretrans', 'preinst');

    &$insertRpmControlFile ('post',     'postinst');

    &$insertRpmControlFile ('preun',    'prerm');

    &$insertRpmControlFile ('postun',   'postrm');

    #

    #   Insert the list of files to be processed

    #       Can't use /* as this will mess with permissions of the root directory. 

    #       Can list Top Level directories and then use *

    #

    print $sf "\n%files\n";

    print $sf "%defattr(",join (',', @RpmDefAttr),")\n";

    GenerateRedHatFileList ($sf);

    print $sf "\n";

    close ($sf);

}

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

# Function        : GenerateRedHatFileList 

#

# Description     : Internal function

#                   Generate a file list to be inserted into an RPM spec file

#

# Inputs          : $fd     - File descriptor.

#                             Function will write directly to the output

#

# Returns         : Nothing 

#

sub GenerateRedHatFileList

{

    my ($fd) = @_;

    #

    #   Sanity Test

    #

    Warning ("No directories has been marked as 'Owned'",

             "Under RedHat a directory must be 'owned' by a package so that it can be removed.",

             "This ownership may be in that package or a 'Required' package.",

             "This ownership may be shared or exclusive.",

             ) unless scalar keys %OwnedDirs;

    #

    #   Flag files and directories with attributes

    #

    my %Attrs;

    my %Dirs;

    foreach my $item ( @RpmAttrList ) {

        my $file =  $item->[0]; 

        my $full_path = $WorkDirInit . $file;

        $Attrs{$file} =  '%attr(' . join(',',@{$item}[1..3] ) . ')';

        $Dirs{$file} = '%dir' if (-d $full_path);

    }

    #

    #   Flag configuration files ( ConfFile )

    #

    my %Configs;

    foreach my $item (@ConfigList) {

        $Configs{$item} = '%config';

    }

    #

    #   Internal subroutine to pretty-print a file/dirname with attributes

    #       $path   - path element

    #       $isDir  - True if a directory

    #   

    my $printer = sub {

        my ($path, $isDir) = @_;

        my $attrText =  delete $Attrs{$path};

        my $confText =  delete $Configs{$path};

        my $dirText  =  delete $Dirs{$path};

        $dirText = '%dir' if $isDir;

        my $txt;

        my $joiner = '';

        $path = '"' . $path . '"';

        foreach ($attrText,$dirText,$confText, $path) {

            next unless $_;

            $txt .= $joiner . $_;

            $joiner = ' ';

        }

        print $fd ("$txt\n");

    };

    #

    #   List all files in the tree

    #       If we use wildcards we get interpackage dependency issues

    #       Process files and directories

    #

    my $search =  JatsLocateFiles->new( '--Recurse', '--NoFullPath', '--DirsToo' );

    my @flist = $search->search($WorkDirInit);

    foreach (@flist) {

        my $file = '/' . $_;

        my $full_path = $WorkDirInit . $file;

        my $isDir = (-d $full_path) || 0;

        #

        #   Determine if the element is within a known RootDir

        #

        my $inRoot = 0;

        my $isOwner = 0;

        foreach (keys %OwnedDirs) {

            if ($file =~ m~^$_~) {

                $inRoot = 1;

                $isOwner = $OwnedDirs {$_};

                last;

            }

        }

        #

        #   Ignore directories that are not within a RootDir

        #   

        unless ($inRoot) {

            next if $isDir;

        }

        #

        #   Ignore directories that are not within an 'owned' directory

        #

        if ( !$isOwner && $isDir ) {

            next;

        }

        &$printer($file, $isDir);

    }

    #

    #   Sanity tests

    #   We should have process all the Configs and Attributes

    #

    if ( (keys %Configs) || ( keys %Attrs))

    {

        Error ("Internal Error. Unprocessed Config or Attributes.",

               keys %Configs, keys %Attrs );

    }

}

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

# Function        : SetVerbose

#

# Description     : Set the level of verbosity

#                   Display activity

#

# Inputs          : Verbosity level

#                       0 - Use makefile verbosity (Default)

#                       1..2

#

# Returns         : 

#

sub SetVerbose

{

    return 1 unless ($ActiveSection);

    my ($level) = @_;

    $level = $opt_verbose unless ( $level );

    $opt_verbose = $level;

    ErrorConfig( 'verbose' => $level);