# 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_Matches );
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/(?\n";
$error = 1;
}
}
return $error;
}
1;
####
# This BEGIN block avoids including File::DosGlob::Param for non-windows systems
BEGIN
{
if ( $^O =~ /win/i )
{
require File::DosGlob::Param;
import File::DosGlob::Param qw( dosglob );
}
}
##
##
# convert filename wildcards to actual filenames
if ( $^O =~ /win/i ) # only if DOS
{
if ( exists( $INC{'File/DosGlob/Param.pm'} ) ) # only if loaded
{
dosglob( "Array_Ref" => \@ARGV,
"Remove_Empty_Matches" => 1,
"Warn_On_Empty_Matches" => 1 );
}
END
{
if ( ( $^O =~ /win/i )
and not exists( $INC{'File/DosGlob/Param.pm'} ) )
{
warn "Consider installing module File::DosGlob::Param...\n";
}
}
}