root/lang/perl/HTTP-MobileAttribute/trunk/lib/HTTP/MobileAttribute/Plugin/Default/EZweb.pm @ 8662

Revision 8662, 1.8 kB (checked in by tokuhirom, 6 years ago)

とりあえず perlcritic をだまらす

Line 
1package HTTP::MobileAttribute::Plugin::Default::EZweb;
2use strict;
3use warnings;
4use base qw/Class::Component::Plugin/;
5
6sub 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 がうまくあたらないからとりあえずこれで。
14for 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
19sub 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
31sub 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
37sub 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
661;
Note: See TracBrowser for help on using the browser.