#! /usr/bin/perl
# substitution_solver solves substitution problems, and is released
# under the terms of the GPL version 2, or any later version, at your
# option. See the file README and COPYING for more information.
# Copyright 2006 by Don Armstrong <don@donarmstrong.com>.
# $Id: perl_script 495 2006-08-10 08:02:01Z don $


use warnings;
use strict;

use Getopt::Long;
use Pod::Usage;

=head1 NAME

substitution_solver - Solve substitution puzzles using known substitution methods

=head1 SYNOPSIS

 substitution_solver [options]

 Options:
  --log, -l file to log to
  --input, -i initial input
  --substitutions, -s directory of substitutions
  --debug, -d debugging level (Default 0)
  --help, -h display this help
  --man, -m display manual

=head1 OPTIONS

=over

=item B<--log,-l>

An optional file to log the puzzle solution process

=item B<--input,-i>

Initial input to start puzzle solving with

=item B<--transforms,-t>

Directory of transforms to use; defaults to ~/.substitution_solver/transforms

=item B<--debug, -d>

Debug verbosity. (Default 0)

=item B<--help, -h>

Display brief useage information.

=item B<--man, -m>

Display this manual.

=back

=head1 EXAMPLES


=cut


use vars qw($DEBUG);

my %options = (debug           => 0,
	       help            => 0,
	       man             => 0,
	       transforms      => [$ENV{HOME}.'/lib/substitution_solver/transforms'],
	       );

GetOptions(\%options,'debug|d+','help|h|?','man|m',
	   'log|l=s','input|i=s',
	   'transforms|t=s@',
	  );

pod2usage() if $options{help};
pod2usage({verbose=>2}) if $options{man};

$DEBUG = $options{debug};

use IO::File;
use File::Temp qw(tempfile);
use Term::ReadLine;
use File::Spec qw(catfile rel2abs);
use Params::Validate qw(validate_with :types);

my $logfh;

if (defined $options{log}) {
     $logfh = IO::File->new($options{log},'w') or die "Unable to open $logfh for writing: $!";
}
else {
     # we write to a tempfile for now
     if ( -w '/dev/null') {
	  $logfh = IO::File->new('/dev/null','w') or die "Unable to open /dev/null for writing: $!";
     }
     else {
	  $logfh = tempfile();
     }
}

my %transforms;

my @input_stack = ('');
my $input_pos = 0;

if (defined $options{input}) {
     read_input($options{input});
}

# read transformations

my $surpress_status = 0;


my $done = 0;

load_transforms(@{$options{transforms}});


my $readline = Term::ReadLine->new('substitutionsolver');

while (not $done) {
     my $line = $readline->readline('['.$input_pos.']: ');
     local $_ = $line;
     s/^\s+//;
     chomp;
     print {$logfh} $line;
     if (/^quit\s*$/) {
	  $done = 1;
     }
     elsif (/^input\s+(.+)/) {
	  read_input($1);
     }
     elsif (/^stat(?:s|istics)?\s*$/) {
	  output_statistics($1);
	  $surpress_status = 1;
     }
     elsif (/^list\s*$/) {
	  list_transformations();
	  $surpress_status = 1;
     }
     elsif (/^applicable/) {
	  list_transformations(applicable=>1);
	  $surpress_status = 1;
     }
     elsif (/^print\s+stack\s*$/) {
	  print join("\n",map {"$_: $input_stack[$_]\n"} 0..$#input_stack);
     }
     elsif (/^p(?:rint)?\s*$/) {
	  print "Current input:\n";
	  print $input_stack[$input_pos];
	  print "\n";
     }
     elsif (/^perl\s*(.+)/) {
	  do_perl_eval($1);
     }
     elsif (/^output\s+(.+)/) {
	  write_output($1);
     }
     elsif (/^undo\s*$/) {
	  $input_pos-- if $input_pos > 0;
     }
     elsif (/^redo\s*$/) {
	  $input_pos++ if ($input_pos+1) < $#input_stack;
     }
     elsif (/^\#/) {
	  # ignore comments
     }
     else {
	  print "Unknown command '$_'\n";
     }
}


sub read_input {
     my ($file) = @_;
     my $fh = IO::File->new($file,'r');
     if (not $fh) {
	  print "Unable to open $file for reading: $!\n";
	  return;
     }
     local $/;
     my $content = <$fh>;
     @input_stack = ($content);
     $input_pos = 0;
}

sub output_statistics {
     my $current_input = $input_stack[$input_pos];
     my %counts;
     $counts{uc($_)}++ foreach grep /\S/, split //, $current_input;
     for my $key (sort {$counts{$b} <=> $counts{$a}} keys %counts) {
	  print "$key: $counts{$key}\n";
     }
}

sub do_perl_eval{
     my ($perl) = @_;
     local $_ = $input_stack[$input_pos];
     my $return = eval $perl;
     if ($@) {
	  print "Failure while evaluating perl code\n";
	  print $@;
	  print "\n";
     }
     else {
	  increment_stack($return);
     }
}

sub write_output{
     my ($file) = @_;
     my $fh = IO::File->new($file,'w');
     if (not $fh) {
	  print "Unable to open $file for writing: $!\n";
	  return;
     }
     print {$fh} $input_stack[$input_pos];
}

sub increment_stack{
     $input_stack[++$input_pos] = $_[0];
}

sub load_transformations{
     my @transforms = @_;
     my @transform_files;
     for my $transform (@transforms) {
	  if (-f $transform) {
	       push @transform_files,rel2abs($transform);
	  }
	  elsif (-d $transform) {
	       my $dir = IO::Dir->new($transform);
	       if (not $dir) {
		    print "Unable to open $transform for reading: $!";
		    next;
	       }
	       my $file;
	       while ($file = $dir->readdir) {
		    next unless /^[a-z0-9][a-z0-9-]*$/;
		    next unless -f rel2abs(catfile($transform,$file));
		    push @transform_files,rel2abs(catfile($transform,$file));
	       }
	  }
     }
     for my $transform_file (@transform_files) {
	  my $fh = IO::File->new($transform_file);
	  if (not $fh) {
	       print "Unable to open $transform_file for reading: $!";
	  }
	  my ($type,$name,$content) = (undef,undef,'');
	  while (<$fh>) {
	       if (/^name\:/ and not defined $name) {
		    chomp;
		    s/^name\:\s*//;
		    $name = $_;
		    next;
	       }
	       elsif (/^type:/ and not defined $type) {
		    chomp;
		    s/^type\:\s*//;
		    $type = $_;
		    next;
	       }
	       elsif (/^\#/) {
		    next;
	       }
	       else {
		    $content .= $_;
	       }
	  }
	  if (not defined $type or not defined $name) {
	       print "Badly formed transform file $transform_file; no type or name\n";
	       next;
	  }
	  if ($type eq 'tr') {
	       my @content = grep /./, split /\n/, $content;
	       $transforms{$name} = {type => 'tr',
				     name => $name,
				     content => $content,
				     from => $content[0],
				     to   => $content[1],
				    };
	  }
	  elsif ($type eq 'map') {
	       my @content = grep /./, split /\n/, $content;
	       my %map;
	       my %map_reverse;
	       for my $line (@content) {
		    my ($from,$to) = split /\t+/,$line;
		    $map{$from} = $to;
		    $map_reverse{$to} = $from;
	       }
	       $transforms{$name} = {type => 'map',
				     name => $name,
				     content => $content,
				     map     => \%map,
				     map_reverse => \%map,
				    };
	  }
	  elsif ($type eq 'perl') {
	       $transforms{$name} = {type => 'perl',
				     name => $name,
				     content => $content,
				    };
	  }
	  else {
	       print "Unknown type $type for transform $transform_file\n";
	       next;
	  }
     }
}

sub list_transformations{
     my %param = validate_with(params => \@_,
			       spec   => {applicable => {type => BOOLEAN,
							 default => 0,
							},
					 },
			      );
     for my $transform (keys %transforms) {
	  if ($param{applicable}) {
	       # figure out if we can apply a transform
	       my $output = attempt_transform($transform);
	       if (not defined $output) {
		    next;
	       }
	  }
	  print "$transform\n";
     }
}


sub attempt_transform{
     my ($name) = @_;
     my $transform = $transforms{$name};
     $transform->{}
}


__END__