root/Text-Emoticon-MSN/trunk/lib/Text/Emoticon/MSN.pm

Revision 1579 (checked in by miyagawa, 15 years ago)

0.02 release: add strict option

  • Property svn:keywords set to Id Revision
Line 
1 package Text::Emoticon::MSN;
2
3 use strict;
4 use vars qw($VERSION);
5 $VERSION = '0.02';
6
7 use vars qw(%Default %EmoticonMap $EmoticonRE);
8
9 %Default = (
10     imgbase => ".",
11     xhtml   => 1,
12     strict  => 0,
13     class   => undef,
14 );
15
16 # Table autogernerated from Emoticons.aspx using
17 # $_ = join "", <>;
18 # while (m@(<img src="emoticons/(.*?)">|<span class="bold">(.*?)</span>)@g) {
19 #   $icon = $2 if $2;
20 #   ($t = $2) =~ s/'/\\'/;
21 #   $print qq('$t' => "$icon",\n) if $3;
22 # }
23
24 %EmoticonMap = (
25 ':-)' => "regular_smile.gif",
26 ':)' => "regular_smile.gif",
27 ':-D' => "teeth_smile.gif",
28 ':d' => "teeth_smile.gif",
29 ':-O' => "omg_smile.gif",
30 ':o' => "omg_smile.gif",
31 ':-P' => "tongue_smile.gif",
32 ':p' => "tongue_smile.gif",
33 ';-)' => "wink_smile.gif",
34 ';)' => "wink_smile.gif",
35 ':-(' => "sad_smile.gif",
36 ':(' => "sad_smile.gif",
37 ':-S' => "confused_smile.gif",
38 ':s' => "confused_smile.gif",
39 ':-|' => "what_smile.gif",
40 ':|' => "what_smile.gif",
41 ':\'(' => "cry_smile.gif",
42 ':-$' => "red_smile.gif",
43 ':$' => "red_smile.gif",
44 '(H)' => "shades_smile.gif",
45 '(h)' => "shades_smile.gif",
46 ':-@' => "angry_smile.gif",
47 ':@' => "angry_smile.gif",
48 '(A)' => "angel_smile.gif",
49 '(a)' => "angel_smile.gif",
50 '(6)' => "devil_smile.gif",
51 ':-#' => "47_47.gif",
52 '8o|' => "48_48.gif",
53 '8-|' => "49_49.gif",
54 '^o)' => "50_50.gif",
55 ':-*' => "51_51.gif",
56 '+o(' => "52_52.gif",
57 ':^)' => "71_71.gif",
58 '*-)' => "72_72.gif",
59 '<:o)' => "74_74.gif",
60 '8-)' => "75_75.gif",
61 '|-)' => "77_77.gif",
62 '(C)' => "coffee.gif",
63 '(c)' => "coffee.gif",
64 '(Y)' => "thumbs_up.gif",
65 '(y)' => "thumbs_up.gif",
66 '(N)' => "thumbs_down.gif",
67 '(n)' => "thumbs_down.gif",
68 '(B)' => "beer_mug.gif",
69 '(b)' => "beer_mug.gif",
70 '(D)' => "martini.gif",
71 '(d)' => "martini.gif",
72 '(X)' => "girl.gif",
73 '(x)' => "girl.gif",
74 '(Z)' => "guy.gif",
75 '(z)' => "guy.gif",
76 '({)' => "guy_hug.gif",
77 '(})' => "girl_hug.gif",
78 ':-[' => "bat.gif",
79 ':[' => "bat.gif",
80 '(^)' => "cake.gif",
81 '(L)' => "heart.gif",
82 '(l)' => "heart.gif",
83 '(U)' => "broken_heart.gif",
84 '(u)' => "broken_heart.gif",
85 '(K)' => "kiss.gif",
86 '(k)' => "kiss.gif",
87 '(G)' => "present.gif",
88 '(g)' => "present.gif",
89 '(F)' => "rose.gif",
90 '(f)' => "rose.gif",
91 '(W)' => "wilted_rose.gif",
92 '(w)' => "wilted_rose.gif",
93 '(P)' => "camera.gif",
94 '(p)' => "camera.gif",
95 '(~)' => "film.gif",
96 '(@)' => "cat.gif",
97 '(&)' => "dog.gif",
98 '(T)' => "phone.gif",
99 '(t)' => "phone.gif",
100 '(I)' => "lightbulb.gif",
101 '(i)' => "lightbulb.gif",
102 '(8)' => "note.gif",
103 '(S)' => "moon.gif",
104 '(*)' => "star.gif",
105 '(E)' => "envelope.gif",
106 '(e)' => "envelope.gif",
107 '(O)' => "clock.gif",
108 '(o)' => "clock.gif",
109 '(M)' => "messenger.gif",
110 '(m)' => "messenger.gif",
111 '(sn)' => "53_53.gif",
112 '(bah)' => "70_70.gif",
113 '(pl)' => "55_55.gif",
114 '(||)' => "56_56.gif",
115 '(pi)' => "57_57.gif",
116 '(so)' => "58_58.gif",
117 '(au)' => "59_59.gif",
118 '(ap)' => "60_60.gif",
119 '(um)' => "61_61.gif",
120 '(ip)' => "62_62.gif",
121 '(co)' => "63_63.gif",
122 '(mp)' => "64_64.gif",
123 '(st)' => "66_66.gif",
124 '(li)' => "73_73.gif",
125 '(mo)' => "69_69.gif",
126
127 );
128
129 my $re = join "|", map quotemeta($_), keys %EmoticonMap;
130 $EmoticonRE = qr/($re)/;
131
132 sub new {
133     my($class, %opt) = @_;
134     my %attr = (%Default, %opt);
135     bless \%attr, $class;
136 }
137
138 sub filter {
139     my($self, $text) = @_;
140     return unless defined $text;
141     if ($self->{strict}) {
142       $text =~ s{(?<!\w)$EmoticonRE(?!\w)}{$self->do_filter($EmoticonMap{$1})}eg;
143     } else {
144       $text =~ s{$EmoticonRE}{$self->do_filter($EmoticonMap{$1})}eg;
145     }
146     return $text;
147 }
148
149 sub do_filter {
150     my($self, $icon) = @_;
151     my $class = $self->{class} ? qq( class="$self->{class}") : "";
152     my $xhtml = $self->{xhtml} ? qq( /) : "";
153
154     return qq(<img src="$self->{imgbase}/$icon"$class$xhtml>);
155 }
156
157 1;
158 __END__
159
160 =head1 NAME
161
162 Text::Emoticon::MSN - Emoticon filter of MSN Messenger
163
164 =head1 SYNOPSIS
165
166   use Text::Emoticon::MSN;
167
168   my $emoticon = Text::Emoticon::MSN->new(
169       imgbase => "http://example.com/emo",
170   );
171
172   my $text = "Yet Another Perl Hacker ;-)";
173   print $emoticon->filter($text);
174
175   # it prints
176   # Yet Another Perl Hacker <img src="http://example.com/emo/regular_smile.gif" />
177
178 =head1 DESCRIPTION
179
180 Text::Emoticon::MSN is a text filter that replaces text emoticons like ":-)", ";-P", etc. to the icons of MSN Messenger, detailed in http://messenger.msn.com/Resource/Emoticons.aspx
181
182 =head1 METHODS
183
184 =over 4
185
186 =item new
187
188   $emoticon = Text::Emoticon::MSN->new(
189       imgbase => "http://yourhost.example.com/images/emoticons",
190       xhtml   => 1,
191       class   => "emoticon",
192   );
193
194 Constructs new Text::Emoticon::MSN object. It accepts two options:
195
196 =over 6
197
198 =item imgbase
199
200 Base URL where icon gif files are located. It defaults to ".", meaning it links to images in current directory. Though you can use "http://messenger.msn.com/Resouce/emoticons" (the MSN site) as C<imgbase> value, I don't recommend that, as there's a possibility MSN will ban your site.
201
202 =item xhtml
203
204 Whether it uses XHTML style img tags. It defaults to 1.
205
206 =item class
207
208 CSS class used in C<img> tags. It defaults to nothing.
209
210   $emoticon = Text::Emoticon::MSN->new(class => "emo");
211
212 will print:
213
214   <img src="blah.gif" class="emo" />
215  
216 =item strict
217
218 Whether it will disable smileys with space in them.
219 defaults to 0.
220  
221 =back
222
223 =item filter
224
225   $filtered_text = $emoticon->filter($text);
226
227 Filters emoticons in text and returns C<img> tagged text (HTML).
228
229 =back
230
231 =head1 TODO
232
233 =over 4
234
235 =item *
236
237 Handling original emoticons. (Patches welcome)
238
239 =item *
240
241 Common API for other Emoticons like Yahoo! (maybe Text::Emoticons)
242
243 =back
244
245 =head1 AUTHOR
246
247 Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
248
249 This library is free software; you can redistribute it and/or modify
250 it under the same terms as Perl itself.
251
252 =head1 SEE ALSO
253
254 http://messenger.msn.com/Resource/Emoticons.aspx
255
256 =cut
Note: See TracBrowser for help on using the browser.