Subversion Repositories DevTools

                    &installDpkgArchivePkgRaw

                    $PkgVersionUser

                    $PkgVersion

sub installDpkgArchivePkgRaw

#

# Description:

#       This sub-routine is used to install all pkg files from the named package

#       in dpkg_archive into the defined install area.

#

#       If it has any problems it will log an error and stop processing.

#

# Inputs          : targetTag       - Target directory      [Mandatory]

#                   package         - Source Package        [Mandatory]

#                   options         - Optional options

#                                       --NoRecurse

#                                       --Recurse           [default]

#                                       --Flatten

#                                       --NoFlatten         [default]

#                                       --FilterIn=xx

#                                       --FilterInRE=xx     [default=.*]

#                                       --FilterOut=xx

#                                       --FilterOutRE=xx

#                                       --Warn              [ default]

#                                       --NoWarn

#

# Notes:    --FilterIn=xxxx, --FilterOut=xxx

#           xxx is a simple Shell style filter where:

#               * means one or more charters        '*.EXE'

#               ? means a single character          '*.?'

#               [abc] means either a or b or c      'file.[ch]'

#

#           --FilterInRE=xxx, --FilterOutRE=xxx

#           xxx is a Regular Expression. There are harder to use but very

#           powerful. ie '.*\.EXE$'

#

#           The 'In' filters are applied before the 'Out' filters.

#

#           If no 'In' filters are specified then all files will be included.

#

#           The filter rules are applied to the path below the Srcdir, and, for

#           the purposes of the filter the path starts with a '/'.

#

#

#       --NoWarn

#           Supresses the warning message generated if no files are transferred

#

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

{

    my $recurse = 1;

    my @dir_tree_exclude;

    my @dir_tree_include;

    my $flatten = 0;

    my $dstDir;

    my @args;

    my $src_base_dir;

    my $warning = 1;

    #

    #   Process the arguments and extract parameters and options

    #

    foreach ( @_ )

    {

        if ( m/^--NoRecurse/ ) {

            $recurse = 0;

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

            $recurse = 1;

        } elsif ( /^--FilterOut=(.*)/ ) {

            push @dir_tree_exclude, glob2pat($1);

        } elsif ( /^--FilterOutRE=(.*)/ ) {

            push @dir_tree_exclude, $1;

        } elsif ( /^--FilterIn=(.*)/ ) {

            push @dir_tree_include, glob2pat($1);

        } elsif ( /^--FilterInRE=(.*)/ ) {

            push @dir_tree_include, $1;

        } elsif ( /^--Flatten/ ) {

            $flatten = 1;

        } elsif ( /^--NoFlatten/ ) {

            $flatten = 0;

        } elsif ( /^--NoWarn/ ) {

            $warning = 0;

        } elsif ( /^--Warn/ ) {

            $warning = 1;

        } elsif ( m/^--/ ) {

            Error("installDpkgArchivePkgRaw: Unknown option: $_")

        } else {

            push @args, $_;

        }

    }

    #

    #   Have removed all the options

    #   Must have two parameters left

    #

    if ( $#args != 1 )

    {

        Error("Incorrect number of params passed to installDpkgArchivePkgRaw() function.",

              "Check deploy config.");

    }

    my ( $dstDirTag, $pkgName ) = @args;

    #

    #   Ensure that the user has specified a target directory

    #   Convert the symbolic target directory to a real path

    #

    Error("installDpkgArchivePkgRaw: No target directories specified")

        unless ( $dstDirTag );

    $dstDir = getTargetDstDirValue($dstDirTag, "A");

    #

    #   Convert the package name into a real path name to the package as

    #   held in dpkg_archive. Do not use the copy in the 'interface' directory

    #

    for my $entry ( $BuildFileInfo->getBuildPkgRules() )

    {

        next unless ( $entry->{'DNAME'} eq $pkgName );

        $src_base_dir = $entry->{'ROOT'};

        Verbose ("Discovered package in: $src_base_dir");

    }

    Error ("installDpkgArchivePkgRaw: Package not located: $pkgName")

        unless ( $src_base_dir );

    Error ("installDpkgArchivePkgRaw: Package directory not found: $src_base_dir")

        unless ( -d $src_base_dir );

    #

    #   Build up a list of files to copy

    #   Creating a list allows:

    #       Simplified coding

    #       Flattening and testing of the flattening

    #

    my @elements = ExpandDirTree( $src_base_dir, \@dir_tree_exclude, \@dir_tree_include, $recurse );

    Information("Installing Raw Pkg files: $pkgName") if @elements;

    #

    #   Perform the file copy

    #   This copy will NOT create empty directories, but it will create needed

    #   directories on the fly.

    #

    foreach  my $sfile ( @elements )

    {

        #

        #   Split into directory and file as we may need to make the directory

        #   since the copy operation will not

        #

        my $dir;                                # Target directory

        my $tfile;                              # Target path

       (my $fname = $sfile )=~ s~^.*/+~~;       # Filename(only)

        unless ( $flatten )

        {

            $sfile =~ m~^(.*/)~;

            $dir = "$dstDir/$1";

            $tfile = $sfile;

        }

        else

        {

            $dir = $dstDir;

            $tfile = $fname;

        }

        #

        #   Ensure the target directory is present

        #

        make_directory ( $dir, 0775 );

        #

        #   Copy the file

        #   Ensure that the target file does not already exist

        #   This is most likely to occur when flattening the directory structure

        #

        my $m_sfile = "$src_base_dir$sfile";

        my $m_tfile = "$dstDir/$tfile";

        if ( -f $m_tfile  )

        {

            Error("Failed to copy file [$m_sfile] to [$m_tfile]: File already exists");

        }

        if( File::Copy::copy("$m_sfile", "$m_tfile") )

        {

            Verbose("Copied [$fname] to [$m_tfile] ...");

        }

        else

        {

            Error("Failed to copy file [$m_sfile] to [$m_tfile]: $!");

        }

    }

    #

    #   Return the number of files transferred

    #

    my $nfiles = $#elements + 1;

    Warning("Installing Raw Pkg files: $pkgName - No files transferred") if ( $warning && ! $nfiles ) ;

    return $nfiles;

}

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