Changeset 1735

Show
Ignore:
Timestamp:
01/11/06 19:17:08
Author:
miyagawa
Message:

whole new Emoticon framework

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved
  • Text-Emoticon/trunk/Changes

    r1721 r1735  
    11Revision history for Perl extension Text::Emoticon 
     2 
     30.02  Wed Jan 11 10:15:39 UTC 2006 
     4        - redesigned Text::Emoticon framework for easy subclass creation 
    25 
    360.01  Tue Jan 10 09:25:28 2006 
  • Text-Emoticon/trunk/META.yml

    r1721 r1735  
    22#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX# 
    33name:         Text-Emoticon 
    4 version:      0.01 
     4version:      0.02 
    55version_from: lib/Text/Emoticon.pm 
    66installdirs:  site 
  • Text-Emoticon/trunk/lib/Text/Emoticon.pm

    r1721 r1735  
    22 
    33use strict; 
    4 our $VERSION = '0.01'; 
     4our $VERSION = '0.02'; 
    55 
    66use UNIVERSAL::require; 
     7 
     8my %map; 
    79 
    810sub new { 
     
    1416       $subclass->require or die $@; 
    1517 
    16     $subclass->new(%$args)
     18    bless { %{$subclass->default_config}, %$args }, $subclass
    1719} 
     20 
     21sub register_subclass { 
     22    my $class = shift; 
     23    my($map)  = @_; 
     24    my $subclass = caller; 
     25    $map{$subclass} = $map; 
     26} 
     27 
     28sub map { $map{ref($_[0])} } 
     29 
     30sub pattern { 
     31    my $self = shift; 
     32    $self->{re} ||= "(" . join("|", map quotemeta($_), keys %{$self->map}) . ")"; 
     33    $self->{re}; 
     34} 
     35 
     36sub filter_one { 
     37    my $self = shift; 
     38    my($text) = @_; 
     39    $self->do_filter($self->map->{$text}); 
     40} 
     41 
     42sub filter { 
     43    my($self, $text) = @_; 
     44    return unless defined $text; 
     45    my $re = $self->pattern; 
     46    if ($self->{strict}) { 
     47      $text =~ s{(?<!\w)$re(?!\w)}{$self->do_filter($self->map->{$1})}eg; 
     48    } else { 
     49      $text =~ s{$re}{$self->do_filter($self->map->{$1})}eg; 
     50    } 
     51    return $text; 
     52} 
     53 
     54sub do_filter { 
     55    my($self, $icon) = @_; 
     56    my $class = $self->{class} ? qq( class="$self->{class}") : ""; 
     57    my $xhtml = $self->{xhtml} ? qq( /) : ""; 
     58 
     59    return qq(<img src="$self->{imgbase}/$icon"$class$xhtml>);  
     60} 
     61 
    1862 
    19631; 
  • Text-Emoticon/trunk/t/01_emoticon.t

    r1721 r1735  
    66for my $driver (qw( MSN Yahoo )) { 
    77    eval { 
    8         my $msn = Text::Emoticon->new($driver); 
    9         my $f = $msn->filter('Hi :)'); 
     8        my $emo = Text::Emoticon->new($driver); 
     9        my $f = $emo->filter('Hi :)'); 
    1010        like $f, qr/img/; 
    1111    }; 
     12    if ($@) { 
     13        diag( "new version of $driver module needed." ); 
     14        pass; 
     15    } 
    1216} 
    1317