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

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

import

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