#!/usr/bin/perl
#: search in, or list all, executable commands in your $PATH
#======================================================================
# Time-stamp: "2009-12-20 05:07:18 AKST sburke@cpan.org"
use constant DEBUG => 0; use strict; use warnings;

my $Cache_Max_Lifetime_In_Days = 1;

#
# allx - list all your executables in your $PATH, or filter for some.
#        The master list is cached in ~/.allx, and is rebuilt
#         periodically.
#
# If called as allxk or allxapropos, we try to list descriptions from 'whatis'
#
# 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 $Home = $ENV{'HOME'} || die "No home directory?";

my $Cache_Plain       = "$Home/allx.txt";
my $Cache_Pointery    = "$Home/allx_wheres.txt";

my $Descriptions_File = "$Home/whatis.txt";  # a cache file

my $Descriptions_Rebuilder_Command =
  '_rebuild_my_text_whatis'
  # "whatis -r . > $Descriptions_File"
;

my $Skip_Path_Current = 1; # Whether to skip any '.' in PATH

my $Show_Descriptions = 0;
my %Descriptions;
{
  DEBUG and print "Considering \$0 value of \"$0\"\n";
  if($0 =~ m/allx-?k/ or $0 =~ m/allk-?apro/) {
    DEBUG and print "OK, we'll try to show descriptions.\n";
    $Show_Descriptions = 1;
  } else {
    DEBUG and print "(We won't show descriptions.)\n";
  }
}

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

my $A = "\nAborting";
my $Force_Rebuild_Cache = 0;
my @Patterns;
my %Name2Where;
run();
exit;

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

sub run {
  args_processing();

  maybe_read_descriptions();

  my @items = all_x_maybe_cached();

  my $found = 0;
  my $desc;

  if(@Patterns) { # we have criteria
   Item:
    foreach my $item (@items) {
      foreach my $p (@Patterns) { # print the item if ANY match
        if($item =~ $p) {

	  $desc = $Descriptions{$item} || '';
	  if($desc) {
	    $desc =~ s<\A ([^\t]+) \t ><\t\t($1\)>x;
	    $desc = "\t$desc";
	  }

          print $item, "$desc\n";
          $found++;
	  next Item;
        }
      }
    }

  } else { # No patterns, we're just dumping:
    foreach my $item (@items) {

      $desc = $Descriptions{$item} || '';
      if($desc) {
        $desc =~ s<\A ([^\t]+) \t ><\t\t($1\)>x;
	$desc = "\t$desc";
      }

      print $item, "$desc\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 should_write_to_cache {

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

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

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

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

  DEBUG and print "As $Cache_Plain 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, "<", $Cache_Plain or die "Couldn't read-open $Cache_Plain - $!$A";
  chomp(@items = <$IN>);
  close($IN) or die "Can't close the readfile $Cache_Plain - $!"; #unexpected!
  return @items;
}

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

  my @items = all_x_scanning();

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

  close($OUT) or die "Can't close the writefile $Cache_Plain - $!"; #unexpected!
  DEBUG and print "Done writing ", scalar(@items), " items to $Cache_Plain\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 $all_count = 0;

  if($Skip_Path_Current) {
    $seen{ '.'  } = 1;
    $seen{ './' } = 1;
  }


  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";
        push @{ $Name2Where{$_} }, "$p/$_";
        ++$this_count;
      }
    }
    closedir(D) or warn "Can't closedir $p - $!";
    DEBUG and print " Saw $this_count items in $p\n";
    $all_count += $this_count;
  }

  my @keys = sort {lc($a) cmp lc($b)} keys %Name2Where;
  if($Cache_Pointery) {
    open my $WHERES, ">", $Cache_Pointery
     or die "Couldn't write-open $Cache_Pointery: $!\n";
    foreach my $key (@keys) {
      print $WHERES join("\t", $key, @{$Name2Where{$key}}), "\n";
    }
    close $WHERES or die "Can't close writefile $Cache_Pointery - $!"; #unexpected!
  }

  my $uniques_count = scalar @keys;
  DEBUG and print "Saw $all_count items in all paths (uniq: $uniques_count)\n";

  return @keys;
}

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


sub maybe_rebuild_descriptions_cache {
  my $rebuild = '';

  if($Force_Rebuild_Cache) {
    $rebuild = 1;
  } elsif(! -e $Descriptions_File ) {
    DEBUG and print "Will build $Descriptions_File (none extant)\n";
    $rebuild = 1;

  } elsif( -M $Descriptions_File >= $Cache_Max_Lifetime_In_Days ) {
    DEBUG and print "As $Descriptions_File is stale...\n";
    $rebuild = 1;
  } else {
    DEBUG and print "Stet $Descriptions_File\n";
  }
  return unless $rebuild;
  return rebuild_descriptions_cache();
}

sub rebuild_descriptions_cache {
  0==system($Descriptions_Rebuilder_Command)
   or die "Running \"$Descriptions_Rebuilder_Command\" failed - $?";
  return;
}



sub maybe_read_descriptions { 
  return unless $Show_Descriptions;


  maybe_rebuild_descriptions_cache();

  DEBUG and print "Reading $Descriptions_File ...\n";
  open my $F, "<", $Descriptions_File
    or die "Can't read-open $Descriptions_File - $!$A";
  my $seen = 0;

=begin notes

Test cases of odd lines from whatis...

cpp (1)              - The C Preprocessor
Crypt::SSLeay (3pm)  - OpenSSL glue that provides LWP https support
cups-genppd (8) [cups-genppd.5.0] - generate Gutenprint PPD files for use with CUPS
ctags (1emacs21)     - generate tag file for Emacs, vi

=end notes

=cut

  # In processing, we'll take the one with the simplest, lowest-sectioned line.
  while(<$F>) {
    chomp;

    my($comm, $sect, $desc) = 
      m<\A
        (\S+)  # command name

	\s+
	\(
          ( .*? )  # section "number" 
	\)

	( .+ )  # absolutely everything else
       >x
    ;

    unless(defined $comm) {
      DEBUG > 5 and print " Can't parse whatis line: \"$_\"\n";
      next;
    }

    DEBUG > 15 and print " Considering the whatis line: $_ {$comm} {$sect} {$desc}\n";

    $desc =~ s< - >< >;
    $desc =~ s<\s+>< >g;
    unless($desc) {
      DEBUG > 5 and print " Odd, no sensible description in: \"$_\"\n";
      next;
    }
    $desc = "$sect\t$desc";

    ++$seen;

    if(!defined $Descriptions{$comm}) {
      $Descriptions{$comm} = $desc;
      if(DEBUG > 14) {
	print " ~For $comm, desc: $desc\n";
      }
      next;      
    }

    # Otherwise, uhoh, here we go, trying to compare
    if( $desc lt $Descriptions{$comm}) {
      if(DEBUG > 14) {
	my $saying = join '', " +For $comm, replacing description\n\t",
	  $Descriptions{$comm}, "\n with simpler\n\t$desc\n\n";
	print $saying;
      }

      Descriptions{$comm} = $desc;

    } else {
      if(DEBUG > 14) {
        my $saying = join '', " -For $comm, stet. Already-seen description\n\t",
	  $Descriptions{$comm}, "\n  is simpler than under-consideration\n\t$desc\n\n";
	print $saying;
      }
    }

  }
  close $F or die "Can't close readfile $Descriptions_File - $!"; #unexpected!

  DEBUG and print "Done reading $Descriptions_File -- $seen descs seen, ",
    scalar keys %Descriptions, " descs stored.\n";

  return;
}

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

__END__