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 $
17 substitution_solver - Solve substitution puzzles using known substitution methods
21 substitution_solver [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
37 An optional file to log the puzzle solution process
41 Initial input to start puzzle solving with
43 =item B<--transforms,-t>
45 Directory of transforms to use; defaults to ~/.substitution_solver/transforms
49 Debug verbosity. (Default 0)
53 Display brief useage information.
69 my %options = (debug => 0,
72 transforms => [$ENV{HOME}.'/lib/substitution_solver/transforms'],
75 GetOptions(\%options,'debug|d+','help|h|?','man|m',
76 'log|l=s','input|i=s',
80 pod2usage() if $options{help};
81 pod2usage({verbose=>2}) if $options{man};
83 $DEBUG = $options{debug};
86 use File::Temp qw(tempfile);
88 use File::Spec qw(catfile rel2abs);
89 use Params::Validate qw(validate_with :types);
93 if (defined $options{log}) {
94 $logfh = IO::File->new($options{log},'w') or die "Unable to open $logfh for writing: $!";
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: $!";
108 my @input_stack = ('');
111 if (defined $options{input}) {
112 read_input($options{input});
115 # read transformations
117 my $surpress_status = 0;
122 load_transforms(@{$options{transforms}});
125 my $readline = Term::ReadLine->new('substitutionsolver');
128 my $line = $readline->readline('['.$input_pos.']: ');
132 print {$logfh} $line;
136 elsif (/^input\s+(.+)/) {
139 elsif (/^stat(?:s|istics)?\s*$/) {
140 output_statistics($1);
141 $surpress_status = 1;
143 elsif (/^list\s*$/) {
144 list_transformations();
145 $surpress_status = 1;
147 elsif (/^applicable/) {
148 list_transformations(applicable=>1);
149 $surpress_status = 1;
151 elsif (/^print\s+stack\s*$/) {
152 print join("\n",map {"$_: $input_stack[$_]\n"} 0..$#input_stack);
154 elsif (/^p(?:rint)?\s*$/) {
155 print "Current input:\n";
156 print $input_stack[$input_pos];
159 elsif (/^perl\s*(.+)/) {
162 elsif (/^output\s+(.+)/) {
165 elsif (/^undo\s*$/) {
166 $input_pos-- if $input_pos > 0;
168 elsif (/^redo\s*$/) {
169 $input_pos++ if ($input_pos+1) < $#input_stack;
175 print "Unknown command '$_'\n";
182 my $fh = IO::File->new($file,'r');
184 print "Unable to open $file for reading: $!\n";
189 @input_stack = ($content);
193 sub output_statistics {
194 my $current_input = $input_stack[$input_pos];
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";
204 local $_ = $input_stack[$input_pos];
205 my $return = eval $perl;
207 print "Failure while evaluating perl code\n";
212 increment_stack($return);
218 my $fh = IO::File->new($file,'w');
220 print "Unable to open $file for writing: $!\n";
223 print {$fh} $input_stack[$input_pos];
227 $input_stack[++$input_pos] = $_[0];
230 sub load_transformations{
233 for my $transform (@transforms) {
235 push @transform_files,rel2abs($transform);
237 elsif (-d $transform) {
238 my $dir = IO::Dir->new($transform);
240 print "Unable to open $transform for reading: $!";
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));
251 for my $transform_file (@transform_files) {
252 my $fh = IO::File->new($transform_file);
254 print "Unable to open $transform_file for reading: $!";
256 my ($type,$name,$content) = (undef,undef,'');
258 if (/^name\:/ and not defined $name) {
264 elsif (/^type:/ and not defined $type) {
277 if (not defined $type or not defined $name) {
278 print "Badly formed transform file $transform_file; no type or name\n";
282 my @content = grep /./, split /\n/, $content;
283 $transforms{$name} = {type => 'tr',
290 elsif ($type eq 'map') {
291 my @content = grep /./, split /\n/, $content;
294 for my $line (@content) {
295 my ($from,$to) = split /\t+/,$line;
297 $map_reverse{$to} = $from;
299 $transforms{$name} = {type => 'map',
303 map_reverse => \%map,
306 elsif ($type eq 'perl') {
307 $transforms{$name} = {type => 'perl',
313 print "Unknown type $type for transform $transform_file\n";
319 sub list_transformations{
320 my %param = validate_with(params => \@_,
321 spec => {applicable => {type => BOOLEAN,
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) {
334 print "$transform\n";
339 sub attempt_transform{
341 my $transform = $transforms{$name};