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

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

fix new subclass problem

  • Property svn:keywords set to Id Revision
Line 
1 package Text::Emoticon;
2
3 use strict;
4 our $VERSION = '0.03';
5
6 use UNIVERSAL::require;
7
8 my %map;
9
10 sub new {
11     my $class  = shift;
12     if ($class eq __PACKAGE__) {
13         my $driver = shift;
14         my $args   = @_ == 1 ? $_[0] : {@_};
15
16         my $subclass = "Text::Emoticon::$driver";
17         $subclass->require or die $@;
18         return bless { %{$subclass->default_config}, %$args }, $subclass;
19     } else {
20         my $args   = @_ == 1 ? $_[0] : {@_};
21         return bless { %{$class->default_config}, %$args }, $class;
22     }
23 }
24
25 sub register_subclass {
26     my $class = shift;
27     my($map)  = @_;
28     my $subclass = caller;
29     $map{$subclass} = $map;
30 }
31
32 sub map { $map{ref($_[0])} }
33
34 sub pattern {
35     my $self = shift;
36     $self->{re} ||= "(" . join("|", map quotemeta($_), keys %{$self->map}) . ")";
37     $self->{re};
38 }
39
40 sub filter_one {
41     my $self = shift;
42     my($text) = @_;
43     $self->do_filter($self->map->{$text});
44 }
45
46 sub filter {
47     my($self, $text) = @_;
48     return unless defined $text;
49     my $re = $self->pattern;
50     if ($self->{strict}) {
51       $text =~ s{(?<!\w)$re(?!\w)}{$self->do_filter($self->map->{$1})}eg;
52     } else {
53       $text =~ s{$re}{$self->do_filter($self->map->{$1})}eg;
54     }
55     return $text;
56 }
57
58 sub do_filter {
59     my($self, $icon) = @_;
60     my $class = $self->{class} ? qq( class="$self->{class}") : "";
61     my $xhtml = $self->{xhtml} ? qq( /) : "";
62
63     return qq(<img src="$self->{imgbase}/$icon"$class$xhtml>);
64 }
65
66
67 1;
68 __END__
69
70 =head1 NAME
71
72 Text::Emoticon - Factory class for Yahoo! and MSN emoticons
73
74 =head1 SYNOPSIS
75
76   use Text::Emoticon;
77
78   my $emoticon = Text::Emoticon->new('MSN', { strict => 1, xhtml => 0 });
79   print $emoticon->filter('Hello ;)');
80
81 =head1 DESCRIPTION
82
83 Text::Emoticon is a factory class to dispatch MSN/YIM emoticon
84 set. It's made to become handy to be used in other applications like
85 Kwiki/MT plugins.
86
87 =head1 AUTHOR
88
89 Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
90
91 This library is free software; you can redistribute it and/or modify
92 it under the same terms as Perl itself.
93
94 =head1 SEE ALSO
95
96 L<Text::Emoticon::MSN>, L<Text::Emoticon::Yahoo>
97
98 =cut
Note: See TracBrowser for help on using the browser.