| 1 | package HTTP::MobileAttribute::Plugin::Default::EZweb; |
|---|
| 2 | use strict; |
|---|
| 3 | use warnings; |
|---|
| 4 | use base qw/Class::Component::Plugin/; |
|---|
| 5 | |
|---|
| 6 | sub initialize : Hook('initialize') { |
|---|
| 7 | my ( $self, $c ) = @_; |
|---|
| 8 | return unless $c->carrier_longname eq 'EZweb'; |
|---|
| 9 | |
|---|
| 10 | $self->parse( $c ); |
|---|
| 11 | } |
|---|
| 12 | |
|---|
| 13 | # FIXME: ここなんとかして。どうにかして。なんか anonymous function だと Attribute がうまくあたらないからとりあえずこれで。 |
|---|
| 14 | for my $method (qw(name version model device_id server xhtml_compliant comment)) { |
|---|
| 15 | eval qq! sub $method :MobileMethod("$method,EZweb") { shift->{$method} }; !; ## no critic. |
|---|
| 16 | die $@ if $@; |
|---|
| 17 | } |
|---|
| 18 | |
|---|
| 19 | sub is_tuka : MobileMethod('is_tuka,EZweb') { |
|---|
| 20 | my $self = shift; |
|---|
| 21 | my $tuka = substr( $self->device_id, 2, 1 ); |
|---|
| 22 | if ( $self->xhtml_compliant ) { |
|---|
| 23 | return 1 if $tuka eq 'U'; |
|---|
| 24 | } |
|---|
| 25 | else { |
|---|
| 26 | return 1 if $tuka eq 'T'; |
|---|
| 27 | } |
|---|
| 28 | return; |
|---|
| 29 | } |
|---|
| 30 | |
|---|
| 31 | sub is_win : MobileMethod('is_win,EZweb') { |
|---|
| 32 | my $self = shift; |
|---|
| 33 | my $win = substr( $self->device_id, 2, 1 ); |
|---|
| 34 | $win eq '3' ? 1 : 0; |
|---|
| 35 | } |
|---|
| 36 | |
|---|
| 37 | sub parse { |
|---|
| 38 | my ($self, $c) = @_; |
|---|
| 39 | my $ua = $c->user_agent; |
|---|
| 40 | if ($ua =~ s/^KDDI\-//) { |
|---|
| 41 | # KDDI-TS21 UP.Browser/6.0.2.276 (GUI) MMP/1.1 |
|---|
| 42 | $self->{xhtml_compliant} = 1; |
|---|
| 43 | my($device, $browser, $opt, $server) = split / /, $ua, 4; |
|---|
| 44 | $self->{device_id} = $device; |
|---|
| 45 | |
|---|
| 46 | my($name, $version) = split m!/!, $browser; |
|---|
| 47 | $self->{name} = $name; |
|---|
| 48 | $self->{version} = "$version $opt"; |
|---|
| 49 | $self->{server} = $server; |
|---|
| 50 | } |
|---|
| 51 | else { |
|---|
| 52 | # UP.Browser/3.01-HI01 UP.Link/3.4.5.2 |
|---|
| 53 | my($browser, $server, $comment) = split / /, $ua, 3; |
|---|
| 54 | my($name, $software) = split m!/!, $browser; |
|---|
| 55 | $self->{name} = $name; |
|---|
| 56 | @{$self}{qw(version device_id)} = split /-/, $software; |
|---|
| 57 | $self->{server} = $server; |
|---|
| 58 | if ($comment) { |
|---|
| 59 | $comment =~ s/^\((.*)\)$/$1/; |
|---|
| 60 | $self->{comment} = $comment; |
|---|
| 61 | } |
|---|
| 62 | } |
|---|
| 63 | $self->{model} = $self->{device_id}; |
|---|
| 64 | } |
|---|
| 65 | |
|---|
| 66 | 1; |
|---|