The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

package Acme::LOLCAT;

use strict;
use warnings;

use 5.006001; # 'our' requires a "more recent" perl.

use Exporter;

our @ISA = qw/Exporter/;
our @EXPORT = qw/translate/;

our $VERSION = '0.0.5';

my %repl = (
   what     => [qw/wut whut/],   'you\b'   => [qw/yu yous yoo u/],
   cture    => 'kshur',          unless    => 'unles',
   'the\b'  => 'teh',            more      => 'moar',
   my       => [qw/muh mah/],    are       => [qw/r is ar/],
   eese     => 'eez',            ph        => 'f',
   'as\b'   => 'az',             seriously => 'srsly',
   'er\b'   => 'r',              sion      => 'shun',
   just     => 'jus',            'ose\b'   => 'oze',
   eady     => 'eddy',           'ome?\b'  => 'um',
   'of\b'   => [qw/of ov of/],   'uestion' => 'wesjun',
   want     => 'wants',          'ead\b'   => 'edd',
   ucke     => [qw/ukki ukke/],  sion      => 'shun',
   eak      => 'ekk',            age       => 'uj',
   like     => [qw/likes liek/], love      => [qw/loves lub lubs luv/],
   '\bis\b' => ['ar teh','ar'],  'nd\b'   => 'n',
   who      => 'hoo',            q(')      => q(),
   'ese\b'  => 'eez',            outh      => 'owf',
   scio     => 'shu',            esque     => 'esk',
   ture     => 'chur',           '\btoo?\b'=> [qw/to t 2 to t/],
   tious    => 'shus',           'sure\b'  => 'shur',
   'tty\b'  => 'tteh',           were      => 'was',
   'ok\b'   => [ qw/'k kay/ ],   '\ba\b'   => q(),
   ym       => 'im',             'thy\b'   => 'fee',
   '\wly\w' => 'li',             'que\w'   => 'kwe',
   oth      => 'udd',            ease      => 'eez',
   'ing\b'  => [qw/in ins ng ing/],
   'have'   => ['has', 'hav', 'haz a'],
   your     => [ qw/yur ur yore yoar/ ],
   'ove\b'  => [ qw/oov ove uuv uv oove/ ],
   for      => [ qw/for 4 fr fur for foar/ ],
   thank    => [ qw/fank tank thx thnx/ ],
   good     => [ qw/gud goed guud gude gewd/ ],
   really   => [ qw/rly rily rilly rilley/ ],
   world    => [ qw/wurrld whirld wurld wrld/ ],
   q(i'?m\b)     => 'im',
   '(?!e)ight'   => 'ite',
   '(?!ues)tion' => 'shun',
   q(you'?re)    => [ qw/yore yr/ ],
   '\boh\b(?!.*hai)'  => [qw/o ohs/],
   'can\si\s(?:ple(?:a|e)(?:s|z)e?)?\s?have\sa' => 'i can has',
   '(?:hello|\bhi\b|\bhey\b|howdy|\byo\b),?'    => 'oh hai,',
   '(?:god|allah|buddah?|diety)'                => 'ceiling cat',
);

sub translate {
  my $phrase = lc shift;

  $phrase =~ s{
                $_
              }
              {
                ref $repl{ $_ } eq 'ARRAY'
                  ? $repl{ $_ }->[ rand( $#{ $repl{ $_ } } + 1 ) ]
                  : $repl{ $_ }
              }gex
              for keys %repl;

  $phrase =~ s/\s{2,}/ /g;
  $phrase =~ s/teh teh/teh/g; # meh, it happens sometimes.
  if( int rand 10 == 2 ){ $phrase .= '.  kthxbye!' }
  if( int rand 10 == 1 ){ $phrase .= '.  kthx.' }
  $phrase =~ s/(\?|!|,|\.)\./$1/;
  return uc $phrase;
}

# LOLCAT->can('has') # Thanks BOBTFISH :)
sub has {}

# LOLCAT->can('haz') # why not?
sub haz {}

1;

=pod

=head1 NAME

Acme::LOLCAT - SPEEK LIEK A LOLCATZ

=head1 VERSHON

Version 0.0.5

=head1 HOEW 2 YOOS IT

This module translates english sentences into "LOLCAT".  For more
information on LOLCAT, please consult wikipedia:
(L<http://en.wikipedia.org/wiki/Lolcat>)

  use strict;
  use warnings;

  use Acme::LOLCAT;

  my $phrase = translate( "You too can speak like a lolcat!" );

  print $phrase;

  Output:

  YU 2 CAN SPEEK LIEK LOLCAT! KTHX.

=head1 ECKSPORTS

=over

=item translate

Exports the function "translate" into your namespace.

Pass translate some text, translate returns some LOLCATed text.

If you prefer to call translate() with the fully qualified name,
and don't want translate() to be exported into your namespace:

  use Acme::LOLCAT ();

  # ...

  my $translated_text
    = Acme::LOLCAT::Translate( $orginal_text );

=back

=head1 IM IN UR NAMESPAEC AND I CAN HAZ

=over

=item has

Every LOLCAT->can('has')

=item haz

I CAN HAZ TOO

=back

=head1 DEMONSTRASHUN TO SEEZ IT WERK IN REEL TIEM

I've created a quick and dirty ajax powered web page to show how easy
Acme:LOLCAT is to use.  Point your web browser here:

L<http://www.kentcowgill.org/lolcat.html>

The backend CGI that accepts and responds to the ajax requests is very
simple:

  #!/usr/bin/perl

  use strict;
  use warnings;

  use CGI qw/:standard/;
  use Acme::LOLCAT;

  print header( -type => 'text/html'),
        translate( param( 'english' );

... where 'english' is the name of the textarea where input is accepted.

=head1 DEPENDNSEEZ

Requires C<Exporter>.

=head1 GUY DAT ROTE IT

Kent Cowgill C<kent@c2group.net>, L<http://www.kentcowgill.org>

=head1 REKWESTZ AN BUGZ

Please report any requests, suggestions, or bugs via the RT bug tracking
system at L<http://rt.cpan.org>.

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Acme::LOLCAT> is the RT queue
to Acme::LOLCAT. Please check to see if your bug has already been reported.

=head1 AKNAHLUJMENTZ

Thanks to Dyana Wu for the patch adding several variations and additions
to the LOLCAT vocabulary.

=head1 COPEERITE AN LISUNZ

Copyright (c) 2007 by Kent Cowgill

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

See L<http://www.perl.com/perl/misc/Artistic.html>

=cut