File Coverage

blib/lib/HTML/Entities/ImodePictogram.pm

Criterion	Covered	Total	%
statement	49	53	92.4
branch	17	24	70.8
condition	24	54	44.4
subroutine	12	12	100.0
pod	4	4	100.0
total	106	147	72.1

package HTML::Entities::ImodePictogram;

use strict;
use vars qw($VERSION);
$VERSION = 0.06;

use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
require Exporter;
@ISA       = qw(Exporter);
@EXPORT    = qw(encode_pictogram decode_pictogram remove_pictogram);
@EXPORT_OK = qw(find_pictogram);
%EXPORT_TAGS = ( all => [ @EXPORT, @EXPORT_OK ] );

my $one_byte  = '[\x00-\x7F\xA1-\xDF]';
my $two_bytes = '[\x81-\x9F\xE0-\xFC][\x40-\x7E\x80-\xFC]';

use vars qw($Sjis_re $Pictogram_re $ExtPictorgram_re);
$Sjis_re      = qr<$one_byte|$two_bytes>;
$Pictogram_re = '\xF8[\x9F-\xFC]|\xF9[\x40-\x7E\x80-\xB0]';
$ExtPictorgram_re = '\xF9[\xB1-\xFC]';

sub find_pictogram (\$&) {
    my($r_text, $callback) = @_;

    my $num_found = 0;
    $$r_text =~ s{(($Pictogram_re)|($ExtPictorgram_re)|$Sjis_re)}{
	my $orig_match = $1;
	if (defined $2 || defined $3) {
	    $num_found++;
	    my $number = unpack 'n', $orig_match;
	    $callback->($orig_match, $number, _num2cp($number));
	}
	else {
	    $orig_match;
	}
    }eg;

    return $num_found;
}

sub encode_pictogram {
    my($text, %opt) = @_;
    find_pictogram($text, sub {
		       my($char, $number, $cp) = @_;
		       if ($opt{unicode} || $cp >= 59148) {
			   return sprintf '&#x%x;', $cp;
		       } else {
			   return '&#' . $number . ';';
		       }
		   });
    return $text;
}

sub decode_pictogram {
    my $html = shift;
    $html =~ s{(\&\#(\d{5});)|(\&\#x([0-9a-fA-F]{4});)}{
	if (defined $1) {
	    my $cp = _num2cp($2);
	    defined $cp ? pack('n', $2) : $1;
	} elsif (defined $3) {
	    my $num = _cp2num(hex($4));
	    defined $num ? pack('n', $num) : $3;
	}
    }eg;
    return $html;
}

sub remove_pictogram {
    my $text = shift;
    find_pictogram($text, sub {
		       return '';
		   });
    return $text;
}

sub _num2cp {
    my $num = shift;
    if ($num >= 63647 && $num <= 63740) {
	return $num - 4705;
    } elsif (($num >= 63808 && $num <= 63817) ||
	     ($num >= 63824 && $num <= 63838) ||
             ($num >= 63858 && $num <= 63870)) {
	return $num - 4772;
    } elsif ($num >= 63872 && $num <= 63996) {
	return $num - 4773;
    } else {
	return;
    }
}

sub _cp2num {
    my $cp = shift;
    if ($cp >= 58942 && $cp <= 59035) {
	return $cp + 4705;
    } elsif (($cp >= 59036 && $cp <= 59045) ||
	     ($cp >= 59052 && $cp <= 59066) ||
	     ($cp >= 59086 && $cp <= 59098)) {
	return $cp + 4772;
    } elsif (($cp >= 59099 && $cp <= 59146) ||
	     ($cp >= 59148 && $cp <= 59223)) {
	return $cp + 4773;
    } else {
	return;
    }
}


1;
__END__