#! /usr/bin/perl -w
#
# Tripphrase generator
# http://worrydream.com/tripphrase
#
# by Bret Victor
# http://worrydream.com
#
# This software is licensed under the terms of the open source MIT license.
# http://www.opensource.org/licenses/mit-license.php
#
# The word lists are from Princeton's WordNet project.
# http://wordnet.princeton.edu/
#
use strict;
use CGI qw(:standard escapeHTML);
use Digest::MD5 qw(md5_hex);
sub main {
my $password = param('q') || $ARGV[0] || "";
my $digest = md5_hex("BV$password");
my @indexes = map { hex } ($digest =~ /..../g);
my $template = templateForIndex(shift(@indexes));
my @types = (split / /, $template);
my @phraseWords = map { wordForIndexAndType(shift(@indexes), $_) } @types;
my $phrase = join " ", @phraseWords;
print header('text/plain'), "($phrase)";
}
#---------------------------------------------
# templates
my @templates = (
"verb article adj noun",
"article adj adj noun",
"article adv adj noun",
"adv verb article noun",
);
sub templateForIndex {
my ($index) = @_;
my $wrappedIndex = $index % @templates;
return $templates[$wrappedIndex];
}
#---------------------------------------------
# words
my %wordsByType;
my @wordTypes = qw/noun verb adj adv article/;
my %wordTypes;
$wordTypes{$_} = 1 foreach (@wordTypes);
sub wordForIndexAndType {
my ($index, $type) = @_;
my $words = wordsForType($type);
return $type unless $words;
my $wrappedIndex = $index % @$words;
my $word = $words->[$wrappedIndex];
chomp($word);
return $word;
}
sub isWordTypeValid {
my ($type) = @_;
return exists $wordTypes{$type};
}
sub wordsForType {
my ($type) = @_;
return $wordsByType{$type} if exists $wordsByType{$type};
return "" unless isWordTypeValid($type);
createWordListForType($type) unless -f "$type.txt";
open WORDS, "$type.txt";
my @words = <WORDS>;
$wordsByType{$type} = \@words;
close WORDS;
return $wordsByType{$type};
}
sub createWordListForType {
my ($type) = @_;
open WORDS, ">$type.txt";
open INDEX, "index.$type";
foreach (<INDEX>) {
next unless /^[a-z]/;
my ($word) = /^(\S+)/;
next if length($word) < 2;
next if $word =~ /_/;
print WORDS "$word\n";
}
close INDEX;
close WORDS;
}
#---------------------------------------------
# go
main();