#!/usr/bin/perl
#desc{ outputs a list of all Perl modules installed on your system }
#
# I have this crontabbed to run every night, like so:
#   list_all_perl_modules > ~/perl_module_list.txt
#						       -- sburke@cpan.org
#
#( Time-stamp: "2008-08-21 19:06:35 AKDT sburke@cpan.org" )
use constant DEBUG => 0;
use strict; use warnings;
my $A = "\nAborting";
$|++; # for sake of error messages mixing incoherently
my( %Name2Path, @Modules, @Perlfunc, @Perlvar );

use Pod::Simple::Search;

get_modules();

my $Fs_perlfunc = $Name2Path{ 'perlfunc' };
my $Fs_perlvar  = $Name2Path{ 'perlvar'  };
get_perlfunc();
#get_perlvar();

print join("\n", @Modules, @Perlfunc, @Perlvar), "\n";

exit;
#======================================================================

sub get_modules {
  DEBUG and print "Scanning \@INC for modules...\n";
  my $n2p = Pod::Simple::Search->new->survey;
  %Name2Path = %$n2p;
  @Modules = sort keys %Name2Path;

  die join '', "Only ", scalar @Modules, " modules found!?"
    if @Modules < 100;

  DEBUG and print "Done scanning Scanning \@INC for modules, having found ",
    scalar(@Modules), " entries.\n\n";
  return;
}

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

sub get_perlfunc {
  open my $IN, "<", $Fs_perlfunc
   or die "Couldn't read-open $Fs_perlfunc: $!$A";

  DEBUG and print "Reading perlfunc...\n";

  my $skipping = 1;
  my %seen;
  while(<$IN>) {
    DEBUG > 10 and print "\tSkipping> $_";
    if($skipping) {
      if( m/\bAlphabetical\b/ ) {
        $skipping = 0;	      
	chomp;
	DEBUG > 5 and print " (Now alert to perlfunc because of $_)";
      }
      next;
    }

    {
      while( m/ \b X< (.*?) > /gx ) {
        next if $seen{$1}++;
	push @Perlfunc, $1;
      }
    }

    if( m/^=item \s+ ( [^\*\s\(\/]+ ) [,\s]+  (.+) /x) {
      my($x, $rest) = ($1,$2);
      DEBUG > 11 and print "\n<$x> <$rest>\n";
      if($rest =~ m/\w/ and $rest eq lc($rest)) {
        chomp;
        DEBUG > 5 and print "\tskipping $_ as a red herring.\n";
	next;
      }
      next if $seen{$x}++;

      DEBUG > 4 and print " func: $x\n";
      push @Perlfunc, $x;
    }
  }

  close($IN);
  die join '', "Only ", scalar @Perlfunc, " functions found!?"
    if @Perlfunc < 50;
  DEBUG and print "Closed perlfunc, having read ", scalar @Perlfunc,
   " entries.\n\n";
  return;
}

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

sub get_perlvar {
  open my $IN, "<", $Fs_perlvar
   or die "Couldn't read-open $Fs_perlvar: $!";

  DEBUG and print "Reading perlvar...\n";

  my %seen;
  while(<$IN>) {
    DEBUG > 10 and print "\tSkipping> $_";
    if( m/^=item \s+ ( [\$\@\%]\S+ ) (.+) /x ) {
      my($x, $rest) = ($1,$2);
      next if $seen{$x}++;
      DEBUG > 4 and print " var: $x\n";
      push @Perlvar, $x;
    }
  }

  close($IN);
  die join '', "Only ", scalar @Perlvar, " modules found!?"
    if @Perlvar < 100;
  DEBUG and print "Closed perlvar, having read ", scalar @Perlvar,
   " entries.\n\n";
  return;
}

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