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__ |