substitution_solver

   1 #! /usr/bin/perl
   2 # substitution_solver solves substitution problems, and is released
   3 # under the terms of the GPL version 2, or any later version, at your
   4 # option. See the file README and COPYING for more information.
   5 # Copyright 2006 by Don Armstrong <don@donarmstrong.com>.
   6 # $Id: perl_script 495 2006-08-10 08:02:01Z don $
   7
   8
   9 use warnings;
  10 use strict;
  11
  12 use Getopt::Long;
  13 use Pod::Usage;
  14
  15 =head1 NAME
  16
  17 substitution_solver - Solve substitution puzzles using known substitution methods
  18
  19 =head1 SYNOPSIS
  20
  21  substitution_solver [options]
  22
  23  Options:
  24   --log, -l file to log to
  25   --input, -i initial input
  26   --substitutions, -s directory of substitutions
  27   --debug, -d debugging level (Default 0)
  28   --help, -h display this help
  29   --man, -m display manual
  30
  31 =head1 OPTIONS
  32
  33 =over
  34
  35 =item B<--log,-l>
  36
  37 An optional file to log the puzzle solution process
  38
  39 =item B<--input,-i>
  40
  41 Initial input to start puzzle solving with
  42
  43 =item B<--transforms,-t>
  44
  45 Directory of transforms to use; defaults to ~/.substitution_solver/transforms
  46
  47 =item B<--debug, -d>
  48
  49 Debug verbosity. (Default 0)
  50
  51 =item B<--help, -h>
  52
  53 Display brief useage information.
  54
  55 =item B<--man, -m>
  56
  57 Display this manual.
  58
  59 =back
  60
  61 =head1 EXAMPLES
  62
  63
  64 =cut
  65
  66
  67 use vars qw($DEBUG);
  68
  69 my %options = (debug           => 0,
  70                help            => 0,
  71                man             => 0,
  72                transforms      => [$ENV{HOME}.'/lib/substitution_solver/transforms'],
  73                );
  74
  75 GetOptions(\%options,'debug|d+','help|h|?','man|m',
  76            'log|l=s','input|i=s',
  77            'transforms|t=s@',
  78           );
  79
  80 pod2usage() if $options{help};
  81 pod2usage({verbose=>2}) if $options{man};
  82
  83 $DEBUG = $options{debug};
  84
  85 use IO::File;
  86 use File::Temp qw(tempfile);
  87 use Term::ReadLine;
  88 use File::Spec qw(catfile rel2abs);
  89 use Params::Validate qw(validate_with :types);
  90
  91 my $logfh;
  92
  93 if (defined $options{log}) {
  94      $logfh = IO::File->new($options{log},'w') or die "Unable to open $logfh for writing: $!";
  95 }
  96 else {
  97      # we write to a tempfile for now
  98      if ( -w '/dev/null') {
  99           $logfh = IO::File->new('/dev/null','w') or die "Unable to open /dev/null for writing: $!";
 100      }
 101      else {
 102           $logfh = tempfile();
 103      }
 104 }
 105
 106 my %transforms;
 107
 108 my @input_stack = ('');
 109 my $input_pos = 0;
 110
 111 if (defined $options{input}) {
 112      read_input($options{input});
 113 }
 114
 115 # read transformations
 116
 117 my $surpress_status = 0;
 118
 119
 120 my $done = 0;
 121
 122 load_transforms(@{$options{transforms}});
 123
 124
 125 my $readline = Term::ReadLine->new('substitutionsolver');
 126
 127 while (not $done) {
 128      my $line = $readline->readline('['.$input_pos.']: ');
 129      local $_ = $line;
 130      s/^\s+//;
 131      chomp;
 132      print {$logfh} $line;
 133      if (/^quit\s*$/) {
 134           $done = 1;
 135      }
 136      elsif (/^input\s+(.+)/) {
 137           read_input($1);
 138      }
 139      elsif (/^stat(?:s|istics)?\s*$/) {
 140           output_statistics($1);
 141           $surpress_status = 1;
 142      }
 143      elsif (/^list\s*$/) {
 144           list_transformations();
 145           $surpress_status = 1;
 146      }
 147      elsif (/^applicable/) {
 148           list_transformations(applicable=>1);
 149           $surpress_status = 1;
 150      }
 151      elsif (/^print\s+stack\s*$/) {
 152           print join("\n",map {"$_: $input_stack[$_]\n"} 0..$#input_stack);
 153      }
 154      elsif (/^p(?:rint)?\s*$/) {
 155           print "Current input:\n";
 156           print $input_stack[$input_pos];
 157           print "\n";
 158      }
 159      elsif (/^perl\s*(.+)/) {
 160           do_perl_eval($1);
 161      }
 162      elsif (/^output\s+(.+)/) {
 163           write_output($1);
 164      }
 165      elsif (/^undo\s*$/) {
 166           $input_pos-- if $input_pos > 0;
 167      }
 168      elsif (/^redo\s*$/) {
 169           $input_pos++ if ($input_pos+1) < $#input_stack;
 170      }
 171      elsif (/^\#/) {
 172           # ignore comments
 173      }
 174      else {
 175           print "Unknown command '$_'\n";
 176      }
 177 }
 178
 179
 180 sub read_input {
 181      my ($file) = @_;
 182      my $fh = IO::File->new($file,'r');
 183      if (not $fh) {
 184           print "Unable to open $file for reading: $!\n";
 185           return;
 186      }
 187      local $/;
 188      my $content = <$fh>;
 189      @input_stack = ($content);
 190      $input_pos = 0;
 191 }
 192
 193 sub output_statistics {
 194      my $current_input = $input_stack[$input_pos];
 195      my %counts;
 196      $counts{uc($_)}++ foreach grep /\S/, split //, $current_input;
 197      for my $key (sort {$counts{$b} <=> $counts{$a}} keys %counts) {
 198           print "$key: $counts{$key}\n";
 199      }
 200 }
 201
 202 sub do_perl_eval{
 203      my ($perl) = @_;
 204      local $_ = $input_stack[$input_pos];
 205      my $return = eval $perl;
 206      if ($@) {
 207           print "Failure while evaluating perl code\n";
 208           print $@;
 209           print "\n";
 210      }
 211      else {
 212           increment_stack($return);
 213      }
 214 }
 215
 216 sub write_output{
 217      my ($file) = @_;
 218      my $fh = IO::File->new($file,'w');
 219      if (not $fh) {
 220           print "Unable to open $file for writing: $!\n";
 221           return;
 222      }
 223      print {$fh} $input_stack[$input_pos];
 224 }
 225
 226 sub increment_stack{
 227      $input_stack[++$input_pos] = $_[0];
 228 }
 229
 230 sub load_transformations{
 231      my @transforms = @_;
 232      my @transform_files;
 233      for my $transform (@transforms) {
 234           if (-f $transform) {
 235                push @transform_files,rel2abs($transform);
 236           }
 237           elsif (-d $transform) {
 238                my $dir = IO::Dir->new($transform);
 239                if (not $dir) {
 240                     print "Unable to open $transform for reading: $!";
 241                     next;
 242                }
 243                my $file;
 244                while ($file = $dir->readdir) {
 245                     next unless /^[a-z0-9][a-z0-9-]*$/;
 246                     next unless -f rel2abs(catfile($transform,$file));
 247                     push @transform_files,rel2abs(catfile($transform,$file));
 248                }
 249           }
 250      }
 251      for my $transform_file (@transform_files) {
 252           my $fh = IO::File->new($transform_file);
 253           if (not $fh) {
 254                print "Unable to open $transform_file for reading: $!";
 255           }
 256           my ($type,$name,$content) = (undef,undef,'');
 257           while (<$fh>) {
 258                if (/^name\:/ and not defined $name) {
 259                     chomp;
 260                     s/^name\:\s*//;
 261                     $name = $_;
 262                     next;
 263                }
 264                elsif (/^type:/ and not defined $type) {
 265                     chomp;
 266                     s/^type\:\s*//;
 267                     $type = $_;
 268                     next;
 269                }
 270                elsif (/^\#/) {
 271                     next;
 272                }
 273                else {
 274                     $content .= $_;
 275                }
 276           }
 277           if (not defined $type or not defined $name) {
 278                print "Badly formed transform file $transform_file; no type or name\n";
 279                next;
 280           }
 281           if ($type eq 'tr') {
 282                my @content = grep /./, split /\n/, $content;
 283                $transforms{$name} = {type => 'tr',
 284                                      name => $name,
 285                                      content => $content,
 286                                      from => $content[0],
 287                                      to   => $content[1],
 288                                     };
 289           }
 290           elsif ($type eq 'map') {
 291                my @content = grep /./, split /\n/, $content;
 292                my %map;
 293                my %map_reverse;
 294                for my $line (@content) {
 295                     my ($from,$to) = split /\t+/,$line;
 296                     $map{$from} = $to;
 297                     $map_reverse{$to} = $from;
 298                }
 299                $transforms{$name} = {type => 'map',
 300                                      name => $name,
 301                                      content => $content,
 302                                      map     => \%map,
 303                                      map_reverse => \%map,
 304                                     };
 305           }
 306           elsif ($type eq 'perl') {
 307                $transforms{$name} = {type => 'perl',
 308                                      name => $name,
 309                                      content => $content,
 310                                     };
 311           }
 312           else {
 313                print "Unknown type $type for transform $transform_file\n";
 314                next;
 315           }
 316      }
 317 }
 318
 319 sub list_transformations{
 320      my %param = validate_with(params => \@_,
 321                                spec   => {applicable => {type => BOOLEAN,
 322                                                          default => 0,
 323                                                         },
 324                                          },
 325                               );
 326      for my $transform (keys %transforms) {
 327           if ($param{applicable}) {
 328                # figure out if we can apply a transform
 329                my $output = attempt_transform($transform);
 330                if (not defined $output) {
 331                     next;
 332                }
 333           }
 334           print "$transform\n";
 335      }
 336 }
 337
 338
 339 sub attempt_transform{
 340      my ($name) = @_;
 341      my $transform = $transforms{$name};
 342      $transform->{}
 343 }
 344
 345
 346 __END__