File Coverage

blib/lib/Catalyst/Controller/Mobile/JP.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Catalyst::Controller::Mobile::JP;
2 1     1   5 use strict;
  1         2  
  1         41  
3 1     1   5 use warnings;
  1         1  
  1         56  
4             our $VERSION = '0.02';
5              
6 1     1   4 use base qw( Catalyst::Controller Class::Accessor::Fast );
  1         2  
  1         1315  
7             __PACKAGE__->mk_accessors(qw( encoding ));
8              
9 1     1   17232 use Encode;
  1         20640  
  1         130  
10 1     1   1584 use Encode::JP::Mobile ':props';
  0            
  0            
11             use Encode::JP::Mobile::Character;
12             use HTTP::MobileAgent::Plugin::Charset;
13              
14             sub begin :Private {
15             my ($self, $c) = @_;
16            
17             $self->encoding(do {
18             my $encoding = $c->req->mobile_agent->encoding;
19             ref($encoding) && $encoding->isa('Encode::Encoding')
20             ? $encoding
21             : Encode::find_encoding($encoding);
22             });
23            
24             for my $value (values %{ $c->req->{parameters} }) {
25             next if ref $value && ref $value ne 'ARRAY';
26            
27             for my $v (ref($value) ? @$value : $value) {
28             next if Encode::is_utf8($v);
29             $v = $self->encoding->decode($v);
30             }
31             }
32            
33             $c->res->content_type(do {
34             if ($c->req->mobile_agent->is_docomo) {
35             'application/xhtml+xml';
36             } else {
37             'text/html; charset=' . $self->encoding->mime_name;
38             }
39             });
40             }
41              
42             my %htmlspecialchars = ( '&' => '&amp;', '<' => '&lt;', '>' => '&gt;', '"' => '&quot;' );
43             my $htmlspecialchars = join '', keys %htmlspecialchars;
44              
45             our $decoding_content_type = qr{^text|xml$|javascript$};
46              
47             sub end :Private {
48             my ($self, $c) = @_;
49            
50             my $body = $c->res->body;
51             if ($body and
52             not ref($body) and
53             $c->res->content_type =~ $decoding_content_type) {
54            
55             $body = $self->encoding->encode($body, sub {
56             my $char = shift;
57             my $out = Encode::JP::Mobile::FB_CHARACTER()->($char);
58            
59             if ($c->res->content_type =~ /html$|xml$/) {
60             $out =~ s/([$htmlspecialchars])/$htmlspecialchars{$1}/ego; # for (>3<)
61             }
62              
63             $out;
64             });
65            
66             $c->res->body($body);
67             }
68             }
69              
70             1;
71             __END__
72              
73             =encoding utf-8
74              
75             =head1 NAME
76              
77             Catalyst::Controller::Mobile::JP - decode/encode with Encode::JP::Mobile
78              
79             =head1 SYNOPSIS
80              
81             package MyApp;
82             use Catalyst qw/ MobileAgent /;
83            
84             ...
85            
86             package MyApp::Controller::Root;
87             use strict;
88             use base 'Catalyst::Controller::Mobile::JP';
89            
90             __PACKAGE__->config->{namespace} = '';
91            
92             sub foo :Local {
93             my ($self, $c) = @_;
94            
95             $c->res->body(
96             $c->req->param('text') . "\x{E72A}"
97             );
98             }
99              
100             =head1 DESCRIPTION
101              
102             Catalyst::Controller::Mobile::JP works as a base controller
103             that automatically decode()/encode() with the recommended encoding
104             lead from values of UserAgent.
105              
106             You can use unicode in your app that includes cross-carrier pictograms.
107              
108             このモジュールは Catalyst::Controller で、SYNOPSIS にあるように使います。
109             C<begin> で C<< $c->req->params >> の Encode::decode()、C<end> で
110             C<< $c->res->body >> の Encode::encode() を行ないます。
111              
112             エンコーディングは UserAgent の値を元に L<Encode::JP::Mobile> から
113             おすすめのものが利用されます(L<HTTP::MobileAgent::Plugin::Charset>)ので、
114             アプリケーション内部では特に意識せずキャリアをまたいだ絵文字を含む文字情報を
115             Unicode として扱うことができます。
116              
117             =head1 ACCESSOR
118              
119             =over 4
120              
121             =item encoding
122              
123             利用されるエンコーディングの L<Encode::Encoding> オブジェクトが
124             入っています。
125              
126             $self->encoding->name; # x-sjis-docomo
127             $self->encoding->mime_name; # Shift_JIS
128              
129             =back
130              
131             =head1 USE WITH CUSTOM end() METHOD
132              
133             コントローラーで C<begin> ã‚„ C<end> を実装する場合は、以下のように
134             C<next::method> でこのモジュールのメソッドを呼んでください。
135              
136             sub render :ActionClass('RenderView') {
137            
138             }
139            
140             sub end :Private {
141             my ($self, $c) = @_;
142            
143             $c->stash->{encoding} = $self->encoding;
144             $c->forward('render');
145            
146             $self->next::method($c);
147             }
148              
149             =head1 AUTHOR
150              
151             Naoki Tomita E<lt>tomita@cpan.orgE<gt>
152              
153             =head1 DEVELOPMENT
154              
155             L<http://coderepos.org/share/browser/lang/perl/Catalyst-Controller-Mobile-JP> (repository)
156              
157             #mobilejp on irc.freenode.net (I've joined as "tomi-ru")
158              
159             =head1 LICENSE
160              
161             This library is free software; you can redistribute it and/or modify
162             it under the same terms as Perl itself.
163              
164             =head1 SEE ALSO
165              
166             L<Encode::JP::Mobile>, L<HTTP::MobileAgent::Plugin::Charset>,
167             L<Catalyst::View::MobileJpFilter>
168              
169             =cut