For a friend's birthday, I wrote him a puzzle letter. to make sure I had it right, I wrote a script that un-puzzled it (it's a simple & silly little encoding).

Today, I decided to send it to someone as my code sample (Yes, I'm job-hunting!) and decided they needed a sample message to decode. Well, I didn't feel like composing them a message by hand, so I wrote a script that encodes, as well. Both are included, but first, the message I sent them. Feel free to try to decode it before looking at the source included. (the sample would be a lot cooler if I had a decently-sized dictionary with only acceptably common english words in it -- say a 10-year-old's reading level. Preferably unsorted.)

---

Jab uang asaddle hat. Kafta pacation xenoblast abactor haab labeler sabaigrass. Abampere ice labeller tableau. Abashed habenal oaritic vakass abalienate kaferita?

Sabadilla. Abarthrosis laang quadratically. Abash fabulosity packery wader. Abdominothoracic qintar wadmaker.

---

so. file 1, the de-puzzler: (reads from STDIN)

#!/usr/bin/perl

use strict;

my @fibo = (0, 1);

my @text;
push @text, split /\s+/, $_ while <STDIN>;

sub modword {
  my $word = pop;

  return (( ($fibo[-1]-1) % length($word) )+1)
}


foreach my $word (@text) {
  my $space = ' ' if $word =~ /[.!?]/;
  $word =~ s/\W+//g;
  print "\n" and next unless $word;

  print substr($word, modword($word) - 1, 1), $space;
  @fibo = (modword($word), $fibo[-2] + modword($word));
#  print "\t($word $fibo[0] $fibo[1])\n";

  }

print "\n\n\n";
[download]

and file 2, the puzzle maker: (reads from the command line)

#!/usr/bin/perl

use strict;

my $dloc = '/usr/share/dict/words';

my @fibo = (0, 0);

my $message = lc(join ' ', @ARGV);
my @message = split /([.!?]?\s*)/, $message;

my @out;
my $new_sentence = 1;
my $lffl = 'a';
my %words;

open (DICT, "<$dloc") or die "no dictionary at $dloc";

sub get_new_word {
  my ($target_letter, $target_number) = @_;
  $target_number ||= 1;    # seeds our fibonacci sequence

  my $sought = 0;
  my $found = 0;
  my $candidate;
  my $n;

  while (not $found) {
    $candidate = <DICT>;
    unless ($candidate) {
      die "never found word for $target_letter at $target_number" if $
+sought;
      $sought = 1;
      seek(DICT, 0, 0) or die "um. no seeky.";
      next;
      }
    chomp($candidate);
    next if ( (length($candidate) < 3)
           or ((not $sought) and ($candidate lt $lffl))
           or ($candidate =~ /[A-Z]/)
           or (defined $words{$candidate})            );
    $n = (($target_number-1) % length($candidate));
    $found++ if ( ( substr($candidate,$n,1) eq $target_letter)
#             and ( print "(pass $sought): $candidate ? ('y' to accept
+)"
#                   and (<STDIN> =~ /^y/i))
                );
    }
  $lffl = chr(ord($candidate)+length($candidate));
  $words{$candidate} = 1;
  return ($candidate, ($n+1));

}


for my $letter (@message) {
  if ($letter =~ m/[.!?]/) {
    push @out, $letter . "\n ";
    $new_sentence = 1;
    }
  elsif (($letter =~ m/\s+/) and @out) {
    push @out, '. ';
    $new_sentence = 1;
    }
  elsif ($letter =~ m/[a-zA-Z]/) {
    my ($outword, $newf) = get_new_word($letter, $fibo[-2]+$fibo[-1]);
    if ($new_sentence) {
       $outword = ucfirst($outword);
       $new_sentence = 0;
      }
    push @out, ' '.$outword;
    @fibo = ($fibo[-1], $newf);
    }
  }
 
print join '', "\n  ",@out,"\n\n";
[download]

... and that's what I did with my day.