Show
Ignore:
Timestamp:
01/19/08 12:58:09 (5 years ago)
Author:
tokuhirom
Message:

rewrote Moxy::Plugin::Pictogram.

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/Moxy/trunk/lib/Moxy/Plugin/Pictogram.pm

    r4858 r4942  
    55use Moxy::Util; 
    66use Path::Class; 
    7 use HTML::Entities::ImodePictogram qw/decode_pictogram find_pictogram/; 
    8  
    9 my $EZENTITIREF2EZPICTNUMBER; 
    10 my $ez_sjis_pattern; 
    11 my %ez_sjis_map; 
    12 my $ez_uni2number; 
     7use HTML::ReplacePictogramMobileJp; 
    138 
    149sub register { 
    1510    my ($class, $context) = @_; 
    1611 
    17     # pre loading data. 
     12    # registering pictogram replacer. 
     13    for my $carrier (qw/I E V H/) { 
     14        $context->register_hook( "response_filter_$carrier" => sub { 
     15            my ($context, $args, ) = @_; 
     16            return unless (($args->{response}->header('Content-Type')||'') =~ /html/); 
    1817 
    19     { 
    20         # EZ.UNI.HEX => EZ.PICT-NUMBER 
    21         $EZENTITIREF2EZPICTNUMBER = $class->_load_yaml($context, 'ez.uni2number.yaml'); 
     18            my $charset = Moxy::Util->detect_charset($args->{response}, $args->{content_ref}); 
     19            $charset = ($charset =~ /utf-?8/i) ? 'utf8' : 'sjis'; 
    2220 
    23         # I.SJIS.HEX => EZ.PICT-NUMBER 
    24         my $isjishex2ezpictnumber = $class->_load_yaml( $context, 'i2ezpict.yaml' ); 
    25         $EZENTITIREF2EZPICTNUMBER = { %$EZENTITIREF2EZPICTNUMBER, %$isjishex2ezpictnumber }; 
    26     } 
     21            ${ $args->{content_ref} } = HTML::ReplacePictogramMobileJp->replace( 
     22                html     => ${ $args->{content_ref} }, 
     23                carrier  => $carrier, 
     24                charset  => $charset, 
     25                callback => sub { 
     26                    my ( $unicode, $carrier ) = @_; 
    2727 
    28     my $ez_code = $class->_load_file( $context, 'ez.sjis.txt' ); 
    29     $ez_sjis_pattern = join('|', grep { quotemeta($_) } split /\n/, $ez_code); 
    30     my $cnt = 0; 
    31     %ez_sjis_map = map { $_ =~ s/\\x//g; lc($_) => ++$cnt } split /\n/, $ez_code; ## no critic. 
    32  
    33     # registering pictogram replacer. 
    34     for my $carrier (qw/I E V/) { 
    35         $context->register_hook( "response_filter_$carrier" => sub { 
    36             my $method = "filter_pictogram_$carrier"; 
    37             $class->$method(@_)  
     28                    my $pict_html = $class->_load_file( $context, 'pict.tmpl' ); 
     29                    return sprintf( $pict_html, $carrier, $unicode, $unicode ); 
     30                } 
     31            ); 
     32            ${ $args->{content_ref} }; 
    3833        }); 
    3934    } 
    40       # airH" uses DoCoMo's pictogram. so cool. 
    41     $context->register_hook( response_filter_H => sub { 
    42         $class->filter_pictogram_I(@_)  
    43     }); 
    4435 
    4536    # deliver pictogram 
    … …  
    4738        my ($context, $args) = @_; 
    4839 
    49         if ($args->{request}->uri =~ m{http://pictogram\.moxy/([iev]/[0-9]+.gif)}) { 
    50             my $fname = file($context->assets_path, "server", 'pictogram', $1); 
    51             return 0 unless -f $fname; 
    52             my $content = $fname->slurp; 
    53             return 0 unless $content; 
     40        if ($args->{request}->uri =~ m{http://pictogram\.moxy/([IEV])/([0-9A-F]{4}).gif}) { 
     41            my $content = file($class->assets_path($context), 'image', $1, "$2.gif")->slurp; 
    5442 
    5543            my $response = HTTP::Response->new( 200, 'ok' ); 
    56             $response->header('Expires' => 'Thu, 15 Apr 2030 20:00:00 GMT'); 
    57             $response->content_type( "image/gif" ); 
     44            $response->header( 'Expires' => 'Thu, 15 Apr 2030 20:00:00 GMT' ); 
     45            $response->content_type("image/gif"); 
    5846            $response->content($content); 
    5947            $args->{filter}->proxy->response($response); 
    6048        } 
    6149    }); 
    62 } 
    63  
    64 # generate pictogram html. 
    65 sub pict_html { 
    66     my ($class, $context, $carrier, $number) = @_; 
    67  
    68     my $pict_html = $class->_load_file( $context, 'pict.tmpl' ); 
    69     if ($class->config($context)->{no_pict}) { 
    70         # 絵文字非表示モード 
    71         return sprintf("[%s:%03d]", $carrier, $number||1); 
    72     } else { 
    73         return sprintf( $pict_html, $carrier, $number||1 ); 
    74     } 
    75 } 
    76  
    77 sub filter_pictogram_I { 
    78     my ($class, $context, $args) = @_; 
    79  
    80     # run only html 
    81     return unless (($args->{response}->header('Content-Type')||'') =~ /html/); 
    82  
    83     my $raw_text = decode_pictogram(${ $args->{content_ref} }); 
    84     find_pictogram($raw_text, sub { 
    85                         my($char, $number, $cp) = @_; 
    86                         return $class->pict_html($context, 'i', $number); 
    87                    }); 
    88  
    89     ${ $args->{content_ref} } = $raw_text; 
    90 } 
    91  
    92 # take from HTML::Entities::ImodePictogram 
    93 my $one_byte  = '[\x00-\x7F\xA1-\xDF]'; 
    94 my $two_bytes = '[\x81-\x9F\xE0-\xFC][\x40-\x7E\x80-\xFC]'; 
    95 my $sjis_re   = qr<$one_byte|$two_bytes>; 
    96  
    97 sub filter_pictogram_E { 
    98     my ($class, $context, $args) = @_; 
    99  
    100     # run only html 
    101     return unless (($args->{response}->header('Content-Type')||'') =~ /html/); 
    102  
    103     my $disp = sub { 
    104         my ($context, $carrier, $number) = @_; 
    105         $class->pict_html($context, $carrier, sprintf("%d", $number||0)); 
    106     }; 
    107  
    108     # do convert pictogram 
    109     ${ $args->{content_ref} } =~ s[(($ez_sjis_pattern)|$sjis_re)] 
    110                                   [defined $2 ? $disp->($context, 'e', $ez_sjis_map{unpack("H*",$2)}) : $1]ige; 
    111     ${ $args->{content_ref} } =~ s/<img[^<>]+localsrc=["'](\d+)[^<>]+>/$disp->($context, 'e', $1)/ige; 
    112     ${ $args->{content_ref} } =~ s/&#(\d+);/$disp->($context, 'e', $EZENTITIREF2EZPICTNUMBER->{sprintf('%X', $1)})/gie; 
    113     ${ $args->{content_ref} } =~ s/&#x(\w+);/$disp->($context, 'e', $EZENTITIREF2EZPICTNUMBER->{$1})/gie; 
    114 } 
    115  
    116  
    117 sub filter_pictogram_V { 
    118     my ($class, $context, $args) = @_; 
    119  
    120     # run only html 
    121     return unless (($args->{response}->header('Content-Type')||'') =~ /html/); 
    122  
    123     # see Encode::JP::Mobile::Vodafone 
    124     # G! => E001, G" => E002, G# => E003 ... 
    125     # E! => E101, F! => E201, O! => E301, P! => E401, Q! => E501 
    126     my %HighCharToBit = (G => 0xE000, E => 0xE100, F => 0xE200, 
    127                          O => 0xE300, P => 0xE400, Q => 0xE500); 
    128  
    129     ${ $args->{content_ref} } =~ s{\x1b\x24([GEFOPQ])([\x20-\x7F]+)\x0f}{ 
    130         join '', map { $class->pict_html($context, 'v', ($HighCharToBit{$1} | ord($_) -32)) } split //, $2 
    131     }ge; 
    132  
    133     my $charset = Moxy::Util->detect_charset($args->{response}, $args->{content_ref}); 
    134     if ($charset =~ /utf-?8/i) { 
    135         ${ $args->{content_ref} } =~ s/&#(\d+);/$class->pict_html($context, 'v', $1)/gie; 
    136         ${ $args->{content_ref} } =~ s/&#x(\w+);/$class->pict_html($context, 'v', hex($1))/gie; 
    137     } 
    13850} 
    13951