File Coverage

blib/lib/Moxy/Plugin/Pictogram.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1             package Moxy::Plugin::Pictogram;
2 11     11   23643 use strict;
  11         23  
  11         362  
3 11     11   60 use warnings;
  11         19  
  11         313  
4 11     11   55 use base qw/Moxy::Plugin/;
  11         22  
  11         489  
5 11     11   614 use Moxy::Util;
  11         20  
  11         100  
6 11     11   278 use Path::Class;
  11         22  
  11         831  
7 11     11   5539 use HTML::ReplacePictogramMobileJp 0.04;
  0            
  0            
8             use HTTP::MobileAttribute;
9              
10             sub response_filter :Hook {
11             my ( $self, $context, $args, ) = @_;
12             return unless ( ( $args->{response}->header('Content-Type') || '' ) =~ /html/ );
13             return if $args->{mobile_attribute}->is_non_mobile;
14              
15             my $carrier = $args->{mobile_attribute}->carrier;
16              
17             my $charset = $args->{response}->charset;
18             $charset = ( $charset =~ /utf-?8/i ) ? 'utf8' : 'sjis';
19              
20             my $pict_html = $self->render_template( $context, 'pict.tmpl' );
21              
22             $args->{response}->content(
23             HTML::ReplacePictogramMobileJp->replace(
24             html => $args->{response}->content,
25             carrier => $carrier,
26             charset => $charset,
27             callback => sub {
28             my ( $unicode, $carrier ) = @_;
29              
30             return sprintf( $pict_html, $carrier, $unicode, $unicode );
31             }
32             )
33             );
34             }
35              
36             sub url_handle :Hook {
37             my ($self, $context, $args) = @_;
38             die "request missing" unless $args->{request};
39              
40             if ($args->{request}->uri =~ m{http://pictogram\.moxy/([IEV])/([0-9A-F]{4}).gif}) {
41             my $content = file($self->assets_path($context), 'image', $1, "$2.gif")->slurp;
42              
43             my $response = HTTP::Response->new( 200, 'ok' );
44             $response->header( 'Expires' => 'Thu, 15 Apr 2030 20:00:00 GMT' );
45             $response->content_type("image/gif");
46             $response->content($content);
47             $response;
48             }
49             }
50              
51             1;
52             __END__