File Coverage

blib/lib/Text/Emoticon.pm

Criterion	Covered	Total	%
statement	12	43	27.9
branch	3	16	18.7
condition	0	3	0.0
subroutine	3	9	33.3
pod	0	7	0.0
total	18	78	23.0

package Text::Emoticon;

use strict;
our $VERSION = '0.04';

use UNIVERSAL::require;

my %map;

sub new {
    my $class  = shift;
    if ($class eq __PACKAGE__) {
        my $driver = shift;
        my $args   = @_ == 1 ? $_[0] : {@_};

        my $subclass = "Text::Emoticon::$driver";
        $subclass->require or die $@;
        return bless { %{$subclass->default_config}, %$args }, $subclass;
    } else {
        my $args   = @_ == 1 ? $_[0] : {@_};
        return bless { %{$class->default_config}, %$args }, $class;
    }
}

sub register_subclass {
    my $class = shift;
    my($map)  = @_;
    my $subclass = caller;
    $map{$subclass} = $map;
}

sub map { $map{ref($_[0])} }

sub pattern {
    my $self = shift;
    $self->{re} ||= "(" . join("|", map quotemeta($_), sort { length($b) <=> length($a) } keys %{$self->map}) . ")";
    $self->{re};
}

sub filter_one {
    my $self = shift;
    my($text) = @_;
    $self->do_filter($self->map->{$text});
}

sub filter {
    my($self, $text) = @_;
    return unless defined $text;
    my $re = $self->pattern;
    if ($self->{strict}) {
      $text =~ s{(?do_filter($self->map->{$1})}eg;
    } else {
      $text =~ s{$re}{$self->do_filter($self->map->{$1})}eg;
    }
    return $text;
}

sub do_filter {
    my($self, $icon) = @_;
    my $class = $self->{class} ? qq( class="$self->{class}") : "";
    my $xhtml = $self->{xhtml} ? qq( /) : "";

    return qq();
}


1;
__END__