File Coverage

blib/lib/Acme/LOLCAT.pm
Criterion Covered Total %
statement 23 26 88.4
branch 5 6 83.3
condition n/a
subroutine 5 7 71.4
pod 3 3 100.0
total 36 42 85.7


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package Acme::LOLCAT;
4              
5 2     2   23827 use strict;
  2         5  
  2         143  
6 2     2   11 use warnings;
  2         3  
  2         57  
7              
8 2     2   40 use 5.006001; # 'our' requires a "more recent" perl.
  2         11  
  2         85  
9              
10 2     2   10 use Exporter;
  2         4  
  2         1246  
11              
12             our @ISA = qw/Exporter/;
13             our @EXPORT = qw/translate/;
14              
15             our $VERSION = '0.0.5';
16              
17             my %repl = (
18             what => [qw/wut whut/], 'you\b' => [qw/yu yous yoo u/],
19             cture => 'kshur', unless => 'unles',
20             'the\b' => 'teh', more => 'moar',
21             my => [qw/muh mah/], are => [qw/r is ar/],
22             eese => 'eez', ph => 'f',
23             'as\b' => 'az', seriously => 'srsly',
24             'er\b' => 'r', sion => 'shun',
25             just => 'jus', 'ose\b' => 'oze',
26             eady => 'eddy', 'ome?\b' => 'um',
27             'of\b' => [qw/of ov of/], 'uestion' => 'wesjun',
28             want => 'wants', 'ead\b' => 'edd',
29             ucke => [qw/ukki ukke/], sion => 'shun',
30             eak => 'ekk', age => 'uj',
31             like => [qw/likes liek/], love => [qw/loves lub lubs luv/],
32             '\bis\b' => ['ar teh','ar'], 'nd\b' => 'n',
33             who => 'hoo', q(') => q(),
34             'ese\b' => 'eez', outh => 'owf',
35             scio => 'shu', esque => 'esk',
36             ture => 'chur', '\btoo?\b'=> [qw/to t 2 to t/],
37             tious => 'shus', 'sure\b' => 'shur',
38             'tty\b' => 'tteh', were => 'was',
39             'ok\b' => [ qw/'k kay/ ], '\ba\b' => q(),
40             ym => 'im', 'thy\b' => 'fee',
41             '\wly\w' => 'li', 'que\w' => 'kwe',
42             oth => 'udd', ease => 'eez',
43             'ing\b' => [qw/in ins ng ing/],
44             'have' => ['has', 'hav', 'haz a'],
45             your => [ qw/yur ur yore yoar/ ],
46             'ove\b' => [ qw/oov ove uuv uv oove/ ],
47             for => [ qw/for 4 fr fur for foar/ ],
48             thank => [ qw/fank tank thx thnx/ ],
49             good => [ qw/gud goed guud gude gewd/ ],
50             really => [ qw/rly rily rilly rilley/ ],
51             world => [ qw/wurrld whirld wurld wrld/ ],
52             q(i'?m\b) => 'im',
53             '(?!e)ight' => 'ite',
54             '(?!ues)tion' => 'shun',
55             q(you'?re) => [ qw/yore yr/ ],
56             '\boh\b(?!.*hai)' => [qw/o ohs/],
57             'can\si\s(?:ple(?:a|e)(?:s|z)e?)?\s?have\sa' => 'i can has',
58             '(?:hello|\bhi\b|\bhey\b|howdy|\byo\b),?' => 'oh hai,',
59             '(?:god|allah|buddah?|diety)' => 'ceiling cat',
60             );
61              
62             sub translate {
63 10     10 1 612 my $phrase = lc shift;
64              
65             $phrase =~ s{
66             $_
67             }
68             {
69 21         2484 ref $repl{ $_ } eq 'ARRAY'
70 53 100       7022 ? $repl{ $_ }->[ rand( $#{ $repl{ $_ } } + 1 ) ]
71             : $repl{ $_ }
72             }gex
73 10         2044 for keys %repl;
74              
75 10         326 $phrase =~ s/\s{2,}/ /g;
76 10         25 $phrase =~ s/teh teh/teh/g; # meh, it happens sometimes.
77 10 50       261 if( int rand 10 == 2 ){ $phrase .= '. kthxbye!' }
  0         0  
78 10 100       68 if( int rand 10 == 1 ){ $phrase .= '. kthx.' }
  3         7  
79 10         32 $phrase =~ s/(\?|!|,|\.)\./$1/;
80 10         809 return uc $phrase;
81             }
82              
83             # LOLCAT->can('has') # Thanks BOBTFISH :)
84 0     0 1   sub has {}
85              
86             # LOLCAT->can('haz') # why not?
87 0     0 1   sub haz {}
88              
89             1;
90              
91             =pod
92              
93             =head1 NAME
94              
95             Acme::LOLCAT - SPEEK LIEK A LOLCATZ
96              
97             =head1 VERSHON
98              
99             Version 0.0.5
100              
101             =head1 HOEW 2 YOOS IT
102              
103             This module translates english sentences into "LOLCAT". For more
104             information on LOLCAT, please consult wikipedia:
105             (L)
106              
107             use strict;
108             use warnings;
109              
110             use Acme::LOLCAT;
111              
112             my $phrase = translate( "You too can speak like a lolcat!" );
113              
114             print $phrase;
115              
116             Output:
117              
118             YU 2 CAN SPEEK LIEK LOLCAT! KTHX.
119              
120             =head1 ECKSPORTS
121              
122             =over
123              
124             =item translate
125              
126             Exports the function "translate" into your namespace.
127              
128             Pass translate some text, translate returns some LOLCATed text.
129              
130             If you prefer to call translate() with the fully qualified name,
131             and don't want translate() to be exported into your namespace:
132              
133             use Acme::LOLCAT ();
134              
135             # ...
136              
137             my $translated_text
138             = Acme::LOLCAT::Translate( $orginal_text );
139              
140             =back
141              
142             =head1 IM IN UR NAMESPAEC AND I CAN HAZ
143              
144             =over
145              
146             =item has
147              
148             Every LOLCAT->can('has')
149              
150             =item haz
151              
152             I CAN HAZ TOO
153              
154             =back
155              
156             =head1 DEMONSTRASHUN TO SEEZ IT WERK IN REEL TIEM
157              
158             I've created a quick and dirty ajax powered web page to show how easy
159             Acme:LOLCAT is to use. Point your web browser here:
160              
161             L
162              
163             The backend CGI that accepts and responds to the ajax requests is very
164             simple:
165              
166             #!/usr/bin/perl
167              
168             use strict;
169             use warnings;
170              
171             use CGI qw/:standard/;
172             use Acme::LOLCAT;
173              
174             print header( -type => 'text/html'),
175             translate( param( 'english' );
176              
177             ... where 'english' is the name of the textarea where input is accepted.
178              
179             =head1 DEPENDNSEEZ
180              
181             Requires C.
182              
183             =head1 GUY DAT ROTE IT
184              
185             Kent Cowgill C, L
186              
187             =head1 REKWESTZ AN BUGZ
188              
189             Please report any requests, suggestions, or bugs via the RT bug tracking
190             system at L.
191              
192             L is the RT queue
193             to Acme::LOLCAT. Please check to see if your bug has already been reported.
194              
195             =head1 AKNAHLUJMENTZ
196              
197             Thanks to Dyana Wu for the patch adding several variations and additions
198             to the LOLCAT vocabulary.
199              
200             =head1 COPEERITE AN LISUNZ
201              
202             Copyright (c) 2007 by Kent Cowgill
203              
204             This library is free software; you can redistribute it and/or modify it under
205             the same terms as Perl itself.
206              
207             See L
208              
209             =cut