Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
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
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            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 wandering the Monastery: (5)
    As of 2015-07-29 23:14 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (269 votes), past polls