Subversion Repositories DevTools

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

# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.

#

# Module name   : JatsCopy

# Module type   : Makefile system

# Compiler(s)   : Perl

# Environment(s): jats

#

#                 Utility functions to

#                   CopyDir                 - Copy Dir Tree

#                   CopyFile                - Copy one or more files

#                   CreateDir               - Create one directory

#                   DeleteDir               - Delete Dir Tree

#                   DeleteFile              - Delete a file

#                   SetCopyDirDefaults      - Set application wide defaults

#

#                 Performs these operations within a common logging

#                 and error reporting framework

#

#                 Intended to replace all similar lumps of code

#                 within JATS

#

#                 Intended to make life simple

#

#                 It has a lot of callbacks and config, but the body

#                 of the work is similar

#

# Examples:

#               CopyDir ( 'aaa', 'bbb' );

#               Simply copy the aaa dir-tree to 'bbb'

#

#               CopyDir ( 'aaa', 'bbb',

#                           { 'DeleteFirst' => 1,

#                             'Error' => \&MyError,

#                             'Logger' => \&MyLog,

#                             'Examine' => \&MyExamine,

#                             'Expert' => \&MyExpert,

#                             'Exists' => \&MyExists,

#                             'Ignore' => ['a2', 'build.pl'],

#                             'IgnoreRE' => ['2$'],

#                             'IgnoreDirs' => ['.svn'],

#                             });

#

#              Complex copy of the 'aaa' tree to 'bbb'

#               Do my own error processing

#               Do my own logging

#               Examine each file/dir being processed

#               Do my own copy ( Expert)

#               Notify me if an existing file is present

#               Do not copy files called a2 and build.pl

#               Do not copy the .svn subdir

#               Do not copy files ending in 2

#

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

use strict;

use warnings;

package JatsCopy;

use JatsError;

use FileUtils;

use File::Path;

# automatically export what we need into namespace of caller.

use Exporter();

our (@ISA, @EXPORT);

@ISA         = qw(Exporter);

@EXPORT      = qw(

                    CopyDir

                    CopyFile

                    CreateDir

                    DeleteDir

                    DeleteFile

                    SetCopyDirDefaults

                );

#

#   Global Data

#

my $Global_opts;

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

# Function        : CopyDir

#

# Description     : Utility function to copy a directory of files

#                   This function is NOT reentrant

#                   Do not use it within callback functions

#

# Inputs          : $src_dir                - Src directory

#                   $dst_dir                - Dest dir

#                   $opt                    - An Array or Hash Ref of options

#                    Flags that affect operation

#                       DeleteFirst     - True: Delete target directory first

#                       NoSubDirs       - True: Only source directory files

#                       NoRecurse       - True: Only scan the root directory. 

#                                               User can 'Examine' dirs

#                       SkipTLF         - True: Skip Files in the specified dir -

#                                               Only consider subdirs

#                       Flatten         - True: Flatten output dir

#                       Log             - True: Log activity

#                       EmptyDirs       - True: Create empty dirs

#                       IgnoreDots      - True: Ignore files and dirs starting with .

#                       NoOverwrite     - True: Do not replace file in target

#                       DuplicateLinks  - True: Duplicate, don't copy links

#                       SymlinkFiles    - True: Create symlinks if possible

#                       ReadOnlyFiles   - True: Make files Read Only

#                       KeepSrcTail     - True: Keeps the tail of the source dir

#                                               Prepends the last directory of the src_dir

#                                               to the $dst_dir

#                     User callback functions

#                       Expert          - Function to do the work

#                       Examine         - Function to examine each entry

#                                         If True, then proceed

#                       Exists          - Function called if target file exists

#                                         If True, then delete and replace

#                       Logger          - Function to Log operations

#                       Error           - Function to Process errors

#                     Mataching operations

#                       Ignore          - An array of files to ignore

#                       IgnoreRE        - An array of files to ignore (RE)

#                       IgnoreDirs      - An array of subdirs to ignore

#                       IgnoreDirsRE    - An array of subdirs to ignore (RE)

#                       Match           - An array of files to match

#                       MatchRE         - An array of file to match (RE)

#                       MatchDirs       - An array of top level dirs to match

#                       MatchDirsRE     - An array of top level dirs to match (RE)

#                     Misc

#                       Stats           - A ref to a hash of stats

#                       FileList        - Ref to array of target files

#                       NoSubDirList    - Ref to array of TLD subdirs skipped

#                                         Implies NoSubDirs

#                       UserData        - Item passed through to call backs

#                                         for the users own purposes.

#

#                   File and dir match/ignore operations come in two flavours

#                   Simple : Use of simple wildcards: ?,* and [...] constructs

#                   RE     : Full regular expression

#

#                   Dir match/ignore work on a single dirname, not dirs and subdirs.

#

#                   Matches rules are applied before ignore rules.

#

#                   User functions are called a ref to a copy of the options hash

#                   with the folling data added.

#                       item            - Source Path

#                       file            - Filename

#                       target          - Dest Path

#                   In the 'Examine' callback, 'target' may be modified

#                   This will be used as the path to target file.

#

# Returns         :

#

sub CopyDir

{

    my $src_dir = shift;

    my $dst_dir = shift;

    #

    #   Setup default options

    #   Merge user options with default options to create a local set

    #

    my $opt = JatsCopyInternal::DefaultOpts( 'CopyDir', @_);

    #

    #   Remove any training / from the users dirs

    #

    $src_dir =~ s~/+$~~;

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

    #

    #   Keep some fo the source directory

    #

    $dst_dir .= '/' . StripDir($src_dir)

        if ( $opt->{'KeepSrcTail'} );

    #

    #   NoSubDirList implies NoSubDirs 

    #

    $opt->{'NoSubDirs'} = 1

        if (defined $opt->{'NoSubDirList'});

    #

    #   Insert some default options

    #

    $opt->{'SrcDir'} = $src_dir;

    $opt->{'DstDir'} = $dst_dir;

    #

    #   Convert Match requests into MatchRE requests

    #

    if ($opt->{'OptMatch'} )

    {

        JatsCopyInternal::Pat2GlobList ($opt ,'Match'     , 'MatchRE' );

        JatsCopyInternal::Pat2GlobList ($opt ,'MatchDirs' , 'MatchDirsRE' );

        JatsCopyInternal::Pat2GlobList ($opt ,'Ignore'    , 'IgnoreRE' );

        JatsCopyInternal::Pat2GlobList ($opt ,'IgnoreDirs', 'IgnoreDirsRE' );

    }

    #

    #   Validate source dir

    #

    Error ("CopyDir: Source dir not found: $src_dir" )

        if ( ! -d $src_dir );

    #

    #   Delete and create target dir

    #

    rmtree( $dst_dir )

        if ( $opt->{'DeleteFirst'} );

    JatsCopyInternal::CreateDir ( $dst_dir, $opt );

    #

    #   Invoke Find to decend the directory tree

    #

    #   Have used global vars to pass data into the find callback

    #

    #   Only use the preprocess rotine if we are doing any form

    #   of matching.

    #

    #   'follow_fast' does not work correctly under windows if the path

    #   has a drive letter. Don't use it under Windows

    #

    JatsCopyInternal::MyFind( $opt );

#    DebugDumpData("opt", $opt );

}

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

# Function        : CopyFile

#

# Description     : Utility function to copy a single file

#                   Uses many of the same options and loging infrastructure

#                   as CopyDir. Does not use 'Expert' or 'Examine'

#

# Inputs          : $src_file               - Src file spec

#                                             May be a file or a reference to an

#                                             array of files.

#                   $dst_file               - Dest file (or dir)

#                   $opt                    - A Hash of options

#                                             Refer to CopyDir

#

# Returns         : Path to the target file

#                   If multiple files are being copied then it is the

#                   path to the last one copied.

#

sub CopyFile

{

    my $src_spec = shift;

    my $dst_spec = shift;

    my $opt = JatsCopyInternal::DefaultOpts( 'CopyFile', @_);

    #

    #   Do not Validate source dir

    #   Do it within the copy operation and get the same error

    #   handling as the CopyDir processing

    #

    #

    #   Handle a scalar and and array in the same manner

    #

    if ( ref $src_spec ne 'ARRAY' ) {

        my @slist = ($src_spec );

        $src_spec = \@slist;

    }

    my $rv = undef;

    foreach my $src_file ( @{$src_spec} )

    {

        next unless ( $src_file );

        #

        #   If the target is a directory, then copy by name

        #

        my $file = StripDir ($src_file);

        my $dst_file = $dst_spec;

        $dst_file .= '/' . $file if ( -d $dst_file );

        #

        #   Insert additional options to provide the same interface to

        #   the internal functions used to do the copy

        #

        #       item            - Source Path

        #       tgt             - Dest subdir below dst_dir

        #       file            - Filename

        #       target          - Dest Path

        #

        $opt->{'item'}     = $src_file;

        $opt->{'file'}     = $file;

        $opt->{'target'}   = $dst_file;

        $opt->{'type'}     = 'f';

        #

        #   Invoke the common file copy routine

        #

        $rv = JatsCopyInternal::CopyFile ( $src_file, $dst_file, $opt );

    }

    return $rv;

}

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

# Function        : CreateDir

#

# Description     : Utility function to create a directory

#                   Uses the same options and loging infrastructure

#                   as CopyDir

#

# Inputs          : $dst                    - Dest dir to create

#                   $opt                    - A Hash of options

#                                             Refer to CopyDir

#

# Returns         : 

#

sub CreateDir

{

    my $dst = shift;

    my $opt = JatsCopyInternal::DefaultOpts( 'CreateDir', @_ );

    #

    #   Insert additional options to provide the same interface to

    #   the internal functions used to do the copy

    #

    #       item            - Source Path

    #       tgt             - Dest subdir below dst_dir

    #       file            - Filename

    #       target          - Dest Path

    #

    $opt->{'item'}     = '';

    $opt->{'file'}     = '';

    $opt->{'target'}   = $dst;

    $opt->{'type'}     = 'd';

    #

    #   Delete and create target dir

    #

    if ( $opt->{'DeleteFirst'} && -e $dst )

    {

        $opt->{'Logger'} ( "Delete Dir" ,$opt );

        rmtree( $dst );

    }

    #

    #   Invoke the common file copy routine

    #

    JatsCopyInternal::CreateDir ( $dst, $opt );

#    DebugDumpData("opt", $opt );

}

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

# Function        : DeleteDir

#

# Description     : Utility function to delete a directory tree

#                   Uses the same options and loging infrastructure

#                   as CopyDir

#

# Inputs          : $dst                    - Dest dir to create

#                   $opt                    - A Hash of options

#                                             Refer to CopyDir

#

# Returns         : 

#

sub DeleteDir

{

    my $dst = shift;

    my $opt = JatsCopyInternal::DefaultOpts( 'DeleteDir', @_ );

    #

    #   Insert additional options to provide the same interface to

    #   the internal functions used to do the copy

    #

    #       item            - Source Path

    #       tgt             - Dest subdir below dst_dir

    #       file            - Filename

    #       target          - Dest Path

    #

    $opt->{'item'}     = '';

    $opt->{'file'}     = '';

    $opt->{'target'}   = $dst;

    $opt->{'type'}     = 'd';

    #

    #   Invoke the common file copy routine

    #

    $opt->{'Logger'} ( "Delete Dir" ,$opt );

    rmtree( $dst );

}

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

# Function        : DeleteFile

#

# Description     : Utility function to delete a file

#                   Uses the same options and loging infrastructure

#                   as CopyDir

#

#                   Uses the same functions as DeleteDir simply because

#                   rmtree does such a great job

#

# Inputs          : $dst                    - Dest dir to create

#                   $opt                    - A Hash of options

#                                             Refer to CopyDir

#

# Returns         : 

#

sub DeleteFile

{

    my $dst = shift;

    my $opt = JatsCopyInternal::DefaultOpts( 'DeleteFile', @_);

    #

    #   Insert additional options to provide the same interface to

    #   the internal functions used to do the copy

    #

    #       item            - Source Path

    #       tgt             - Dest subdir below dst_dir

    #       file            - Filename

    #       target          - Dest Path

    #

    $opt->{'item'}     = '';

    $opt->{'file'}     = '';

    $opt->{'target'}   = $dst;

    $opt->{'type'}     = 'f';

    #

    #   Invoke the common file copy routine

    #

    $opt->{'Logger'} ( "Delete File" ,$opt );

    rmtree( $dst );

}

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

# Function        : SetCopyDirDefaults

#

# Description     : Set default options to be used by all the functions

#                   Simplifies the process fo setting options on all

#                   operations

#

# Inputs          : $uopt                        - A Hash of options

#                                                - An array of options

#

# Returns         : Nothing

#

sub SetCopyDirDefaults

{

    my $name = 'SetCopyDirDefaults';

    return if ( $#_ < 0);

    #

    #   User can pass in a reference to a hash or a hash as

    #   a list of argumnts

    #

    my $uopt = JatsCopyInternal::ArgsToRef ($name, @_ );

    #

    #   Insert user options into the default hash

    #

    JatsCopyInternal::ValidateArg ($name, $uopt, $Global_opts );

    #

    #   BEGIN Block to initialise default global options

    #   Note: This will be called first

    #   Note: Multiple begin blocks are allowed

    #

    sub BEGIN

    {

        my %stats;

        #

        #   Insert some default options

        #   Later insert user options

        #

        $Global_opts->{'Error'}  = \&JatsCopyInternal::Error;

        $Global_opts->{'Expert'} = \&JatsCopyInternal::Body;

        $Global_opts->{'Logger'} = \&JatsCopyInternal::Log;

        $Global_opts->{'Stats'}  = \%stats;

    }

}

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

#

#   Hide the body of the work within another package

#   Done to make it obvious which parts are user accessible

#

package JatsCopyInternal;

#use JatsError;

use File::Basename;

use File::Path;

use File::Copy;

use Cwd 'abs_path';

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

# Function        : MyFind

#

# Description     : Recurse a directory tree and locate files of interest

#

#                   Tried to use File::Find, but this has several major

#                   limitations:

#                       'preprocess' does not work with 'follow' symlinks

#                       Without 'preprocess' there is no way to terminate

#                       a directory sub-tree recursion leading to complicated

#                       code to do directory pruning.

#

#                   This function will perform file and directory name matching

#                   on the fly. All items with match are passed to the user

#                   examination functions and eventually to the processing

#                   function to perform the actual copy

#

#                   Current implementation will:

#                       Follow dir Symlinks

#

#                       Process dir element anytime before the dir contents

#                       Not 'just' before.

#

#

# Inputs          : $opt                        - Hash of search options

#

# Returns         : Nothing

#

sub MyFind

{

    my ( $opt ) = @_;

    local ( *DIR );

    #

    #   Create a list of subdirs to scan

    #       Elements do not contain the SrcDir

    #       Elements have a '/' suffix - simplify joining

    #

    my @dirs = '';

    #

    #   Process all directories in the list

    #   Pop them off so we do a depth first search

    #

    while ( @dirs )

    {

        my $root = pop( @dirs );

        my $dir = $opt->{'SrcDir'} . '/' . $root;

        unless (opendir DIR, $dir )

        {

            ::Warning ("File Find. Can't opendir($dir): $!\n");

            next;

        }

        my @filenames = readdir DIR;

        closedir(DIR);

        foreach my $file ( @filenames )

        {

            #

            #   Ignore filesystem house keeping directories

            #

            next if ( $file eq '.' || $file eq '..' );

            #

            #   Common processing

            #       Ignore all files and directories that start with a .

            #       Unix 'hidden' files may be simply ignored

            #

            next if ( $opt->{'IgnoreDots'} && substr( $file, 0, 1) eq '.' );

            #

            #   Determine the type of element

            #       1)Link

            #           - Link to a File

            #           - Link to a directory

            #       2)File

            #       3)Directory

            #

            my $filename = $dir . $file;

            my $relname = $root . $file;

            #

            #   Stat the file

            #   Use speed trick. (-f _) will use into from last stat/lstat

            #

            stat ( $filename );

            if ( -f _ )

            {

                $opt->{'Stats'}{'examinedFiles'}++;

                next if ( $opt->{'SkipTLF'} );

                next unless doMatch ( $file, $opt, 'MatchRE', 'IgnoreRE' );

                $opt->{'type'} = 'f';

            }

            elsif ( -d _ )

            {

                #

                #   Only process the top-level directory

                #

                if ( $opt->{'NoSubDirs'} )

                {

                    if (defined $opt->{'NoSubDirList'})

                    {

                        push @{$opt->{'NoSubDirList'}}, $file;

                    }

                    next;

                }

                #

                #   Match against wanted items

                #

                $opt->{'Stats'}{'examinedDirs'}++;

                next unless doMatch ( $file, $opt, 'MatchDirsRE', 'IgnoreDirsRE' );

                #

                #   Add to the list of future dirs to process

                #   Place on end to ensure depth first

                #   Algorithm requires dirname has a trailing /

                #

                push (@dirs, $relname . '/') unless ( $opt->{'NoRecurse'} ) ;

                #

                #   Create flat output dir - no more processing

                #

                next if ( $opt->{'Flatten'} );

                $opt->{'type'} = 'd';

            }

            else

            {

                ::Warning ("Find File: Unknown type skipped: $filename");

                next;

            }

            #

            #   Have a valid element to process

            #   Setup parameters for later users

            #

            my $target = ( $opt->{'Flatten'} ) ? $file : $relname;

            $opt->{'file'}   = $file;                           # Element name

            $opt->{'item'}   = $filename;                       # Full path

            $opt->{'target'} = $opt->{'DstDir'} . '/' .$target; # Target(Below dest)

            #

            #   If the user has opted to examine each file then ...

            #   If user returns TRUE then continue with operation

            #

            #   Note: It is allowed to play with the copy args

            #         but be careful. Only 'target' should be messed with

            #

            if ( $opt->{'Examine'} )

            {

                next unless ( $opt->{'Examine'} ( $opt ) )

            }

            #

            #   Always invoke the 'Expert' function

            #   A dummy one will be provided unless the user gave one

            #

            $opt->{'Expert'} ( $opt );

        }

        #

        #   Have processed the entire directory

        #   Kill the 'MatchDirsRE' data so that the Directory match

        #   only occurs on the Root directory

        #

        delete $opt->{'MatchDirsRE'};

        delete $opt->{'SkipTLF'};

    }

}

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

# Function        : Body

#

# Description     : Default CopyDir copy operation function

#                   This function will be used if the user does not provide

#                   one of their own

#

# Inputs          : $opt            - Ref to hash of options and args

#

# Returns         :

#

sub Body

{

    my ($opt) = @_;

    my $item = $opt->{'item'};

    my $target = $opt->{'target'};

    #

    #   If a directory, create the directory

    #

    if ( $opt->{'type'} eq 'd' )

    {

        $opt->{'Stats'}{'dirs'}++;

        #

        #   Directories are handled differently

        #       - Directories are created with nice permissions

        #       - Empty directories are created here

        #

        if ( $opt->{'EmptyDirs'} )

        {

            CreateDir ($target, $opt);

        }

    }

    else

    {

        CopyFile ( $item, $target, $opt );

    }

}

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

# Function        : CreateDir

#

# Description     : Create a directory

#                   With loging

#

# Inputs          : $dir                        - Dir to Create

#                   $opt                        - Process Data

#

# Returns         : 

#

sub CreateDir

{

    my ($dir, $opt) = @_;

    if ( ! -d $dir )

    {

        $opt->{'Logger'} ( "Creating Dir", $opt, $dir );

        mkpath($dir, 0, 0775);

        $opt->{'Error'} ( "Failed to create dir [$dir]: $!", $! , $opt )

            unless( -d $dir );

    }

}

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

# Function        : CopyFile

#

# Description     : Copy a file with common logging and other basic options

#

# Inputs          : $item                      - Source Path

#                   $target                    - Dest Path (dir+name)

#                   $opt                       - Ref to options hash

#

#

#                   Only a few of the options are implemented

#                   Becareful if using this function directly

#

# Returns         : The path of the target file

#

sub CopyFile

{

    my ($item, $target, $opt) = @_;

    #

    #   If the target already exists then we may need to take some

    #   action. The default action is to delete and replace

    #

    if ( -e $target )

    {

        if ( $opt->{'Exists'} )

        {

            return $target unless

                $opt->{'Exists'} ( $opt );

        }

        elsif ( $opt->{'NoOverwrite'} )

        {

            return $target;

        }

        rmtree( $target );

    }

    #

    #   Ensure that the target directory exists

    #   Don't assume prior creation - the user may have messed with the path

    #

    my $tdir = $target;

    $tdir =~ s~/[^/]+$~~;

    CreateDir ( $tdir, $opt);

    #

    #   If the target is a 'broken' link then we will have got this

    #   far. It wan't have been reported as existing

    #

    unlink $target

        if ( -l $target );

    #

    #   Save name of target file

    #

    if ( defined $opt->{'FileList'} )

    {

        push @{$opt->{'FileList'}}, $target;

    }

    {

        #

        #   Try a symlink first

        #

        if ( $opt->{'SymlinkFiles'}  )

        {

            $opt->{'Logger'} ( "Linking File" ,$opt );

            if (symlink (abs_path( $item ), $target)  )

            {

                $opt->{'Stats'}{'links'}++;

                last;

            }

            #

            #   Symlink has failed

            #   Flag: Don't attempt to symlink anymore

            #

            $opt->{'SymlinkFiles'}  = 0;

        }

        #

        #   Copy file to destination

        #   If the file is a link, then duplicate the link contents

        #   Use: Unix libraries are created as two files:

        #        lib.xxxx.so -> libxxxx.so.vv.vv.vv

        #

        if ( -l $item && $opt->{'DuplicateLinks'} )

        {

            $opt->{'Logger'} ( "Copying Link" ,$opt );

            my $link = readlink $item;

            symlink ($link, $target );

            unless ( $link && -l $target )

            {

                $opt->{'Error'} ( "Failed to copy link [$item] to [$target]: $!", $! , $opt );

            }

            $opt->{'Stats'}{'links'}++;

            last;

        }

        if (File::Copy::copy($item, $target))

        {

            $opt->{'Logger'} ( "Copying File" ,$opt );

            my $perm = 0775;

            $perm = (stat $target)[2] & 07777 & 0555

                if ( $opt->{'ReadOnlyFiles'} );

            CORE::chmod $perm, $target;

            $opt->{'Stats'}{'files'}++;

            last;

        }

        #

        #   All attempts to copy have failed

        #

        $opt->{'Error'} ( "Failed to copy file [$item] to [$target]: $!", $! ,$opt );

    }

    return $target;

}

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

# Function        : Log

#

# Description     : Default Copy Log callback function

#

# Inputs          : $type

#                   $opt hash

#                   $ltarget                        - Target to log

#

# Returns         : 

#

sub Log

{

    my ($type, $opt, $ltarget) = @_;

    return unless ( $opt->{'Log'} );

    #

    #   User target or logging target as overide

    #

    $ltarget = $opt->{'target'} unless ( $ltarget );

    if ( $opt->{'Log'} < 2 )

    {

        JatsError::Information (sprintf( "%-15s [%s]", $type, $ltarget));

    }

    else

    {

        JatsError::Information (sprintf( "%-15s  [%s]->[%s], %s, %s", $type,

                                    $opt->{'item'},

                                    $ltarget,

                                    $opt->{'file'},

                                    $opt->{'type'},

                                    ));

    }

}

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

# Function        : Error

#

# Description     : Default Copy Error callback function

#

# Inputs          : $message

#                   $ecode

#                   $opt hash

#

# Returns         : Does not return

#

sub Error

{

    my ($message, $ecode, $opt) = @_;

    JatsError::Error ($message);

}

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

# Function        : Pat2GlobList

#

# Description     : Convert a list of simple filenames into list of

#                   RE. Simple filenames may contain simple globs

#

# Inputs          : $opt                - Option hash

#                   $src                - Name of Source Data

#                   $dst                - Name of Dest Data

#

# Returns         : Updates dst data

#

sub Pat2GlobList

{

    my ($opt, $src, $dst) = @_;

    foreach ( @{$opt->{$src}} )

    {

        push @{$opt->{$dst}}, glob2pat($_);

    }

}

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

# Function        : glob2pat

#

# Description     : Convert four shell wildcard characters into their equivalent

#                   regular expression; all other characters are quoted to

#                   render them literals.

#

# Inputs          : Shell style wildcard pattern

#

# Returns         : Perl RE

#

sub glob2pat

{

    my $globstr = shift;

    $globstr =~ s~^/~~;

    my %patmap = (

        '*' => '.*',

        '?' => '.',

        '[' => '[',

        ']' => ']',

        '-' => '-'

    );

    $globstr =~ s{(.)} { $patmap{$1} || "\Q$1" }ge;

    return '^' . $globstr . '$';

}

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

# Function        : doMatch

#

# Description     : Match a file against a match specification

#                   Match, before ignore

#

# Inputs          : $file                   - File to match

#                   $opt                    - Options hash

#                   $mname                  - RE to match

#                   $iname                  - RE's to ignore

#

# Returns         : true    - File can matched

#

sub doMatch

{

    my ($file, $opt, $mname, $iname) = @_;

    if ( $opt->{$mname} )

    {

        if ( my @mlist = @{$opt->{$mname}} )

        {

            #

            #   Must match if we have a match list,

            #   then process ignore list

            #

            my $match = 0;

            foreach (@mlist)

            {

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

                {

                    $match = 1;

                    last;

                }

            }

            return 0

                unless ( $match );

        }

    }

    if ( $opt->{$iname} )