Subversion Repositories DevTools

########################################################################
# Copyright (C) 2008 ERG Limited, 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  alot 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 loggind
#               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 frunctions
#
# 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
#                       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
#                     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)
#                       SkipTLF         - Skip Files in the specified dir -
#                                         only consider subdirs
#                     Misc
#                       Stats           - A ref to a hash of stats
#                       FileList        - Ref to array of target files
#                       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'} );

    #
    #   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
                #
                next if ( $opt->{'NoSubDirs'} );

                #
                #   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 . '/';

                #
                #   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} )
    {
        foreach ( @{$opt->{$iname}})
        {
            return 0
                if ( $file =~ m~$_~ );
        }
    }
    return 1;
}


#-------------------------------------------------------------------------------
# Function        : DefaultOpts
#
# Description     : Insert default opts into the option structure
#
# Inputs          : $name               - Utility name
#                   @opts               - User options (hash ref or an array)
#
# Returns         : Ref to a new set of options
#                   With defauls inserted
#
sub DefaultOpts
{
    my $name = shift;
    my $uopt = ArgsToRef ($name, @_ );
    my $opt;

    #
    #   Init with global options
    #
    foreach ( keys %{$Global_opts} )
    {
        $opt->{$_} = $Global_opts->{$_};
    }

    #
    #   Transfer the users options into our own working hash
    #   Allows the user to create an option-set that won't get messed with
    #   Validity test of user args
    #
    ValidateArg ($name, $uopt, $opt);

    #
    #   Determine if the underlying system supports symlinks
    #   May be killed later if we discover that the filesystem
    #   does not support symlinks
    #
    if ( $opt->{'SymlinkFiles'} )
    {
        my $symlinks = eval { symlink("",""); 1 } || 0;
        $opt->{'SymlinkFiles'} = 0
            unless ( $symlinks  );
    }

    #
    #   Return a new options structure
    #   One that won't pollute the users set of options
    #
    return $opt;
}


#-------------------------------------------------------------------------------
# Function        : ArgsToRef
#
# Description     : Convert an argument list into a hash reference
#                   with error checking
#
# Inputs          : $name                   - User function name
#                   *                       - User arguments
#                                             May be a ref to a hash
#                                             Array of args
#
# Returns         : Ref to a hash
#
sub ArgsToRef
{
    my $name = shift;
    my $uopt;

    #
    #   User can pass in:
    #       Nothing at all
    #       A reference to a hash
    #       A hash as a list of argumnts
    #
    if ( $#_ < 0 ) {

    } elsif ( UNIVERSAL::isa($_[0],'HASH') ) {
         $uopt = $_[0];

    } else {
        #
        #   A list of arguments
        #   Treat it as a hash. Must have an even number of arguments
        #
        Error ("$name: Odd number of args to function")
            unless ((@_ % 2) == 0);
        $uopt = {@_};
    }

    return $uopt;
}

################################################################################
#   
#
#   Valid User Arguments
#   Hash value is used to determine if the CopyDir operation must perform
#   extensive matching operations.
#
use constant    Scalar   => 1;
use constant    Match    => 2;
use constant    CodeRef  => 4;
use constant    ArrayRef => 8;
use constant    HashRef  => 16;

my %ValidArgs = (
    'DeleteFirst'     => Scalar,
    'DuplicateLinks'  => Scalar,
    'NoSubDirs'       => Scalar | Match,
    'Flatten'         => Scalar,
    'Logger'          => CodeRef,
    'EmptyDirs'       => Scalar,
    'IgnoreDots'      => Scalar | Match,
    'Expert'          => CodeRef,
    'Examine'         => CodeRef,
    'Exists'          => CodeRef,
    'Log'             => Scalar,
    'Error'           => CodeRef,
    'Stats'           => HashRef,
    'Match'           => ArrayRef | Match,
    'MatchRE'         => ArrayRef | Match,
    'MatchDirs'       => ArrayRef | Match,
    'MatchDirsRE'     => ArrayRef | Match,
    'Ignore'          => ArrayRef | Match,
    'IgnoreRE'        => ArrayRef | Match,
    'IgnoreDirs'      => ArrayRef | Match,
    'IgnoreDirsRE'    => ArrayRef | Match,
    'NoOverwrite'     => Scalar,
    'UserData'        => 0,
    'SymlinkFiles'    => Scalar,
    'ReadOnlyFiles'   => Scalar,
    'KeepSrcTail'     => Scalar,
    'FileList'        => ArrayRef,
    'SkipTLF'         => Scalar,
);


#-------------------------------------------------------------------------------
# Function        : ValidateArg
#
# Description     : Validate a user option arguments
#                   Transfer validated options to a target hash
#
# Inputs          : $name                   - User function
#                   $uopt                   - Source option list to process
#                   $topt                   - Target option ref
#
# Returns         : Nothing
#
sub ValidateArg
{
    my ($name, $uopt, $topt ) = @_;

    foreach ( keys %{$uopt} )
    {
        #
        #   Option must exist
        #
        Error ("$name. Invalid option: $_")
            unless ( exists $ValidArgs{$_} );

        my $ref =  ref($uopt->{$_});
        my $mask = $ValidArgs{$_};

        if ( $mask & Scalar )
        {
            Error ("$name. Argument not expecting a ref: $_")
                if ( $ref );
        }

        if ( $mask & CodeRef )
        {
            Error ("$name. Argument requires a Code Reference: $_")
                if ( $ref ne 'CODE' );
        }

        if ( $mask & ArrayRef )
        {
            Error ("$name. Argument requires an Array Reference: $_")
                if ( $ref ne 'ARRAY' );
        }

        if ( $mask & HashRef )
        {
            Error ("$name. Argument requires an Hash Reference: $_")
                if ( $ref ne 'HASH' );
        }

        #
        #   If any of the Match options are active, then flag OptMatch
        #   This will be used to speed up searching and processing
        #
        $topt->{'OptMatch'} = 1
            if ( $mask & Match );

        #
        #   Insert the user argument
        #
        $topt->{$_} = $uopt->{$_}
    }
}

1;