note
QM
I hesitated quite a while before sharing this, but it seems that it can only be improved. (And I did write it some time ago.)
<p>
I hacked up [mod://File::DosGlob] to suit me a while back. I vaguely recall some problem with globs that didn't match anything, and whether they were silently dropped, or passed through as a glob. Either or both of these may cause needless errors or incomplete data, so I added options and checking for the caller to control this behavior, and was rather paranoid about accepting options that weren't recognized.
<p>
I should go back and clean this up nice with POD, etc., but I'm lazy.
<readmore>
<code>
# 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/(?<!\\)(\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;
</code>
</readmore>
<p>
I also had unsophisticated users running my scripts, and sometimes running them on *nix. They would not need this module, and wouldn't have installed it, but of course it couldn't just be [doc://use]d, so I used this code instead:
<code>
# 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 );
}
}
</code>
<p>
Now, this didn't avoid the issue of the user not having it installed on Windows, but at least it didn't blow up unnecessarily in *nix.
<p>
And finally, an example invocation:
<code>
# 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";
}
}
}
</code>
<div class="pmsig"><div class="pmsig-294463">
<p>-QM<br />
--<br />
Quantum Mechanics: The dreams stuff is made of
</div></div>
781801
781801