Beefy Boxes and Bandwidth Generously Provided by pair Networks Cowboy Neal with Hat
"be consistent"
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
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

In reply to Wild - Perl extension for improved program interface. Wild-card expansion for @ARGV. by hsmyers

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • 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! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, 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, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &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.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others avoiding work at the Monastery: (5)
    As of 2014-04-20 16:32 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      April first is:







      Results (485 votes), past polls