root/HTTP-MobileAgent/trunk/lib/HTTP/MobileAgent.pm

Revision 875 (checked in by miyagawa, 17 years ago)

version 0.09

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1 package HTTP::MobileAgent;
2
3 use strict;
4 use vars qw($VERSION);
5 $VERSION = 0.09;
6
7 use HTTP::MobileAgent::Request;
8
9 require HTTP::MobileAgent::DoCoMo;
10 require HTTP::MobileAgent::JPhone;
11 require HTTP::MobileAgent::EZweb;
12 require HTTP::MobileAgent::AirHPhone;
13 require HTTP::MobileAgent::NonMobile;
14 require HTTP::MobileAgent::Display;
15
16 use vars qw($MobileAgentRE);
17 # this matching should be robust enough
18 # detailed analysis is done in subclass's parse()
19 my $DoCoMoRE = '^DoCoMo/\d\.\d[ /]';
20 my $JPhoneRE = '^J-PHONE/\d\.\d';
21 my $EZwebRE  = '^(?:KDDI-[A-Z]+\d+ )?UP\.Browser\/';
22 my $AirHRE   = '^Mozilla/3\.0\(DDIPOCKET\;';
23
24 $MobileAgentRE = qr/(?:($DoCoMoRE)|($JPhoneRE)|($EZwebRE)|($AirHRE))/;
25
26 sub new {
27     my($class, $stuff) = @_;
28     my $request = HTTP::MobileAgent::Request->new($stuff);
29
30     # parse UA string
31     my $ua = $request->get('User-Agent');
32     my $sub = 'NonMobile';
33     if ($ua =~ /$MobileAgentRE/) {
34         $sub = $1 ? 'DoCoMo' : $2 ? 'JPhone' : $3 ? 'EZweb' : 'AirHPhone';
35     }
36
37     my $self = bless { _request => $request }, "$class\::$sub";
38     $self->parse;
39     return $self;
40 }
41
42 sub user_agent {
43     my $self = shift;
44     $self->get_header('User-Agent');
45 }
46
47 sub get_header {
48     my($self, $header) = @_;
49     $self->{_request}->get($header);
50 }
51
52 # should be implemented in subclasses
53 sub parse { die }
54 sub _make_display { die }
55
56 sub name  { shift->{name} }
57
58 sub display {
59     my $self = shift;
60     unless ($self->{display}) {
61         $self->{display} = $self->_make_display;
62     }
63     return $self->{display};
64 }
65
66 # utility for subclasses
67 sub make_accessors {
68     my($class, @attr) = @_;
69     for my $attr (@attr) {
70         no strict 'refs';
71         *{"$class\::$attr"} = sub { shift->{$attr} };
72     }
73 }
74
75 sub no_match {
76     my $self = shift;
77     require Carp;
78     Carp::carp($self->user_agent, ": no match. Might be new variants. ",
79                "please contact the author of HTTP::MobileAgent!") if $^W;
80 }
81
82 sub is_docomo  { 0 }
83 sub is_j_phone { 0 }
84 sub is_ezweb   { 0 }
85 sub is_airh_phone { 0 }
86 sub is_non_mobile { 0 }
87
88 sub is_wap1 {
89     my $self = shift;
90     $self->is_ezweb && ! $self->is_wap2;
91 }
92
93 sub is_wap2 {
94     my $self = shift;
95     $self->is_ezweb && $self->xhtml_compliant;
96 }
97
98
99 1;
100 __END__
101
102 =head1 NAME
103
104 HTTP::MobileAgent - HTTP mobile user agent string parser
105
106 =head1 SYNOPSIS
107
108   use HTTP::MobileAgent;
109
110   my $agent = HTTP::MobileAgent->new(Apache->request);
111   # or $agent = HTTP::MobileAgent->new; to get from %ENV
112   # or $agent = HTTP::MobileAgent->new($agent_string);
113
114   if ($agent->is_docomo) {
115       # or if ($agent->name eq 'DoCoMo')
116       # or if ($agent->isa('HTTP::MobileAgent::DoCoMo'))
117       # it's NTT DoCoMo i-mode.
118       # see what's available in H::MA::DoCoMo
119   } elsif ($agent->is_j_phone) {
120       # it's J-Phone.
121       # see what's available in H::MA::JPhone
122   } elsif ($agent->is_ezweb) {
123       # it's KDDI/EZWeb.
124       # see what's available in H::MA::EZweb
125   } else {
126       # may be PC
127       # $agent is H::MA::NonMobile
128   }
129
130   my $display = $agent->display;        # HTTP::MobileAgent::Display
131   if ($display->color) { ... }
132
133 =head1 DESCRIPTION
134
135 HTTP::MobileAgent parses HTTP_USER_AGENT strings of (mainly Japanese)
136 mobile HTTP user agents. It'll be useful in page dispatching by user agents.
137
138 =head1 METHODS
139
140 Here are common methods of HTTP::MobileAgent subclasses. More agent
141 specific methods are described in each subclasses. Note that some of
142 common methods are also overrided in some subclasses.
143
144 =over 4
145
146 =item new
147
148   $agent = HTTP::MobileAgent->new;
149   $agent = HTTP::MobileAgent->new($r);  # Apache or HTTP::Request
150   $agent = HTTP::MobileAgent->new($ua_string);
151
152 parses HTTP headers and constructs HTTP::MobileAgent subclass
153 instance. If no argument is supplied, $ENV{HTTP_*} is used.
154
155 Note that you nees to pass Aapche or HTTP::Requet object to new(), as
156 some mobile agents put useful information on HTTP headers other than
157 only C<User-Agent:> (like C<x-jphone-msname> in J-Phone).
158
159 =item user_agent
160
161   print "User-Agent: ", $agent->user_agent;
162
163 returns User-Agent string.
164
165 =item name
166
167   print "name: ", $agent->name;
168
169 returns User-Agent name like 'DoCoMo'.
170
171 =item is_docomo, is_j_phone, is_ezweb, is_wap1, is_wap2, is_non_mobile
172
173    if ($agent->is_docomo) { }
174
175 returns if the agent is DoCoMo, J-Phone or EZweb.
176
177 =item display
178
179   my $display = $agent->display;
180
181 returns HTTP::MobileAgent::Display object. See
182 L<HTTP::MobileAgent::Display> for details.
183
184 =back
185
186 =head1 WARNINGS
187
188 Following warnings might be raised when C<$^W> is on.
189
190 =over 4
191
192 =item "%s: no match. Might be new variants. please contact the author of HTTP::MobileAgent!"
193
194 User-Agent: string does not match patterns provided in subclasses. It
195 may be faked user-agent or a new variant. Feel free to mail me to
196 inform this.
197
198 =back
199
200 =head1 NOTE
201
202 =over 4
203
204 =item "Why not adding this module as an extension of HTTP::BrowserDetect?"
205
206 Yep, I tried to do. But the module's code seems hard enough for me to
207 extend and don't want to bother the author for this mobile-specific
208 features. So I made this module as a separated one.
209
210 =back
211
212 =head1 MORE IMPLEMENTATIONS
213
214 If you have any idea / request for this module to add new subclass,
215 I'm open to the discussion or (more preferable) patches. Feel free to
216 mail me.
217
218 =head1 AUTHOR
219
220 Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
221
222 This library is free software; you can redistribute it and/or modify
223 it under the same terms as Perl itself.
224
225 =head1 SEE ALSO
226
227 L<HTTP::MobileAgent::DoCoMo>, L<HTTP::MobileAgent::JPhone>,
228 L<HTTP::MobileAgent::EZweb>, L<HTTP::MobileAgent::NonMobile>,
229 L<HTTP::MobileAgent::Display>, L<HTTP::BrowserDetect>
230
231 Reference URL for specification is listed in Pods for each subclass.
232
233 =cut
Note: See TracBrowser for help on using the browser.