view release on metacpan or  search on metacpan

lib/HTTP/MobileAgent/DoCoMo.pm  view on Meta::CPAN

use vars qw($VERSION);
$VERSION = 0.24;

use base qw(HTTP::MobileAgent);

__PACKAGE__->make_accessors(
    qw(version model status bandwidth
       serial_number is_foma card_id xhtml_compliant comment)
);

use HTTP::MobileAgent::DoCoMoDisplayMap qw($DisplayMap);

# various preferences
use vars qw($DefaultCacheSize $HTMLVerMap $GPSModelsRe);
$DefaultCacheSize = 5;

# http://www.nttdocomo.co.jp/service/developer/make/content/spec/useragent/index.html
$HTMLVerMap = [
    qr/(?i-xsm:^(?:D501i|F501i|N501i|P501i)$)/,
    '1.0',
    qr/(?i-xsm:^(?:D209i|D502i|ER209i|F209i|F210i|F502i|F502it|F671i|KO209i|KO210i|N209i|N210i|N502i|N502it|N821i|NM502i|P209i|P209iS|P210i|P502i|P651ps|P821i|R209i|R691i|SH821i|SO502i|SO502iWM)$)/,
    '2.0',
    qr/(?i-xsm:^(?:D2101V|D210i|D211i|D503i|D503iS|F211i|F503i|F503iS|N2001|N2002|N211i|N211iS|N503i|N503iS|P2002|P2101V|P211i|P211iS|P503i|P503iS|R211i|R692i|SH2101V|SH251i|SH251iS|SO210i|SO211i|SO503i|SO503iS|T2101V)$)/,
    '3.0',
    qr/(?i-xsm:^(?:eggy|P751v)$)/,
    '3.2',
    qr/(?i-xsm:^(?:D251i|D251iS|D504i|F2051|F2102V|F212i|F251i|F504i|F504iS|F661i|F671iS|F672i|N2051|N2102V|N251i|N251iS|N2701|N504i|N504iS|NM705i|NM706i|NM850iG|P2102V|P251iS|P504i|P504iS|SO212i|SO213i|SO213iS|SO213iWR|SO504i)$)/,
    '4.0',
    qr/(?i-xsm:^(?:D252i|D253i|D253iWM|D505i|D505iS|D506i|D701i|D701iWM|D900i|D901i|D901iS|F505i|F505iGPS|F506i|F700i|F700iS|F880iES|F881iES|F900i|F900iC|F900iT|F901iC|F901iS|L600i|L601i|L602i|M702iG|M702iS|N252i|N253i|N505i|N505iS|N506i|N506iS|N506i...
    '5.0',
    qr/(?i-xsm:^(?:D702i|D702iBCL|D702iF|D800iDS|D851iWM|D902i|D902iS|F702iD|F882iES|F883i|F883iS|F902i|F902iS|L01A|L01C|L02B|L03A|L03B|L04A|L04B|L06A|L704i|L705i|L705iX|L706ie|L852i|N601i|N702iD|N702iS|N902i|N902iL|N902iS|N902iX|P702i|P702iD|P703imy...
    '6.0',
    qr/(?i-xsm:^(?:D703i|D704i|D705i|D705imyu|D903i|D903iTV|D904i|F05A|F703i|F704i|F705i|F801i|F883iES|F883iESS|F903i|F903iBSC|F903iX|F904i|L10C|N703iD|N703imyu|N704imyu|N903i|N904i|P703i|P704i|P903i|P903iTV|P903iX|P904i|SH703i|SH704i|SH705i|SH705iII...
    '7.0',
    qr/(?i-xsm:^(?:D905i|F07A|F10A|F884i|F884iES|F905i|F905iBiz|N03A|N05A|N06B|N705i|N705imyu|N706i|N706iII|N706ie|N905i|N905iBiz|N905imyu|N906iL|P705i|P705iCL|P705imyu|P706imyu|P905i|P905iTV|SH905i|SH905iTV|SO705i|SO706i|SO905i|SO905iCS)$)/,
    '7.1',
    qr/(?i-xsm:^(?:F01A|F02A|F03A|F04A|F06A|F08C|F09B|F706i|F906i|N01A|N02A|N04A|N906i|N906imyu|P01A|P02A|P03A|P04A|P05A|P06A|P10A|P706ie|P906i|SH01A|SH02A|SH03A|SH04A|SH706i|SH706iw|SH906i|SH906iTV|SO906i)$)/,
    '7.2',
];

# http://www.nttdocomo.co.jp/binary/pdf/service/developer/make/content/spec/imode_spec.pdf
$GPSModelsRe = qr/SH03D|P03D|N03D|N02D|F04D|F02D|F10C|F09C|F07C|F03C|F02C|F01C|SH11C|SH10C|SH09C|SH06C|SH05C|SH04C|SH02C|SH01C|CA01C|N05C|N03C|N02C|N01C|P05C|P04C|P03C|L01B|N05B|N04B|N02B|N01B|P06B|P04B|P02B|P01B|F09B|F07B|F06B|F04B|F03B|F02B|F01B|SH...

sub is_docomo { 1 }

sub carrier { 'I' }

sub carrier_longname { 'DoCoMo' }

sub parse {
    my $self = shift;
    my($main, $foma_or_comment) = split / /, $self->user_agent, 2;

    if ($foma_or_comment && $foma_or_comment =~ s/^\((.*)\)$/$1/) {
	# DoCoMo/1.0/P209is (Google CHTML Proxy/1.0)
	$self->{comment} = $1;
	$self->_parse_main($main);
    } elsif ($foma_or_comment) {
	# DoCoMo/2.0 N2001(c10;ser0123456789abcde;icc01234567890123456789)
	$self->{is_foma} = 1;
	@{$self}{qw(name version)} = split m!/!, $main;
	$self->_parse_foma($foma_or_comment);
    } else {
	# DoCoMo/1.0/R692i/c10
	$self->_parse_main($main);
    }

    $self->{xhtml_compliant} =
      ( $self->is_foma && !( $self->html_version && $self->html_version == 3.0 ) )
      ? 1
      : 0;
}

sub _parse_main {
    my($self, $main) = @_;
    my($name, $version, $model, $cache, @rest) = split m!/!, $main;
    $self->{name}    = $name;
    $self->{version} = $version;
    $self->{model}   = $model;
    $self->{model}   = 'SH505i' if $self->{model} eq 'SH505i2';

    if ($cache) {
	$cache =~ s/^c// or return $self->no_match;
	$self->{cache_size} = $cache;
    }

    for (@rest) {
	/^ser(\w{11})$/  and do { $self->{serial_number} = $1; next };
	/^(T[CDBJ])$/    and do { $self->{status} = $1; next };
	/^s(\d+)$/       and do { $self->{bandwidth} = $1; next };
	/^W(\d+)H(\d+)$/ and do { $self->{display_bytes} = "$1*$2"; next; };
    }
}

sub _parse_foma {
    my($self, $foma) = @_;

    $foma =~ s/^([^\(]+)// or return $self->no_match;
    $self->{model} = $1;
    $self->{model} = 'SH2101V' if $1 eq 'MST_v_SH2101V'; # Huh?

    if ($foma =~ s/^\((.*?)\)//) {
	my @options = split /;/, $1;
	for (@options) {
	    /^c(\d+)$/       and $self->{cache_size} = $1, next;
	    /^ser(\w{15})$/  and $self->{serial_number} = $1, next;
	    /^icc(\w{20})$/  and $self->{card_id} = $1, next;
	    /^(T[CDBJ])$/    and $self->{status} = $1, next;
            /^W(\d+)H(\d+)$/ and $self->{display_bytes} = "$1*$2", next;
	    $self->no_match;
	}
    }
}

sub html_version {
    my $self = shift;

    my @map = @$HTMLVerMap;
    while (my($re, $version) = splice(@map, 0, 2)) {
	return $version if $self->model =~ /$re/;
    }
    return undef;
}

sub cache_size {
    my $self = shift;
    return $self->{cache_size} || $DefaultCacheSize;
}

sub series {
    my $self = shift;
    my $model = $self->model;

    if ($self->is_foma && $model =~ /(?:\d{4}|\w\d{2}\w\d?)/) {
        return 'FOMA';
    }