Category: | Win32 Stuff |
Author/Contact Info | hsmyers@sdragons.com |
Description: | Will handle DOS-style wild-card expansion of '*' and '?'. Additionally it introduces '@', '!', and '~' as filename prefixes with the following 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. |
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 |
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: Wild - Perl extension for improved program interface. Wild-card expansion for @ARGV.
by miyagawa (Chaplain) on Sep 28, 2001 at 02:37 UTC | |
by hsmyers (Canon) on Sep 28, 2001 at 18:09 UTC | |
Re: Wild - Perl extension for improved program interface. Wild-card expansion for @ARGV.
by Jenda (Abbot) on Nov 12, 2002 at 23:19 UTC |
Back to
Code Catacombs