#!/usr/bin/perl
#( Time-stamp: "2008-03-10 15:36:01 AKDT sburke@cpan.org"
#( desc{  search in, or list all, executable commands in your $PATH }
use constant DEBUG => 0; use strict; use warnings;

my $Cache_Max_Lifetime_In_Days = 10;

#
# allx - list all your executables in your $PATH, or filter for some.
#        The master list is cached in ~/.allx, and is rebuilt
#         periodically.
#
# allx               lists all executable files
# allx foo           lists all executable files matching the regexp "foo"
# allx foo bar baz   lists all executable files matching any of those regexps
# allx / ...         forces a rebuild of ~/.allx, then handles the ... items
#
# Note: Like grep, we return an exit status of 1 if nothing was found.
#
#======================================================================
#
# If you want to force a rebuild but not show anything, just use this hack:
#   allx / > /dev/null
#
#======================================================================
#
# (FYI: I chose "/" as the magic rebuild flag because there's just no way
# an executable could be named "/", or even contain the "/" character.)
#
#======================================================================

my $A = "\nAborting";
my $Dot = where_dot();
my $Force_Rebuild_Cache = 0;
my @Patterns;

run();

#======================================================================

sub run {
  args_processing();

  my @items = all_x_maybe_cached();
  my $found = 0;

  if(@Patterns) { # we have criteria
   Item:
    foreach my $item (@items) {
      foreach my $p (@Patterns) { # print the item if ANY match
        if($item =~ $p) {
          print $item, "\n";
          $found++;
	  next Item;
        }
      }
    }

  } else { # No patterns, we're just dumping:
    foreach my $item (@items) {
      print $item, "\n";
      $found++;
    }
  }

  DEBUG and print "Items found: $found\n";
  exit 1 unless $found;
  exit 0;
  return;
}

#======================================================================

sub args_processing {
  if(@ARGV and $ARGV[0] eq '/') { # the rebuild flag
    shift @ARGV;
    $Force_Rebuild_Cache = 1;
  }
  pattern_compiling( splice @ARGV );

  return;
}

#======================================================================

sub pattern_compiling {
  my(@ins) = @_;
   
  my $this_pat;
  foreach my $in (@ins) {
    eval { $this_pat = qr/$in/i };
    if($@) {
      die "$in isn't a valid regexp: $@\n";
    }
    push @Patterns, $this_pat;
  }

  if(DEBUG) {
    if(@Patterns) {
      print "Patterns to try matching against:\n";
      for(@Patterns) { print "  $_\n" }
      print "\n";
    } else {
      print "No patterns to match against.  Will just dump all.\n";
    }
  }

  return;
}


#======================================================================

sub where_dot {
  my $home = $ENV{'HOME'} || die "No 'HOME' in env?$A";
  die "$home doesn't exist?!" unless -e $home;
  return $home . "/.allx";
}

#======================================================================

sub should_write_to_cache {

  if( $Force_Rebuild_Cache ) {
    DEBUG and print "As I'm being forced to...\n";
    return 1;
  }

  unless( -e $Dot ) {
    DEBUG and print "As $Dot doesn't exist...\n";
    return 1;
  }

  if( -M $Dot >= $Cache_Max_Lifetime_In_Days ) {
    DEBUG and print "As $Dot is stale...\n";
    return 1;
  }

  die "$Dot isn't writeable$A" unless -w $Dot;

  DEBUG and print "As $Dot is fine...\n";
  return; # extant and not stale, and not forcing
}

#======================================================================

sub all_x_maybe_cached {
  return to_and_from_cache() if should_write_to_cache();
  return from_cache();
}

#======================================================================

sub from_cache {
  my @items;
  open my $IN, "<", $Dot or die "Couldn't read-open $Dot - $!$A";
  chomp(@items = <$IN>);
  close($IN);
  return @items;
}

sub to_and_from_cache {
  DEBUG and print "I'm re-scanning the dirs and writing to $Dot\n";
  open my $OUT, ">", $Dot or die "Couldn't write-open $Dot - $!$A";

  my @items = all_x_scanning();

  for(@items) {    print $OUT $_, "\n";    }

  close($OUT);
  DEBUG and print "Done writing ", scalar(@items), " items to $Dot\n";

  return @items;
}

#======================================================================

sub all_x_scanning { # no parameters, returns a list

  DEBUG > 1 and print "About to scan all path-dirs for executables...\n";

  my @path = grep m/\S/, split ':', $ENV{'PATH'} || die "No path!?";
  
  my %seen;
  my %x;
  my $all_count = 0;
  foreach my $p (@path) {
    next if $seen{$p};
    $seen{$p} = 1;
  
    opendir(D, $p) or next;
  
    DEBUG and print " Looking at path dir $p\n";
    my $this_count = 0;
  
    while(defined($_ = readdir(D))) {
      next if $_ eq '.' or $_ eq '..' or m/~/;
      if( -e "$p/$_" and -x _ and -r _ and -f _ ) {
        DEBUG > 15 and print "    x: $_\n";
        $x{ $_ }++;
        ++$this_count;
      }
    }
    closedir(D);
    DEBUG and print " Saw $this_count items in $p\n";
    $all_count += $this_count;
  }
  my $uniques_count = scalar keys %x;
  DEBUG and print "Saw $all_count items in all paths (uniq: $uniques_count)\n";

  return sort keys %x;
}

#======================================================================
__END__