#!/usr/bin/perl
use vars qw($VERSION);
my $APP  = 're.pl';
$VERSION = '0.132';

use Storable;
use strictures 1;
use Pod::Usage;
use Data::Dumper;
use Getopt::Long;
use Term::ReadLine;
use File::Find::Rule;
use Eval::WithLexicals;
use B::Keywords qw/@Symbols/; # @Barewords/;

push(@Symbols, 'perldoc');

my $module_db = "$ENV{HOME}/.re.pl.db";

if(exists($ENV{XDG_DATA_HOME})) {
  mkdir("$ENV{XDG_DATA_HOME}/re.pl");
  $module_db = "$ENV{XDG_DATA_HOME}/re.pl/re.pl.db";
}

{
  package Data::Dumper;
  no strict 'vars';
  $Terse = $Indent = $Useqq = $Deparse = $Sortkeys = 1;
  $Quotekeys = 0;
}

my %modules;
GetOptions(
  'g|genmod'  => sub { unlink($module_db); },

  'h|help'    => sub { pod2usage(verbose => 1); },
  'v|version' => sub { printf("%s v%s\n", $APP, $VERSION) and exit 0; },
  'm|man'     => sub { pod2usage(verbose => 3); },
);

my @modules = get_installed_modules();

my $eval = Eval::WithLexicals->new;
my $term = Term::ReadLine->new('re.pl');

my $attr = $term->Attribs;
$attr->{completion_function} = sub {
  my($word, $buffer, $start) = @_;
  return (@Symbols, @modules);
};

$attr->{autolist}    =  0;
$attr->{maxcomplete} =  0;

#$term->set_keymap('vi');


while(1) {
  my $line = $term->readline("\e[33m\e[1m>\e[m ");
  print "\e[34m";
  my @ret;


  my @to_complete;

  if($line =~ m/^(perldoc\s+.+)$/) {
    system($1);
    next;
  }
  elsif($line eq ':q') {
    exit 0;
  }
  eval {
    local $SIG{INT} = sub { die("Caught SIGINT"); };
    @ret = $eval->eval($line);
    1;
  } or print "\e[31;1mError!\n$@\e[0m\n";

  # Differentiate Dumper and evaled function calls i.e print return values
  print "\e[1m";
  print Dumper @ret;
  print "\e[m";
}

sub get_installed_modules {
  if(-f $module_db) {
    %modules = %{ retrieve($module_db) },
  }
  else {
    local $| = 1;
    print "Generating list of available modules...";
    map {
      s%.+(?:core|site|vendor)_perl/(.+)\z%$1%;
      s|/|::|g;
      s/\.pm\z//;
      ($_ =~ m/^5.10/) ? undef : $modules{$_}++;

    } File::Find::Rule->file()->name('*.pm')->in(@INC);
    printf("%s\n", (scalar(keys(%modules)) > 0) ? "[OK]" : "");
  }
  store(\%modules, $module_db);
  return keys %modules;
}

__END__

=pod

=head1 NAME

re.pl - read, eval, print, loop with tabcompletion and persistent lexicals

=head1 DESCRIPTION

B<re.pl> tabcompletes to variables, special file handles, built in functions,
operators, control structures and modules if you have L<Term::ReadLine::Gnu>
or L<Term::ReadLine::Zoid> installed.

Documentation is also available straight from the REPL;

  re.pl$ perldoc Term::E<TAB>
  Term::ExtendedColor                     Term::ExtendedColor::TTY::Colorschemes
  Term::ExtendedColor::TTY                Term::ExtendedColor::Xresources

A list of available modules is created on the first run, or when the B<--genmod>
flag is specified.

=head1 OPTIONS

  -g, --genmod    re-create a list of available modules on the system

  -h, --help      show the help and exit
  -v, --version   show version info and exit
  -m, --man       show documentation and exit

=head1 COMMANDS

  perldoc My::Module # Invoke perldoc; will use the system $PAGER
  :q, exit           # exit re.pl

=head1 ENVIRONMENT

The behavior in the prompt is controlled by several variables. First, it's
recommended to have the C<Term::ReadLine::Gnu> module installed. Without it,
tab-completion and a I<vi> keymap can not be guaranteed.

A couple of records in $HOME/.inputrc will make working with perldoc easier,
assuming you are using Bash (or anything other that uses readline) as your
shell:

  set editing-mode vi
  set keymap vi-insert

  $if re.pl
    "\C-e": "perldoc perlre\n"
    "\C-g": "perldoc perlguts\n"
    "\C-o": "perldoc perlop\n"¶
    "\C-p": "perldoc perlipc\n"
    "\C-u": "perldoc perlunicode\n"¶
    "\C-v": "perldoc perlvar\n"¶
  $endif

=head1 AUTHOR

  Magnus Woldrich
  CPAN ID: WOLDRICH
  m@japh.se
  http://japh.se

=head1 HISTORY

Based on mst's example REPL in the awesome L<Eval::WithLexicals> distribution.

=head1 COPYRIGHT

Copyright (C) 2011, 2018 Magnus Woldrich.
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut
