kenny

   1 #!/usr/bin/perl -w
   2 #
   3 # kenny.pl -- translate from and to KennySpeak
   4 #
   5 # $Revision: 1.7 $
   6 #
   7 # Licensed unter the Artistic License:
   8 # http://www.perl.com/language/misc/Artistic.html
   9 #
  10 # (C) 2001,2002 by Christian Garbs <mitch@cgarbs.de>, http://www.cgarbs.de
  11 #                  Alan Eldridge <alane@geeksrus.net>
  12 #
  13 # KennySpeak invented by Kohan Ikin <syneryder@namesuppressed.com>
  14 #                        http://www.namesuppressed.com/kenny/
  15
  16 #
  17 # $Id: kenny.pl,v 1.7 2002/01/06 22:09:52 mitch Exp $
  18 #
  19
  20 use strict;
  21
  22 #
  23 # This is Perl POD documentation.
  24 # You can generate a nice manpage with "pod2man kenny.pl > kenny.man".
  25 # Or have a look at "perldoc perlpod" for other options
  26 #
  27
  28 =head1 NAME
  29
  30 kenny.pl -- translate from and to KennySpeak
  31
  32 =head1 SYNOPSIS
  33
  34 B<kenny.pl>
  35 S<[ B<-h> ]>
  36 S<[ B<-u> ]>
  37 S<[ B<-k> | B<-d> ]>
  38 S<[ I<file1> ] [ I<file2> ] ...>
  39
  40 =head1 OVERVIEW
  41
  42 kenny.pl translates a given text from or to B<KennySpeak>. KennySpeak
  43 looks like this:
  44
  45     "Ppfmfp ppmffm mfmppfmpm, fmpmfpmppffm'fpmmpp
  46      pmpmffpmfpmfmppmpm Pmpmppppppppffm!"
  47
  48 =head1 DESCRIPTION
  49
  50 kenny.pl will read the given filenames, translate them and print the
  51 results on stdout. If you don't give a filename, stdin is used. A F<->
  52 as a filename means stdin.
  53
  54 Without any parameters, kenny.pl will look at the first line of input
  55 and guess which way you want to translate. If kenny.pl guesses wrong,
  56 you must select the translation mode using the B<-k> or B<-d> switch.
  57
  58 =head2 Switches
  59
  60 =over 5
  61
  62 =item B<-h>
  63
  64 This will print a short notice and a quick summary of the available
  65 switches.
  66
  67 =item B<-u>
  68
  69 This will convert German umlauts to Ae, Oe, Ue, ae, oe, ue and ss
  70 so that they can be kennyfied correctly.
  71
  72 =item B<-k>
  73
  74 Kennyfy. This forces the input to be translated into KennySpeak.
  75
  76 =item B<-d>
  77
  78 Dekennyfy. This forces the input to be translated back from
  79 KennySpeak.
  80
  81 =back
  82
  83 =head1 VERSION
  84
  85 This is $Revision: 1.7 $.
  86
  87 =head1 BUGS
  88
  89 The B<-u> switch might not work for charsets other than Latin-1. You
  90 might try to convert the kenny.pl script using B<recode> to change it
  91 from Latin-1 to your preferred charset.
  92
  93 =head1 CREDITS
  94
  95 kenny.pl was written by B<Christian Garbs>. Look on his homepage for
  96 newer versions of kenny.pl. Bug reports or comments about the program
  97 should be sent to him:
  98        Christian Garbs <F<mitch@cgarbs.de>>
  99        F<http://www.cgarbs.de/weird.en.html>
 100
 101 KennySpeak was invented by B<Kohan Ikin>. See his homepage for an
 102 online version of the original B<KennyTranslator>:
 103        Kohan Ikin <F<syneryder@namesuppressed.com>>
 104        F<http://www.namesuppressed.com/kenny/>
 105
 106 Alan Eldridge <F<alane@geeksrus.net>> patched in a signal handler to
 107 print an appropriate message when kenny.pl is killed.
 108
 109 =head1 COPYRIGHT
 110
 111 kenny.pl is licensed unter the B<Artistic License> which can be found
 112 at F<http://www.perl.com/language/misc/Artistic.html>. This license
 113 has been chosen for keeping compatibility with the original KennySpeak
 114 format.
 115
 116 =cut
 117
 118
 119
 120 ######################################################################
 121 #
 122 # CHANGELOG
 123 #
 124 # $Log: kenny.pl,v $
 125 # Revision 1.7  2002/01/06 22:09:52  mitch
 126 # Included patch by Alan Eldridge <alane@geeksrus.net>
 127 # to show a message when kenny.pl is killed.
 128 #
 129 # Revision 1.6  2001/07/20 19:04:49  mitch
 130 # Removed warnings with Perl 5.6.
 131 # Thanks go to Alan Eldridge <alane@geeksrus.net>
 132 #
 133 # Revision 1.5  2001/07/15 10:27:57  mitch
 134 # Included notice about -u and charsets other than Latin-1.
 135 #
 136 # Revision 1.4  2001/07/14 13:16:30  mitch
 137 # Initial release.
 138 #
 139 #
 140 #
 141 ######################################################################
 142
 143
 144
 145 #
 146 # finally{}, the source code!
 147 #
 148
 149
 150
 151 ##### Declaration of function prototypes
 152
 153 sub generateKenny();
 154 sub generateDeKenny($);
 155 sub guessDialect($);
 156 sub translate($);
 157 sub addGermanUmlauts($);
 158 sub printHelp();
 159 sub theyKilledKenny();
 160
 161
 162
 163 ##### Default values for various option:
 164
 165 my $dialect = 0;  # Translate from or to KennySpeak?
 166                   # 0=guess, 1=encode, 2=decode
 167
 168 my $umlauts = 0;  # Convert German Umlauts before translation?
 169                   # TRUE=ÄÖÜäöüß => Ae, Oe, Ue, ae, ou, ue, ss
 170
 171
 172
 173 ##### The KennySpeak translation tables:
 174
 175 my $kenny   = generateKenny();          # encoding table
 176 my $dekenny = generateDeKenny($kenny);  # decoding table
 177
 178
 179
 180 ##### Install signal handlers
 181
 182 $SIG{HUP} = \&theyKilledKenny;
 183 $SIG{INT} = \&theyKilledKenny;
 184 $SIG{QUIT} = \&theyKilledKenny;
 185 $SIG{TERM} = \&theyKilledKenny;
 186
 187
 188
 189 ##### Parse commandline arguments
 190
 191 # "-h" switch (print help):
 192
 193 if (grep /^-h$/, @ARGV) {
 194     printHelp();
 195     exit 0;
 196 }
 197
 198 # "-u" switch (convert German umlauts):
 199
 200 if ((defined $ARGV[0]) && ($ARGV[0] eq "-u")) {
 201     $umlauts = 1;
 202     shift @ARGV;
 203 } elsif ((defined $ARGV[1]) && ($ARGV[1] eq "-u")) {
 204     $umlauts = 1;
 205     splice @ARGV, 1, 1;
 206 }
 207
 208 # "-k" and "-d" switch (force encoding/decoding):
 209
 210 if (defined $ARGV[0]) {
 211     if ($ARGV[0] eq "-k") {
 212         $dialect = 1;
 213         shift @ARGV;
 214     } elsif ($ARGV[0] eq "-d") {
 215         $dialect = 2;
 216         shift @ARGV;
 217     }
 218 }
 219
 220
 221
 222 ##### add German umlauts to encoding if desired:
 223
 224 if ($umlauts) {
 225     addGermanUmlauts($kenny);
 226 }
 227
 228
 229
 230 ##### Process the given input files (or stdin of none given)
 231
 232 while (my $line=<>) {
 233     chomp $line;
 234     $dialect = guessDialect($line) unless $dialect;
 235     $line = translate($line);
 236     print "$line\n";
 237 }
 238
 239
 240
 241 ##### That's all, folks!
 242
 243 exit 0;
 244
 245
 246 ##### Signal handler, if we're kill(1)ed
 247
 248 sub theyKilledKenny()
 249 {
 250     print "Oh my God! They killed Kenny! You bastards!\n";
 251     exit 0;
 252 }
 253
 254
 255
 256 ##### Guess whether input is already kennyfied:
 257
 258 sub guessDialect($)
 259 {
 260     my $line = shift;
 261     $line =~ tr/a-zA-Z//cd;
 262     if (($line =~ tr/mfpMFP//c) > 0) {
 263         return 1;
 264     } else {
 265         return 2;
 266     }
 267 }
 268
 269
 270
 271 ##### Encode/decode a given line
 272
 273 sub translate($)
 274 {
 275     my $in  = shift;
 276     my $out = "";
 277     if ($dialect == 1)
 278     {
 279         $out .= exists $kenny->{$1} ? $kenny->{$1} : $1 while ($in =~ s/^(.)//);
 280     } else {
 281         my @chars = split //, $in;
 282         while (@chars) {
 283             if ((@chars > 2) and (exists $dekenny->{$chars[0]}->{$chars[1]}->{$chars[2]})) {
 284                 $out .= $dekenny->{$chars[0]}->{$chars[1]}->{$chars[2]};
 285                 shift @chars;
 286                 shift @chars;
 287                 shift @chars;
 288             } else {
 289                 $out .= shift @chars;
 290             }
 291         }
 292     }
 293     return $out;
 294 }
 295
 296
 297
 298 ##### Generate KennySpeak encoding table
 299
 300 sub generateKenny()
 301 {
 302     my %kenny;
 303
 304     # lower case characters
 305
 306     my ($a, $b, $c) = (0,0,0);
 307     for my $char ("a".."z") {
 308         my $foo = $a.$b.$c;
 309         $foo =~ tr/012/mpf/;
 310         $kenny{$char} = $foo;
 311         $c++;
 312         if ($c == 3) {
 313             $c=0;
 314             $b++;
 315             if ($b == 3) {
 316                 $b=0;
 317                 $a++;
 318             }
 319         }
 320     }
 321
 322     # upper case characters
 323
 324     map { $kenny{uc $_} = ucfirst $kenny{$_} } keys %kenny;
 325
 326     return \%kenny;
 327 }
 328
 329
 330
 331 ##### Generate KennySpeak decoding table
 332
 333 sub generateDeKenny($)
 334 {
 335     my %dekenny;
 336     my $kenny = $_[0];
 337     foreach my $key (keys %{$kenny})
 338     {
 339         my ($a, $b, $c) = split //, $kenny->{$key};
 340         if (! exists $dekenny{$a}) {
 341             $dekenny{$a} = {};
 342         }
 343         if (! exists $dekenny{$a}->{$b}) {
 344             $dekenny{$a}->{$b} = {};
 345         }
 346         $dekenny{$a}->{$b}->{$c} = $key;
 347     }
 348
 349     return \%dekenny;
 350 }
 351
 352
 353
 354 ##### Add German Umlaut conversion to KennySpeak encoding table
 355
 356 sub addGermanUmlauts($)
 357 {
 358     my $kenny = $_[0];
 359     $kenny->{"ä"} = $kenny->{"a"} . $kenny->{"e"};
 360     $kenny->{"ö"} = $kenny->{"o"} . $kenny->{"e"};
 361     $kenny->{"ü"} = $kenny->{"u"} . $kenny->{"e"};
 362     $kenny->{"Ä"} = $kenny->{"A"} . $kenny->{"e"};
 363     $kenny->{"Ö"} = $kenny->{"O"} . $kenny->{"e"};
 364     $kenny->{"Ü"} = $kenny->{"U"} . $kenny->{"e"};
 365     $kenny->{"ß"} = $kenny->{"s"} x 2;
 366 }
 367
 368
 369
 370 ##### Print short help message
 371
 372 sub printHelp()
 373 {
 374     print <<'EOF';
 375 kenny.pl $Revision: 1.7 $ by Christian Garbs <mitch@cgarbs.de>
 376 Use "pod2man kenny.pl > kenny.man" to generate the man page.
 377 Usage: kenny.pl [ -h ] [ -u ] [ -k | -d ] [ file1 ] [ file2 ] ...
 378 -h : print this help message
 379 -u : convert German umlauts before translation
 380 -k : force encoding to KennySpeak
 381 -d : force decoding from KennySpeak
 382 EOF
 383     ;
 384 }