# 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;
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.