package Wild;
require 5.005_62;
use strict;
use warnings;
use File::DosGlob 'glob';
require Exporter;
our @ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not expo
+rt
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
# This allows declaration use Wild ':all';
# If you do not need this, moving things directly into @EXPORT or @EXP
+ORT_OK
# will save memory.
our %EXPORT_TAGS = (
'all' => [
qw(
)
]
);
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(&WildARGV
);
our $VERSION = '0.01';
# Preloaded methods go here.
sub WildARGV {
my $arg;
my @newARGV;
my @glob_args;
my @xARGV;
my $recurse;
my $command;
my $exclude;
while (@ARGV) {
$arg = pop (@ARGV);
$recurse = ( $arg =~ /\!/ ) ? 1 : 0;
$exclude = ( $arg =~ /\~/ ) ? 1 : 0;
$command = ( $arg =~ /\@/ ) ? 1 : 0;
$arg =~ s/[\~\@\!]//g;
if ($command) {
WildFILE( $arg, $exclude );
}
elsif ($exclude) {
push ( @xARGV, WildGLOB($arg) );
}
elsif ($recurse) {
if ($exclude) {
push ( @xARGV, WildDIRFILES($arg) );
}
else {
push ( @newARGV, WildDIRFILES($arg) );
}
}
else {
push ( @newARGV, WildGLOB($arg) );
}
}
push ( @ARGV, @newARGV );
foreach (@ARGV) {
s|\/|\\|g;
}
if ($exclude) {
foreach (@xARGV) {
s|\/|\\|g;
}
ExcludeARGV(@xARGV);
}
}
sub WildGLOB {
my $arg = shift;
my $spec = shift;
$arg =~ s|\\|/|g;
if ( $arg =~ / / ) {
$arg = '"' . $arg . '"';
$arg =~ s/ /\\ /g;
}
my @glob_args = glob($arg);
return @glob_args ? @glob_args : $arg;
}
sub WildFILE {
my $filename = shift;
my $exclude = shift;
my @filenames;
open( FILE, $filename );
while (<FILE>) {
@filenames = split;
if ($exclude) {
@filenames = map( $_ =~ /\~/ ? $_ : '~' . $_, @filenames )
+;
}
push ( @ARGV, @filenames );
}
close(FILE);
}
sub ExcludeARGV {
my @b = @_;
my %seen;
my @aonly;
@seen{@b} = ();
foreach my $item (@ARGV) {
push ( @aonly, $item ) unless exists $seen{$item};
}
@ARGV = @aonly;
}
sub WildDIRFILES {
my $spec = shift;
my $path;
my @dirlist;
my @filelist;
my $dir;
$spec =~ s/\\/\//g;
if ( $spec =~ /(.*[\\\/])(.*)/ ) {
$path = $1;
$spec = $2;
}
else {
$path = './';
}
@dirlist = rdirlist($path);
while (@dirlist) {
$dir = pop (@dirlist);
push ( @filelist, glob( $dir . '/' . $spec ) );
}
return @filelist;
}
sub rdirlist {
my @list = shift;
my $dir;
my @rlist;
while (@list) {
push ( @rlist, $dir = pop (@list) );
push ( @list, dirlist($dir) );
}
return @rlist;
}
sub dirlist {
my $spec = shift;
if ( !( $spec =~ /[\/\\]*\.\*$/ ) ) {
$spec .= '/*.*';
}
my @list = grep( -d $_, glob($spec) );
return @list;
}
1;
__END__
=head1 NAME
Wild - Perl extension for improved program interface. Wild-card expans
+ion for @ARGV.
=head1 SYNOPSIS
use Wild;
=head1 DESCRIPTION
Will handle DOS-style wild-card expansion of '*' and '?'. Additionally
it introduces '@', '!', and '~' as filename prefixes with the followin
+g
effects:
'@' -- treat each line of the file as though it were a command line
+.
'!' -- directory recursion operator.
'~' -- exclusion operator.
'~' creates an exclusionary list, a sort of negative @ARGV. As a last
+step
in WildARGV(), the union of the two is removed from @ARGV. '!' forces
+lookups
to be recursive. The allowed combinations of operators are:
!~@ | ~!@ -- Recursion on, Exclusion on, applied to a command line
+list file.
!~* | ~!* -- Recursion on, Exclusion on, applied to a file specific
+ation.
!@ -- Recursion on, applied to a command line list file.
~@ -- Exclusion on, applied to a command line list file.
~* -- Exclusion on, applied to a file specification.
!* -- Recursion on, applied to a file specification.
The recursion operation consists of:
1. Get path to implied directory (i.e. either path to current direc
+tory or path as
given).
2. Use remainder of specification as wild-card specification.
3. Find all relevant sub-directories and form new glob string (i.e.
+ path + specification).
4. Append list of files (if any) to the appropriate argument vector
+.
5. Continue until all directories have been searched.
Crudely speaking, this can be done by forming a list of all relevant d
+irectories first
and then for each, find the necessary matching files. The first versio
+n will not use
recursion, it will manage the task in normal linear fashion.
=head2 EXPORT
WildARGV
=head2 EXAMPLE
#!/perl/bin/perl -w
#
# testwild.pl -- WildARGV demonstration script.
use strict;
use diagnostics;
use Getopt::Std;
use Wild;
my %OPT;
printARGV("Initial state.");
getopts('hx:',\%OPT);
printARGV("After getopts().");
WildARGV();
printARGV("After WildARGV().");
sub printARGV{
my $s = shift;
print "\@ARGV: $s\n";
foreach (0..$#ARGV) {
print "ARGV[$_]=$ARGV[$_]\n";
}
}
=head2 BUGS
Of course, though I try to be neat...
=head1 AUTHOR
B<I<Hugh S. Myers>>
=over
=item Always: hsmyers@sdragons.com
=item Sometimes: hughmyers@micron.com
=back
=cut
|