package HTTP::MobileAgent;
use strict;
use vars qw($VERSION);
$VERSION = 0.18;
use HTTP::MobileAgent::Request;
require HTTP::MobileAgent::DoCoMo;
require HTTP::MobileAgent::JPhone;
require HTTP::MobileAgent::EZweb;
require HTTP::MobileAgent::AirHPhone;
require HTTP::MobileAgent::NonMobile;
require HTTP::MobileAgent::Display;
use vars qw($MobileAgentRE);
# this matching should be robust enough
# detailed analysis is done in subclass's parse()
my $DoCoMoRE = '^DoCoMo/\d\.\d[ /]';
my $JPhoneRE = '^J-PHONE/\d\.\d';
my $EZwebRE = '^(?:KDDI-[A-Z]+\d+ )?UP\.Browser\/';
my $AirHRE = '^Mozilla/3\.0\(DDIPOCKET\;';
$MobileAgentRE = qr/(?:($DoCoMoRE)|($JPhoneRE)|($EZwebRE)|($AirHRE))/;
sub new {
my($class, $stuff) = @_;
my $request = HTTP::MobileAgent::Request->new($stuff);
# parse UA string
my $ua = $request->get('User-Agent');
my $sub = 'NonMobile';
if ($ua =~ /$MobileAgentRE/) {
$sub = $1 ? 'DoCoMo' : $2 ? 'JPhone' : $3 ? 'EZweb' : 'AirHPhone';
}
my $self = bless { _request => $request }, "$class\::$sub";
$self->parse;
return $self;
}
sub user_agent {
my $self = shift;
$self->get_header('User-Agent');
}
sub get_header {
my($self, $header) = @_;
$self->{_request}->get($header);
}
# should be implemented in subclasses
sub parse { die }
sub _make_display { die }
sub name { shift->{name} }
sub display {
my $self = shift;
unless ($self->{display}) {
$self->{display} = $self->_make_display;
}
return $self->{display};
}
# utility for subclasses
sub make_accessors {
my($class, @attr) = @_;
for my $attr (@attr) {
no strict 'refs';
*{"$class\::$attr"} = sub { shift->{$attr} };
}
}
sub no_match {
my $self = shift;
require Carp;
Carp::carp($self->user_agent, ": no match. Might be new variants. ",
"please contact the author of HTTP::MobileAgent!") if $^W;
}
sub is_docomo { 0 }
sub is_j_phone { 0 }
sub is_ezweb { 0 }
sub is_airh_phone { 0 }
sub is_non_mobile { 0 }
sub is_wap1 {
my $self = shift;
$self->is_ezweb && ! $self->is_wap2;
}
sub is_wap2 {
my $self = shift;
$self->is_ezweb && $self->xhtml_compliant;
}
1;
__END__
=head1 NAME
HTTP::MobileAgent - HTTP mobile user agent string parser
=head1 SYNOPSIS
use HTTP::MobileAgent;
my $agent = HTTP::MobileAgent->new(Apache->request);
# or $agent = HTTP::MobileAgent->new; to get from %ENV
# or $agent = HTTP::MobileAgent->new($agent_string);
if ($agent->is_docomo) {
# or if ($agent->name eq 'DoCoMo')
# or if ($agent->isa('HTTP::MobileAgent::DoCoMo'))
# it's NTT DoCoMo i-mode.
# see what's available in H::MA::DoCoMo
} elsif ($agent->is_j_phone) {
# it's J-Phone.
# see what's available in H::MA::JPhone
} elsif ($agent->is_ezweb) {
# it's KDDI/EZWeb.
# see what's available in H::MA::EZweb
} else {
# may be PC
# $agent is H::MA::NonMobile
}
my $display = $agent->display; # HTTP::MobileAgent::Display
if ($display->color) { ... }
=head1 DESCRIPTION
HTTP::MobileAgent parses HTTP_USER_AGENT strings of (mainly Japanese)
mobile HTTP user agents. It'll be useful in page dispatching by user agents.
=head1 METHODS
Here are common methods of HTTP::MobileAgent subclasses. More agent
specific methods are described in each subclasses. Note that some of
common methods are also overrided in some subclasses.
=over 4
=item new
$agent = HTTP::MobileAgent->new;
$agent = HTTP::MobileAgent->new($r); # Apache or HTTP::Request
$agent = HTTP::MobileAgent->new($ua_string);
parses HTTP headers and constructs HTTP::MobileAgent subclass
instance. If no argument is supplied, $ENV{HTTP_*} is used.
Note that you nees to pass Aapche or HTTP::Requet object to new(), as
some mobile agents put useful information on HTTP headers other than
only C<User-Agent:> (like C<x-jphone-msname> in J-Phone).
=item user_agent
print "User-Agent: ", $agent->user_agent;
returns User-Agent string.
=item name
print "name: ", $agent->name;
returns User-Agent name like 'DoCoMo'.
=item is_docomo, is_j_phone, is_ezweb, is_wap1, is_wap2, is_non_mobile
if ($agent->is_docomo) { }
returns if the agent is DoCoMo, J-Phone or EZweb.
=item display
my $display = $agent->display;
returns HTTP::MobileAgent::Display object. See
L<HTTP::MobileAgent::Display> for details.
=back
=head1 WARNINGS
Following warnings might be raised when C<$^W> is on.
=over 4
=item "%s: no match. Might be new variants. please contact the author of HTTP::MobileAgent!"
User-Agent: string does not match patterns provided in subclasses. It
may be faked user-agent or a new variant. Feel free to mail me to
inform this.
=back
=head1 NOTE
=over 4
=item "Why not adding this module as an extension of HTTP::BrowserDetect?"
Yep, I tried to do. But the module's code seems hard enough for me to
extend and don't want to bother the author for this mobile-specific
features. So I made this module as a separated one.
=back
=head1 MORE IMPLEMENTATIONS
If you have any idea / request for this module to add new subclass,
I'm open to the discussion or (more preferable) patches. Feel free to
mail me.
=head1 OTHER LANGUAGE BINDINGS
This module is now ported to PHP as Net::UserAgent::Mobile by Atsuhiro
KUBO. See http://pear.php.net/package-info.php?pacid=180 for details.
=head1 AUTHOR
Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 SEE ALSO
L<HTTP::MobileAgent::DoCoMo>, L<HTTP::MobileAgent::JPhone>,
L<HTTP::MobileAgent::EZweb>, L<HTTP::MobileAgent::NonMobile>,
L<HTTP::MobileAgent::Display>, L<HTTP::BrowserDetect>
Reference URL for specification is listed in Pods for each subclass.
=cut