So hilariously accurate

Today's xkcd really made me smile, if only because it's so very very true

Updated word-search solver in perl

 I've been busy, updating my word search solver that I wrote about a month ago now, and have managed to make several improvements.  Once again I've uploaded the code to perlmonks, but this time I've also posted it here (finally figured out that block quote will work nicely in laying out code).  In essence the code remains the same, with just a few added features, including:

• The puzzle is now loaded from a text file (an example is given below).
• The program now accepts command line arguments to give help, version information and to select the file to use.
• A slightly greater list of internal commands, for a full list type #help at the programs prompt.
  

An example of a Puzzle file:
In order to actually use the program now, you have to supply it with a file containing the puzzle to be searched.  This is simple to set out, each letter of the puzzle is put in the file with a single space between columns and a new line between rows (see the example below):

r e l a e d b y
e s c r e e n t 
m i o e i s h l 
i s l a t e r a 
t n u r c n n u 
r g m u a i h s 
o u b m t h a a 
m e o a n c c c

The program expects you to supply a file from the command line (using the -f switch) when you start, but will prompt you for one if you forget it.

The Program itself:

#!/usr/bin/perl
# wordSearchSolve.pl
# Program to solve a word search puzzle semi-automatically.
#
# With thanks to toolic, Limbic~Region and Count Zero of perlmonks.org for 
# suggesting several improvements.
#
# Christopher Dykes (2009-10-19) - (v2.2)

#Enable the following packages:
use strict;  #Enable strict syntax checking
use warnings;  #Enable diagnostic warnings
use Getopt::Long; #Enable command line option parsing

#Define constants:
use constant 'VERSION' => 2.2;

#Declare local variables:
my($i, $j, $k, $word, $found); #Various control variables
my $done = 0;   #Whether we're finished or not
my(@start, @end);  #The start and end locations of the word
my @puzzle;   #The puzzle to be searched

#Parse command line options:
my($file, $help, $version); #Available command line options
GetOptions('file=s' => \$file, 'help' => \$help, 'version' => \$version);

&help    if($help); #Display the help message
&version   if($version); #Display the version details
@puzzle = @{&puzzleGet($file)} if($file); #Open our file if we have one

exit if($help || $version);

if(!$file) #Get a file from the user if they haven't supplied one
{
 my $check = " ";
 while($check ne "y")
 {
  print "WARNING: No File supplied, supply now? (y/n) ";
  $check = lc();
  chomp $check;
  
  exit if($check eq "n");
 }
 print "Enter file name:\t"; $file = ;
 @puzzle = @{&puzzleGet($file)};
}

#Display the header:
print "Wordsearch Solver (v", VERSION, "):\n\n";
print "Enter the term to search for, enter '#quit' to exit ";
print "and #help for assistance\n\n";

#Allow the user to search:
while(!$done)
{
 print "> "; chomp($word = ); #Get the word from the user
 my @chars = split(//,  $word);
 my @words = split(/ /, $word);

 if($chars[0] eq "#")
 {
  $done++  if($word eq "#quit");
  &internalHelp if($word eq "#help");
  if($words[0] eq "#newpuzzle")
  {
   @puzzle = @{&getPuzzle($words[1])};
  }
 }
 else
 {
  print $word, "\t= ";
  my @word = split(//, $word);

  for($i = 0, $found = 0; $i < @puzzle && !$found; $i++) #Row loop
  {
   for($j = 0; $j < @puzzle && !$found; $j++) #Col loop
   {
    for($k = 0; $k < 8 && !$found; $k++) #Dir loop
    {
     my @gen = ("");
     $found = &search($k, $i, $j, \@puzzle, \@word, @gen);
    }
   }
  }
  print "($i,$j) - ($end[0],$end[1])\n" if($found);
  print "NO RESULT\n" if(!$found);
 }
}

#Subroutines begin here:
sub search #Performs a recursive search across the puzzle
{
 #Declare local variables:
 my($dir, $row, $col, $puzRef, $wrdRef, @gen) = @_;
 my @puzzle = @{$puzRef};
 my @word   = @{$wrdRef};

 ($end[0], $end[1]) = (($row + 1), ($col + 1)); #Set our end location

 return 0 if($puzzle[$row][$col] ne $word[$#gen]);
 return 1 if($#word == $#gen);

 #Decide what to do:
 $row++ if(($dir == 0 || $dir == 4 || $dir == 5) && $row < $#puzzle);
 $row-- if(($dir == 1 || $dir == 6 || $dir == 7) && $row > 0);
 $col++ if(($dir == 3 || $dir == 5 || $dir == 7) && $col < $#puzzle);
 $col-- if(($dir == 2 || $dir == 4 || $dir == 6) && $col > 0);
 
 #Do the useful stuff:
 push(@gen, $puzzle[$row][$col]);
 return 1 if(&search($dir, $row, $col, \@puzzle, \@word, @gen)) || return 0;
}
sub puzzleGet
{
 my @puzzle;

 open(FILEIN, "$_[0]") || die("Couldn't open file $_[0]");

 while()
 {
  chomp($_);
  my @line = split(/ /, $_);
  push(@puzzle, \@line);
 }

 return \@puzzle;
}
sub help
{
 print "Usage: wordSearchSolve.pl [OPTION] -f [FILENAME]\n";
 print "A program to solve a word search automatically\n\n";
 print "-f\t--file\t\tLoad the puzzle from this file\n";
 print "-h\t--help\t\tDisplay this message\n";
 print "-v\t--version\tDisplay version information\n\n";
 print "Report bugs to .\n";
}
sub version
{
 print "wordSearchSolve (v", VERSION, ")\n";
 print "Copyright (C) 2009 Christopher Dykes.\n";
 print "License GPLv3+: GNU GPL Version 3 or later \n";
 print "This is free software: you are free to change and redistribute it.\n";
 print "There is NO WARRANTY, to the extent permitted by law.\n\n";
 print "Written by Christopher Dykes.\n";
 print "With thanks to toolic, Limbic~Region and Count Zero of perlmonks.org\n";
 print "for suggesting several improvements.\n";
}
sub internalHelp
{
 print "\nAvailable commands are:\n";
 print "\t#help\t\tDisplay this message\n";
 print "\t#newpuzzle\tLoad a new puzzle from a file\n";
 print "\t#quit\t\tExit the program\n";
 print "\n";
}

download here