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 export
# 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 @EXPORT_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 expansion 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 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. 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 specification.
   !@        -- 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 directory 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 directories first
and then for each, find the necessary matching files. The first version 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