# glob for dos scripts

# pass a reference to an array with the wildcards
# (usually you want \@ARGV)
#
# optionally pass a true value to remove empty matches
# 
# optionally pass a false value to turn off warnings on empty matches
# (must have empty match removal on)

# "glob" is really File::Glob::glob
#perl2exe_include File::Glob

package File::DosGlob::Param;

# for some reason, use Exporter must be used before use strict.
use Exporter;
our @ISA=(Exporter);
our @EXPORT_OK = qw( dosglob );

use strict;
use warnings;

our $VERSION = '1.3';

####################################
# Revision History
#
# 1.3 Escaped blanks in glob specs to avoid accidentally globbing
#         on pieces instead of the whole
#     (This is a fault in glob's metacharacter docs - spaces are 
#      glob separators)
# 1.2 Returns error value, indicating unmatched wildcards, when
#         called with "Warn_On_Empty_Matches"
#####################################
# Synopsis:
#
# Modified from dosglob.pm, adding functionality of
# passing array reference, removing wildcards that don't match,
# and warning on empty matches.
#####################################


sub dosglob
{
  my $error = 0;
  
  # define param names
  my @param_names = qw( Array_Ref Remove_Empty_Matches Warn_On_Empty_M
+atches );
  my %param_names;
  @param_names{@param_names} = @param_names;
  
  # set default param values
  my %options;
  @options{@param_names} = ( undef, 0, 1 );
  
  # update with actual parameters
  my %params = @_;
  foreach my $param_name ( keys %params )
  {
    if ( exists( $param_names{$param_name} ) ) # valid parameter
    {
      $options{$param_name} = $params{$param_name}
    }
    else
    {
      die "Bad parameter $param_name passed in " . __PACKAGE__ . ", ";
    }
  }
  
  my $arg_ref = $options{Array_Ref};
  
  die "Needs reference to array (usually \@ARGV), " 
    unless ( ref( $arg_ref ) eq ref( ["ARRAY"] ) );
  
  my $glob_count = @{$arg_ref}; # keep track of glob elements
  
  foreach ( 1..$glob_count )
  {
    my $glob = shift @{$arg_ref}; # pull wildcards off the front
    # escape whitespace in globs, unless already escaped
    $glob =~ s/(?<!\\)(\s)/\\$1/g;
    my @glob = glob( $glob );
    
    # check for empty matches, use original if allowed
    if ( not( @glob ) and not( $options{Remove_Empty_Matches} ) )
    {
      @glob = ( $glob ); # use original if no matches
    }
    
    # check if there's anything to add
    if ( @glob )
    {
      push @{$arg_ref}, @glob; # push results on the back
    }
    elsif ( $options{Warn_On_Empty_Matches} )
    {
      warn "*** Warning: No " . __PACKAGE__ . "::dosglob matches for <
+$glob>\n";
      $error = 1;
    }
  }
  
  return $error;
}

1;