--- /dev/null
+#! /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__
projects / bin.git / blobdiff