#!/usr/local/bin/perl

use strict;
use warnings;

use Config;
use FileHandle;
use Games::Sudoku::General;
use Getopt::Long;
use Pod::Usage;
use Term::ReadLine;
use Text::ParseWords;
use UNIVERSAL qw{can};

my %opt;

GetOptions (\%opt, qw{filter}) or die <<eod;

Solve Sudoku and Sudoku-like puzzles.

usage: sudokug [options]

where the only valid option at the moment is
  -filter
    suppresses the front matter in the output, making the script more
    useful as a Unix-style filter.

eod

our $VERSION = '0.007';

my $rdln = Term::ReadLine->new ('Solve Sudoku and other set-allocation puzzles');
my $OUT = $rdln->OUT || \*STDOUT;

print $OUT <<eod unless $opt{filter};
sudokug version $VERSION
based on Games::Sudoku::General version @{[Games::Sudoku::General->VERSION]}
Perl $Config{version} under $Config{osname}

Solve Sudoku and other set-allocation puzzles.

Copyright 2005, 2006, 2008 by Thomas R. Wyant, III. All rights reserved.

Enter 'help' for help, and terms of use.

eod

my $su = Games::Sudoku::General->new ();
my @handles;
my %synonym = (
    '.' => 'source',
    show => 'get',
    );

my %parm = (	# Settable parameters not attributes of the object.
    webcmd => undef,	# Command to spawn for web-based help.
);

while (1) {
    defined ($_ = _acquire_line ()) or do {
	last unless @handles;
	shift @handles;
	redo;
	};

    s/^\s+//;
    s/\s+$//;
    next unless $_;
    next if m/^#/;
    my @args = parse_line ('\s+', 0, $_);
    my $verb = lc shift @args;
    $verb = $synonym{$verb} if $synonym{$verb};
    @args = map {m/^<<(.+)/ ? _here_document ($1) : $_} @args;
    last if $verb eq 'exit';
    eval {
	if ($verb =~ m/\W/ || $verb =~ m/^_/ || $verb eq 'new') {
	    die <<eod;
Warning - Verb '$verb' is not recognized. Enter 'help' for help.
eod
	    }
	  elsif (can (__PACKAGE__, $verb)) {
	    no strict qw{refs};
	    &$verb (@args);
	    use strict qw{refs};
	    }
	  elsif (can ($su, $verb)) {
	    my $rslt = $su->$verb (@args);
	    print "$rslt\n" if defined $rslt && !ref $rslt;
	    }
	  else {
	    die <<eod;
Warning - Verb '$verb' is not recognized. Enter 'help' for help.
eod
	    }
	};
    $@ and warn $@;
    }

sub dump {
use Data::Dumper;
local $Data::Dumper::Terse = 1;
print "Dump of the current Games::Sudoku::General object:\n", Dumper ($su);
}

sub get {

=begin comment

my @rslt = $su->get (@_);
for (my $inx = 0; $inx < @_; $inx++) {
    print $rslt[$inx] =~ m/\n/s ?
	"$_[$inx]:\n$rslt[$inx]\n" :
	"$_[$inx]: $rslt[$inx]\n\n";
    }

=end comment

=cut

    foreach my $name (@_) {
	local $_  = exists $parm{$name} ? $parm{$name} : $su->get($name);
	if (!defined $_) {
	    print "$name:\n\n";
	} elsif (m/\n/s) {
	    print "$name:\n$_\n";
	} else {
	    print "$name: $_\n\n";
	}
    }

}

sub help {
    if (my $cmd = $parm{webcmd}) {
	system {$cmd} $cmd, 'http://search.cpan.org/dist/Games-Sudoku-General/';
    } else {
    my $os_specific = "_help_$^O";
    __PACKAGE__->can ($os_specific) ? __PACKAGE__->$os_specific :
    pod2usage (-verbose => 2, -exitval => 'NOEXIT',
	$_[0] && $_[0] eq 'lib' ? (-input => $INC{'Games/Sudoku/General.pm'}) : ());
    }
}

sub _help_MacOS {
print <<eod;

Normally, we would display the documentation for the sudokug
script here. But unfortunately this depends on the ability to
spawn the perldoc command, and we do not have this ability under
Mac OS 9 and earlier. You can find the same thing online at
http://search.cpan.org/~wyant/Games-Sudoku-General-@{[
    Games::Sudoku::General->VERSION]}/bin/sudokug

eod
}

sub set {
    while (@_) {
	my $name = shift;
	if (exists $parm{$name}) {
	    $parm{$name} = shift;
	} else {
	    $su->set ($name, shift);
	}
    }
}

sub solution {
my $rslt = $su->solution () || ($su->get ('status_text'));
chomp $rslt;
print "$rslt\n";
}

sub source {
my $fn = shift;
my $fh = FileHandle->new ("<$fn") or die <<eod;
Error - Failed to open input file $fn.
        $!
eod
unshift @handles, $fh;
}

sub _acquire_line {
my $prompt = shift || 'sudokug> ';
my $rslt = @handles ? $handles[0]->getline() : -t STDIN ? $rdln->readline ($prompt) : <STDIN>;
defined $rslt and chomp $rslt;
$rslt;
}

sub _here_document {
my $tag = shift;
my $rslt = '';
while (defined (my $data = _acquire_line ("$tag: "))) {
    last if $data eq $tag;
    $rslt .= $data;
    $rslt .= "\n";
    }
$rslt;
}

__END__

=head1 NAME

sudokug - Script to solve sudoku-like puzzles.

=head1 SYNOPSIS

 $ sudokug

 (front matter displayed here)

 sudokug> problem <<eod
 eod: . . . 4 . . 7 8 9
 eod: 4 . 6 . . . 1 . .
 eod: . 8 . . . . . 5 .
 eod: 2 . 4 . . 5 . . .
 eod: . 9 5 . . . . . .
 eod: . . . 9 . 2 3 4 5
 eod: . 3 . . 7 . 9 . 8
 eod: . 6 7 . . 1 . . .
 eod: 9 . . . . 8 . . 2
 eod: eod
 sudokug> solution
 1 2 3 4 5 6 7 8 9
 4 5 6 7 8 9 1 2 3
 7 8 9 1 2 3 4 5 6
 2 1 4 3 6 5 8 9 7
 3 9 5 8 4 7 2 6 1
 6 7 8 9 1 2 3 4 5
 5 3 2 6 7 4 9 1 8
 8 6 7 2 9 1 5 3 4
 9 4 1 5 3 8 6 7 2
 sudokug> solution
 No solution found
 sudokug> exit

=head1 DETAILS

This Perl script is based on the Games::Sudoku::General module. It is
capable of solving a variety of Sudoku and Sudoku-like puzzles. In
fact, it should be able to solve any puzzle that meets the following
criteria:

* The puzzle is based on allocating symbols among cells.

* Each cell contains exactly one symbol.

* A number of sets of cells are specified; each set must
contain each symbol exactly once.

* Optionally, some cells may contain initial values.

* Optionally, some cells may be restricted to a subset of
all possible symbols.

In theory, any size and topology is possible. What is B<not> possible
at the moment is the solution of puzzles requiring logic other than
that given above.

There is one command option: -filter, which suppresses the front matter
to make the script behave more like a traditional Unix filter. Commands
may be piped or redirected in (e.g.

 sudokug <commands

or

 cat commands | sudokug

) if the user so desires, with or without the -filter option.

Basically, any exposed method in Games::Sudoku::General is a command
understood by this script. Arguments to the methods are parameters
to the script commands. A few commands have been added to make life
for the user of the script easier.

Commands are parsed by Text::ParseWords, so the command name and
parameters are whitespace-delimited. Any parameter that contains
whitespace must be quoted. Either single ("'") or double ('"') quotes
will work.

Because some of the parameters (e.g. specifying a problem) involve a
large number of bytes, pseudo-"here documents" are supported. To
specify a "here document" as a parameter, specify "<<string" in place
of the parameter. The script will prompt with the string, and anything
you enter is part of that parameter, until you enter a line consisting
solely of the given string. More than one "here document" can be
specified; you will be prompted for them in left-to-right order. There
is an example of a "here document" in the L</SYNOPSIS> section.

Below is a brief description of the commands. For the attributes that
may be set or retrieved, and a more thorough (and possibly more
current) discussion of the underlying methods, see
L<Games::Sudoku::General>, or (equivalently) use the command

 sudokug> help lib

=head2 Commands

=over

=item add_set

This command adds a set to an existing topology. The arguments are the
name of the new set, and the numbers of the existing cells that are to
be members of it.

Cells are numbered from 0 in the order in which they were defined by
the topology. Typically this is row order.

=item constraints_used

This command lists the constraints used to provide the most recent
solution.

=item copy

Copy the current puzzle or solution to the clipboard. See the CLIPBOARD
SUPPORT section of the L<Games::Sudoku::General> documentation for what
you need to make this work.

=item drop_set

This command drops a set from the existing topology. The argument is the
name of the new set.

=item exit

This command does not correspond to a Games::Sudoku::General method.
It causes this script to terminate. Entering end-of-file in response
to a prompt by this script also works.

=item generate min max constraints

This command attempts to generate a puzzle in the current topology.
All arguments may be defaulted, but the defaults may not be
appropriate for all topologies. See 'help lib' for details.

=item get name ...

This command displays the values of the named attributes. You can
specify the name of more than one attribute. See L</Attributes> below
for a brief discussion of each, and L<Games::Sudoku::General> for more
details.

=item help

This command does not correspond to a Games::Sudoku::General method.
Without an argument, it gets you this documentation. If given with
the argument 'lib', that is, as

 sudokug> help lib

it gets you the POD for Games::Sudoku::General.

=item new

This command instantiates a Games::Sudoku::General object. You get one
for free when you launch this script; this command is for those cases
when it is easier to start over with a new object than to reconfigure
the one you already have. Any arguments get passed to the set() method.

=item paste

Paste a new puzzle from the clipboard. See the CLIPBOARD SUPPORT
section of the L<Games::Sudoku::General> documentation for what you
need to make this work.

=item problem string

This command specifies the problem to be solved, in the order they were
defined by the topology (typically row order). The problem string must
be specified in terms of the currently-valid symbols. Whitespace
between the symbols is always allowed, but is required only if at least
one symbol consists of more than one character. Any invalid symbol is
taken to represent an unspecified cell.

Line breaks may be given (as in the L</SYNOPSIS>), but are treated
like any other whitespace.

=item set name value ...

This command sets each named attribute to its given value. You can
specify more than one name/value pair. See L</Attributes> below
for a brief discussion of each, and L<Games::Sudoku::General> for more
details.

In addition to the attributes of the L<Games::Sudoku::General> object
itself, the following pseudo-attributes are supported, and documented
below:

* webcmd - the name of the command to spawn to bring up a web browser.

=item show name ...

This command does not correspond to a Games::Sudoku::General method,
but is just a synonym for 'get'.

=item solution

This command causes an attempt to solve the currently-set-up problem.
If a solution is found, it will be displayed. Otherwise you will get
a brief message saying what happened.

If you issue this command more than once without an intervening
'problem' command, the solution will be attempted starting where the
previous solution left off. If there are multiple solutions to a
puzzle, each 'solution' command will get you one, until you run out.

=item source filename

This command does not correspond to a Games::Sudoku::General method.
It causes subsequent commands to be taken from the given file, until
the file is completely read, or until an 'exit' command is executed.
'source' commands may be nested to the limit allowed by your system.

'.' is accepted as a synonym for 'source', but the whitespace before
the file name is still required.


=item steps

This command displays the steps taken to obtain the most recent
solution. They will be displayed as follows:

F [cell value] - this represents a forced cell. That is, the given
value is the only allowed value for the cell. The given cell is
set to that value.

N [cell value] - this represents a "numeration". That is, the given
value can only be supplied by the given cell. The given cell is set
to that value.

B [[cell cell ...] value] - "box claim". The given value is not
possible in the given cells, because they lie outside a set
intersection that must contain that value. The given value is
eliminated as a possibility for the given cells.

T naked size [[cell cell ...] value] ... - "naked tuple". The given
value is not possible for the given cell because there exists a "tuple"
(pair, triple, ...) of cells of the given size which must contain this
value, and the given cells are not in the tuple. More than one value
can be given, with a list of cells for each. The given value is
eliminated as a possibility for the given cells.

T hidden size [[cell cell ...] value] ... - "hidden tuple". The given
cells are part of a "tuple" of cells of the given size that must
contain a same-sized "tuple" of values, but the given values are not
part of the "tuple" of values that must be contained in those cells.
The given value is eliminated as a possibility for the given cell.

? [cell value] - "backtrack". If derivation of the solution reaches
a point where none of the above rules can be applied, we simply take
a guess at a legal cell value. The cell with the smallest number of
possible values is chosen for the guess. If there are more than one
such cell, the one with the smallest cell number is chosen. If at any
point a solution becomes impossible, we backtrack to the point we
took the guess, and try the next possible value.

=item unload

Display the current problem, or its current solution if it has been
solved.

=back

=head2 Attributes

Any readable attribute may be displayed with the 'get' or 'show'
commands, and any writable attribute may be set with the 'set'
command. For example:

 sudokug> set allowed_symbols <<eod
 eod: e=2,4,6,8
 eod: o=1,3,5,7,9
 eod: eod
 sudokug>

The following simply lists the attributes. Rather than repeat their
definitions, you are simply referred to L<Games::Sudoku::General>, or
(equivalently) to the

 sudokug> help lib

command.

=over

=item allowed_symbols (string)

This attribute is used to specify and name sets of allowed symbols. See
above for an example.

=item autocopy (boolean)

If true (in the Perl sense) generated problems are copied to the
clipboard.

=item brick (string, write-only)

This pseudo-attribute sets the topology, symbols, and columns for a
Sudoku puzzle involving rectangular regions rather than square ones.
The value is a comma-delimited string of three numbers representing
the horizontal and vertical dimensions of the rectangular regions, and
the size of the enclosing square.

The last number may be omitted, with the default being the product of
the first two. It is in fact deprecated, with the intent of disallowing
it in the future.

=item columns (number)

This attribute specifies the number of cells displayed on a line of
topology or solution output. It has nothing to do with the problem
itself, and no effect on problem input.

=item corresponding (number)

This pseudo-attribute sets the topology, symbols, and columns for a
Sudoku puzzle having the additional restriction that corresponding
cells in the small squares must contain different numbers. The value
is the size of the small square (i.e. the same as the value for
L</sudoku>. Also called "disjoint groups".

=item cube (string, write-only)

This pseudo-attribute sets the topology, symbols, and columns for a
Sudoku puzzle on the faces of a cube. There are three topologies
supported; two on the face of a 4 x 4 x 4 cube, plus the Dion cube.
Which one is actually generated is selected by the argument:

* a number generates a Dion cube, and specifies the size of the small
square. Specifying 3 generates a 9 x 9 x 9 Dion cube.

* 'full' generates a puzzle on all 6 faces of the cube. The sets are
the faces of the cube and the "stripes" of cells running around the
cube in all three directions. The problem is entered face-by-face;
if you imagine the cube unfolded into a Latin cross, work top-to-bottom
and left-to-right.

* 'half' generates a puzzle on the visible 3 faces of an isometric view
of a cube. The sets are halves of the face and the visible "stripes".
Imagine the visible part of the cube unfolded into the letter "L", with
the top and right faces divided horizontally, and the remaining face
divided vertically. Enter the problem working top-to-bottom and
left-to-right.

B<Caveat:> The symbols generated for a 'full' cube are 1 .. 16. The
example I have (from L<http://www.mathrec.org/sudoku/sudokucube.gif>)
uses 0 through F. If you have one of these, remember to 'set symbols'
after you 'set cube full'.

See L<Games::Sudoku::General> (or 'help lib') for a fuller discussion,
with cheesy typed diagrams.

=item debug (number)

This attribute displays debugging information. The only supported value
is 0.

=item generation_limit (number)

This attribute sets the number of times the L<generate|/item_generate>
command tries to generate a puzzle before it gives up.

=item iteration_limit (number)

This attribute sets the number of times the solution command is allowed
to use the backtrack constraint. If set to 0, there is no limit.

=item largest_set (number, read-only)

This attribute reports the size of the largest set in the current
topology.

=item latin (number, write-only)

This pseudo-attribute sets the topology to a Latin square, and the
symbol set to the requisite number of letters. The argument is the
size of the square.

=item max_tuple (number)

This attribute is the maximum tuple size considered when applying
the tuple constraint.

=item name (string)

This is just a convenient place to put an identifying string.

=item output_delimiter (string)

This attribute specifies the delimiter between cell values on output.
The default is a single space.

=item quincunx (string, write-only)

This pseudo-attribute sets the topology, symbols, and columns for a
quincunx puzzle, which is five 'normal' sudoku puzzles joined at the
corners, such as 'Samurai Sudoku' (L<http://www.samurai-sudoku.com/>).

The argument is a string of one or two integers, separated by a comma
if two are specified.

The first integer is the 'order' of the puzzle, in the same sense as for
the 'sudoku' pseudo-attribute, with 'Samurai Sudoku' being order 3.

The second integer specifies the gap between arms of the quincunx in
terms of multiples of 'order' squares. This must be the same parity (odd
or even) as the order, less than the order, and defaults to the smallest
possible value (1 for 'Samurai Sudoku').

=item rows (number)

This attribute specifies the number of lines of topology or solution
output before a blank line is inserted for readability. It has nothing
to do with the problem itself, and no effect on problem input.

=item status_text (string, read-only)

This attribute reports the message generated by the last attempted
solution.

=item status_value (number)

This attribute is the status code generated by the last attempted
solution.

=item sudoku (number, write-only)

This pseudo-attribute sets the topology, symbols, and columns for
the usual Sudoku puzzle, The value is the 'order' of the puzzle,
that is, the size of the small square. To get the usual set-up,
use

 sudokug> set sudoku 3

=item sudokux (number, write-only)

This pseudo-attribute is similar to the 'sudoku' attribute, but
the main diagonals are included.

=item symbols (string)

This attribute sets the symbols that are to be placed in the cells
of the puzzle. The individual symbols must be whitespace-delimited,
and the first symbol must be the 'canonical' representation of an
empty cell.

=item topology (string)

This attribute sets the current topology in terms of a list of the
sets to which each cell belongs.

=item webcmd (string)

This setting does not correspond to any attribute of the underlying
L<Games::Sudoku::General> object. It is the name of the command to be
used to launch a web browser. If this is set to a value which is true
in the Perl sense, it will be used by the help command to launch a web
browser and open L<http://search.cpan.org/dist/Games-Sudoku-General/>.

Mac OS X users will find 'open' a useful value; Windows users will find
'start' useful. All others should probably use the name of your
preferred browser.

=back

=head1 MODIFICATIONS

 0.001 T. R. Wyant
   Initial release
 0.003 T. R. Wyant
   Documented methods and attributes added
   since 0.001.
 0.004 T. R. Wyant - Documented new use of cube attribute.
 0.005 T. R. Wyant - Documented new methods and attributes.
 0.006 T. R. Wyant
   Corrected spelling.
   Allowed input to be redirected or piped in.
   Added -filter option.
   Document new methods and attributes.
 0.007 T. R. Wyant
   Added the 'webcmd' pseudo-attribute.
   Small documentation tweaks.
   Fix the 'source' command.

=head1 AUTHOR

Thomas R. Wyant, III (F<wyant at cpan dot org>)

=head1 COPYRIGHT

Copyright 2005, 2006, 2008 by Thomas R. Wyant, III
(F<wyant at cpan dot org>). All rights reserved.

This module is free software; you can use it, redistribute it
and/or modify it under the same terms as Perl itself.