The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -s

use strict;
use warnings;

use Data::Dumper;

use Term::ReadLine;
use File::Spec;
use File::Path;
use File::Copy;
use Lingua::NATools;

our ($h);

if ($h) {
  print "nat-shell: A shell interface to NATools corpora alignment\n\n";
  print "\tnat-shell\n\n";
  print "For more help, please run 'perldoc nat-shell'\n";
  exit;
}

=encoding UTF-8

=head1 NAME

nat-shell - A shell interface to NATools corpora alignment

=head1 SYNOPSIS

  nat-shell

=head1 DESCRIPTION

This is intended to be a shell for NATools main command. At the moment
is just supports the creation of parallel corpora. Details on the
shell commands usage are available inside the shell. Just issue a
C<usage> command at the prompt.

=cut

print "Welcome to NATools shell tool\n";

our $SELF = {};
our %usage =
  (
   init     => "Initializes a directory for a NATools corpus. Use:\n\tinit <dir> <name>\n",
   usage    => "Gets help for a command. Use:\n\tusage <command>\nYou can get a list of available commands using\n\tcommands\n",
   commands => "Prints the list of available commands.\n",
   codify   => "Codifies a parallel corpus. Use:\n\tcodify <corpus-1> <corpus-2>\n",
   align    => "Aligns all chunks or a specific one. Use:\n\talign [<chunk_nr>|all]\n",
   index    => "Join all invertion indexes",
   open     => "Open a NATools corpus. Use:\n\topen <dir>\n",
   grep     => "",
   mkdict   => "",
  );
$usage{help}   = $usage{usage};
$usage{encode} = $usage{codify};

my $cmds = init_commands();
our $term = new Term::ReadLine 'nat-shell';
our $prompt = "(nat)";
my $line;
while ( defined ($line = $term->readline($prompt)) ) {
  next if $line =~ m!^\s*$!;
  $line =~ m!^\s*(\S+)(?:\s+(.*))?!;
  my ($command,$data) = ($1,$2);
  if (exists($cmds->{$command})) {
    if ($data) {
      $cmds->{$command}(split/\s+/,$data)
    } else {
      $cmds->{$command}()
    }
  } else {
    print "Command '$command' unknown\n";
  }

  print "\n"; # clear line before exit
}
print "\n"; # clear line before exit





sub init_commands {
  +{
    init     => \&init,
    open     => \&openit,
    usage    => \&usage,
    help     => \&usage,
    commands => \&list_commands,
    codify   => \&codify,
    encode   => \&codify,
    align    => \&align,
    index    => \&invindex,
    grep     => \&grp,
    mkdict   => \&mkdict,
   }
}

sub mkdict {
  $SELF->make_dict
}

sub invindex {
  $SELF->index_invindexes(1);
}


sub codify {
  my ($txt1, $txt2) = @_;

  eval {
    $SELF->codify({verbose => 1}, $txt1,$txt2);
  };
  print $@ if ($@);
}


sub list_commands {
  print " Commands available:\n";
  print "   $_\n" for sort keys %$cmds;
}


sub align {
  my ($chunk) = @_;
  $chunk ||= "all";

  if ($chunk eq "all") {
    $SELF->align_all;
  } else {
    eval {
      $SELF->align_chunk($chunk)
    };
    print $@ if $@;
  }
}

sub openit {
  my ($dir) = @_;
  if ($dir) {
      $SELF = Lingua::NATools->load($dir);
      if ($SELF) {
	  $prompt = "(".$SELF->{conf}->param("nat.name").")";
      } else {
	  print "Error loading '$dir'";
      }
  } else {
    usage("open");
  }
}

sub init {
  my ($dir,$name) = @_;
  if ($dir && $name) {
    if (-d $dir) {
      my $homedir = File::Spec->catfile($dir,$name);
      if (-d $homedir) {
	my $ans = $term->readline("Directory already exists. Overwrite? [no]");
	return unless $ans =~ m!^y(es)?$!;
      }

      eval { $SELF = Lingua::NATools->init($dir,$name) };

      if ($@) {
	print $@;
	return
      }

      $prompt = "($name)";

    } else {
      print "Directory '$dir' does not exist\n";
    }
  } else {
    usage("init");
  }
}

sub usage {
  my $arg = shift || "help";

  if (exists($usage{$arg})) {
    print $usage{$arg}
  } else {
    print "Command '$arg' is unknown\n";
  }
}

=head1 SEE ALSO

NATools documentation, perl(1)

=head1 AUTHOR

Alberto Manuel Brandão Simões, E<lt>ambs@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006-2012 by Alberto Manuel Brandão Simões

=cut