File Coverage

blib/lib/HTTP/DetectUserAgent.pm
Criterion Covered Total %
statement 188 280 67.1
branch 126 180 70.0
condition 32 61 52.4
subroutine 21 21 100.0
pod 1 2 50.0
total 368 544 67.6


line stmt bran cond sub pod time code
1             package HTTP::DetectUserAgent;
2              
3 7     7   574577 use warnings;
  7         18  
  7         196  
4 7     7   34 use strict;
  7         15  
  7         124  
5 7     7   155 use 5.006;
  7         24  
6             #use Carp;
7             our $VERSION = '0.05';
8 7     7   37 use base qw(Class::Accessor);
  7         11  
  7         901  
9              
10             __PACKAGE__->mk_accessors(qw(name version vendor type os));
11              
12             sub new {
13 39     39 1 320482 my ( $class, $user_agent ) = @_;
14 39         79 my $self = {};
15 39         76 bless $self, $class;
16 39 50       125 unless( defined $user_agent ){
17 0         0 $user_agent = $ENV{'HTTP_USER_AGENT'};
18             }
19 39         109 $self->user_agent($user_agent);
20 39         100 return $self;
21             }
22              
23             sub user_agent {
24 39     39 0 61 my ( $self, $user_agent ) = @_;
25 39 50       132 if( defined $user_agent ){
26 39         127 $self->{user_agent} = $user_agent;
27 39         94 $self->_parse();
28             }
29 39         86 return $self->{user_agent};
30             }
31              
32             sub _parse {
33 39     39   59 my $self = shift;
34 39         105 my $ua = lc $self->{user_agent};
35 39         101 $self->_parse_name($ua);
36 39 100       124 if( $self->{type} eq 'Browser' ){
37 14         47 $self->_parse_os($ua);
38             }
39             }
40              
41             sub _parse_name {
42 39     39   61 my ( $self, $ua ) = @_;
43 39 100       109 return if( $self->_check_crawler($ua) );
44 24 100       74 if( index($ua,'opera') != -1){
45 1         5 $self->_check_opera($ua);
46 1         2 return;
47             }
48 23         59 my $block = $self->_parse_block($ua);
49 23 100 100     156 if( $block->{applewebkit} ){
    100          
    100          
50 3         12 $self->_check_webkit( $ua, $block );
51             }elsif( $block->{'_comment'}
52             && index($block->{'_comment'}, 'msie' ) != -1 ){
53 6         16 $self->_check_ie($ua, $block);
54             }elsif( $block->{gecko} ){
55 1         5 $self->_check_gecko( $ua, $block );
56             }else{
57 13 100 66     43 $self->_check_mobile( $ua, $block ) ||
      66        
      66        
      100        
58             $self->_check_mobile_pc_viewer( $ua, $block ) ||
59             $self->_check_other_browsers( $ua, $block ) ||
60             $self->_check_webservice($ua, $block ) ||
61             $self->_check_robot( $ua, $block ) ||
62             $self->_check_portable($ua, $block );
63             }
64 23 50       101 if( !$self->{name} ){
65 0         0 $self->{name} = 'Unknown';
66 0         0 $self->{type} = 'Unknown';
67             }
68             }
69              
70             sub _parse_block {
71 23     23   39 my ( $self, $ua ) = @_;
72              
73 23 50       54 return {} unless $ua;
74 23         75 my $reg = qr{(\([^()]+\))|(\S+?)/(\S+)|(\S+)};
75 23         44 my %block = ();
76 23         157 while( $ua =~ /$reg/g ){
77 80 100       270 if( $1 ){
    100          
    50          
78 19   100     188 $block{_comment} = ($block{_comment}||'').$1;
79             }elsif( $2 ){
80 49         346 $block{$2} = $3;
81             }elsif( $4 ){
82 12   100     122 $block{_illigal} = ($block{_illigal}||'').':'.$4;
83             }
84             }
85 23         78 return \%block;
86             }
87              
88             sub _check_crawler {
89 39     39   56 my ( $self, $ua ) = @_;
90 39 100 33     830 if( index($ua,'googlebot') != -1){
    50 33        
    50          
    100          
    100          
    100          
    100          
    100          
    50          
    50          
    50          
    50          
    50          
    100          
    100          
    100          
    50          
91             # http://www.google.com/bot.html
92 3 100       9 if( index($ua,'mobile') != -1 ){
93 2         6 $self->{name} = 'Googlebot Mobile';
94             }else{
95 1         3 $self->{name} = 'Googlebot';
96             }
97 3         7 $self->{vendor} = 'Google';
98             }elsif( index($ua,'mediapartners-google') != -1){
99 0         0 $self->{name} = 'Googlebot Mediapartners';
100 0         0 $self->{vendor} = 'Google';
101             }elsif( index($ua,'feedfetcher-google') != -1){
102 0         0 $self->{name} = 'Googlebot Feedfetcher';
103 0         0 $self->{vendor} = 'Google';
104             }elsif( index($ua, 'yahoo') != -1){
105 3 100 33     50 if( index($ua, 'slurp') != -1){
    50          
    50          
    50          
    100          
106             # http://help.yahoo.com/help/us/ysearch/slurp
107 1         3 $self->{name} = 'Yahoo! Slurp';
108 1         4 $self->{vendor} = 'Yahoo';
109             }elsif( index($ua, 'y!j-srd') != -1 || index($ua, 'y!j-mbs') != -1 ){
110             # http://help.yahoo.co.jp/help/jp/search/indexing/indexing-27.html
111 0         0 $self->{name} = 'Yahoo! Japan Mobile Crawler';
112 0         0 $self->{vendor} = 'Yahoo';
113             }elsif( index($ua, 'y!j-bsc') != -1){
114             # http://help.yahoo.co.jp/help/jp/blog-search/
115 0         0 $self->{name} = 'Yahoo! Japan Blog Crawler';
116 0         0 $self->{vendor} = 'Yahoo';
117             }elsif( index($ua, 'y!j-') != -1){
118             # http://help.yahoo.co.jp/help/jp/search/indexing/indexing-15.html
119 0         0 $self->{name} = 'Yahoo! Japan Crawler';
120 0         0 $self->{vendor} = 'Yahoo';
121             }elsif( index($ua, 'yahoofeedseeker') != -1){
122 1         20 $self->{name} = 'YahooFeedSeeker';
123 1         3 $self->{vendor} = 'Yahoo';
124             }
125             }elsif( index($ua, 'msnbot') != -1){
126             # http://search.msn.com/msnbot.htm
127 1         3 $self->{name} = 'msnbot';
128 1         4 $self->{vendor} = 'Microsoft';
129             }elsif( index($ua, 'twiceler') != -1){
130             # http://www.cuil.com/twiceler/robot.html
131 1         3 $self->{name} = 'Twiceler';
132 1         2 $self->{vendor} = 'Cuil';
133             }elsif( index($ua, 'baiduspider') != -1){
134             # http://help.baidu.jp/system/05.html
135 1         3 $self->{name} = 'Baiduspider';
136 1         3 $self->{vendor} = 'Baidu';
137             }elsif( index($ua, 'baidumobaider') != -1){
138             # http://help.baidu.jp/system/05.html
139 4         5 $self->{name} = 'BaiduMobaider';
140 4         9 $self->{vendor} = 'Baidu';
141             }elsif( index($ua, 'yeti') != -1 && index($ua, 'naver') != -1){
142             # http://help.naver.com/robots/
143 0         0 $self->{name} = 'Yeti';
144 0         0 $self->{vendor} = 'Naver';
145             }elsif( index($ua, 'ichiro') != -1){
146             # http://help.goo.ne.jp/door/crawler.html)
147 0         0 $self->{name} = 'ichiro';
148 0         0 $self->{vendor} = 'goo';
149             }elsif( index($ua, 'moba-crawler') != -1){
150             # http://crawler.dena.jp/
151 0         0 $self->{name} = 'moba-crawler';
152 0         0 $self->{vendor} = 'DeNA';
153             }elsif( index($ua, 'masagool') != -1){
154             # http://sagool.jp/
155 0         0 $self->{name} = 'MaSagool';
156 0         0 $self->{vendor} = 'Sagool';
157             }elsif( index($ua, 'ia_archiver') != -1){
158             # http://www.archive.org/
159 0         0 $self->{name} = 'Internet Archive';
160 0         0 $self->{vendor} = 'Internet Archive';
161             }elsif( index($ua, 'tagoobot') != -1){
162             # http://www.tagoo.ru
163 1         3 $self->{name} = 'Tagoobot';
164 1         2 $self->{vendor} = 'Tagoo';
165             }elsif( index($ua, 'sogou web spider') != -1){
166             #http://www.sogou.com/docs/help/webmasters.htm#07
167 1         3 $self->{name} = 'Sogou';
168 1         2 $self->{vendor} = 'Sogou';
169             }elsif( index($ua, 'daumoa') != -1){
170             #http://ws.daum.net/aboutWebSearch.html
171 1         2 $self->{name} = 'Daumoa';
172 1         3 $self->{vendor} = 'Daum';
173             }elsif( index($ua, 'spider') != -1 || index($ua, 'crawler') != -1 ){
174 0         0 $self->{name} = 'Unknown Crawler';
175             }
176 39 100       115 if( $self->{name} ){
177 15         29 $self->{type} = 'Crawler';
178 15         48 return 1;
179             }
180 24         68 return 0;
181             }
182              
183             sub _check_robot {
184 4     4   8 my ( $self, $ua, $block ) = @_;
185 4 50       39 if( $block->{'libwww-perl'} ){
    100          
    50          
    50          
    50          
    50          
    50          
    50          
186 0         0 $self->{name} = 'LWP';
187 0         0 $self->{version} = $block->{'libwww-perl'};
188             }elsif( $block->{'web::scraper'} ){
189 1         2 $self->{name} = 'Web::Scraper';
190 1         3 $self->{version} = $block->{'web::scraper'};
191             }elsif( $block->{php} ){
192 0         0 $self->{name} = 'PHP';
193 0         0 $self->{version} = $block->{php};
194             }elsif( $block->{java} ){
195 0         0 $self->{name} = 'Java';
196 0         0 $self->{version} = $block->{java};
197             }elsif( $block->{wget} ){
198 0         0 $self->{name} = 'Wget';
199 0         0 $self->{version} = $block->{wget};
200             }elsif( $block->{curl} ){
201 0         0 $self->{name} = 'Curl';
202 0         0 $self->{version} = $block->{curl};
203             }elsif( index( $ua, 'h2tconv' ) != -1 ){
204 0         0 $self->{name} = 'H2Tconv';
205 0         0 $self->{version} = 'Unknown';
206             }elsif( $block->{plagger} ){
207 0         0 $self->{name} = 'Plagger';
208 0         0 $self->{version} = $block->{plagger};
209             }
210 4 100       11 if( $self->{name} ){
211 1         2 $self->{type} = 'Robot';
212 1         5 return 1;
213             }
214 3         15 return 0;
215             }
216              
217             sub _check_webservice {
218 8     8   16 my ( $self, $ua, $block ) = @_;
219 8 100       51 if( index( $ua, 'hatena bookmark') != -1 ){
    100          
    100          
    100          
220 1         3 $self->{name} = 'Hatena Bookmark';
221 1         3 $self->{version} = $block->{bookmark};
222 1         2 $self->{vendor} = 'Hatena';
223             }elsif( index( $ua, 'hatena antenna') != -1 ){
224 1         4 $self->{name} = 'Hatena Antenna';
225 1         3 $self->{version} = $block->{antenna};
226 1         2 $self->{vendor} = 'Hatena';
227             }elsif( $ua =~ /yahoo pipes ([\d.]+)/ ){
228 1         3 $self->{name} = 'Yahoo Pipes';
229 1         3 $self->{version} = $1;
230 1         2 $self->{vendor} = 'Yahoo';
231             }elsif( $block->{pathtraq} ){
232 1         3 $self->{name} = 'Pathtraq';
233 1         29 $self->{version} = $block->{pathtraq};
234 1         2 $self->{vendor} = 'Cybozu Labs';
235             }
236 8 100       28 if( $self->{name} ){
237 4         7 $self->{type} = 'Robot';
238 4         21 return 1;
239             }
240 4         25 return 0;
241             }
242              
243             sub _check_opera {
244 1     1   2 my ( $self, $ua ) = @_;
245 1         3 $self->{engine} = 'Opera';
246 1         3 $self->{type} = 'Browser';
247 1         2 $self->{name} = 'Opera';
248 1         3 $self->{vendor} = 'Opera';
249 1 50       8 if( $ua =~ m{opera(?:/|\s+)([\d.]+)} ){
250 1         6 $self->{version} = $1;
251             }else{
252 0         0 $self->{version} = 'Unknown';
253             }
254 1         3 return 1;
255             }
256              
257             sub _check_webkit {
258 3     3   7 my ( $self, $ua, $block ) = @_;
259 3         7 $self->{engine} = 'WebKit';
260 3         7 $self->{type} = 'Browser';
261 3 100       19 if( $block->{chrome} ){
    50          
    50          
    50          
262 1         3 $self->{name} = 'Chrome';
263 1         3 $self->{version} = $block->{chrome};
264 1         3 $self->{vendor} = 'Google';
265             }elsif( $block->{omniweb} ){
266 0         0 $self->{name} = 'OmniWeb';
267 0         0 $self->{version} = $block->{omniweb};
268 0         0 $self->{vendor} = 'The Omni Group';
269             }elsif( $block->{shiira} ){
270 0         0 $self->{name} = 'Shiira';
271 0         0 $self->{version} = $block->{shiira};
272 0         0 $self->{vendor} = 'Shiira Project';
273             }elsif( $block->{safari} ){
274 2         5 $self->{name} = 'Safari';
275 2   33     8 $self->{version} = $block->{version} || $block->{shiira};
276 2         4 $self->{vendor} = 'Apple';
277             }else{
278 0         0 $self->{name} = 'WebKit';
279 0         0 $self->{version} = $block->{webkit};
280             }
281             }
282              
283             sub _check_ie {
284 6     6   11 my ( $self, $ua, $block ) = @_;
285 6         14 $self->{engine} = 'Internet Explorer';
286 6         12 $self->{type} = 'Browser';
287 6 100       47 if( $block->{sleipnir} ){
    100          
    50          
    50          
288 1         3 $self->{name} = 'Sleipnir';
289 1         3 $self->{version} = $block->{sleipnir};
290 1         3 $self->{vendor} = 'Fenrir';
291             }elsif( $block->{_comment} =~ /lunascape\s+([\d.]+)/){
292 1         4 $self->{name} = 'Lunascape';
293 1         3 $self->{version} = $1;
294 1         2 $self->{vendor} = 'Lunascape';
295             }elsif( $block->{_comment} =~ m{kiki/([\d.]+)}){
296 0         0 $self->{name} = 'KIKI';
297 0         0 $self->{version} = $1;
298 0         0 $self->{vendor} = 'http://www.din.or.jp/~blmzf/index.html';
299             }elsif( $block->{_comment} =~ /msie\s+([\d.]+)/){
300 4         7 $self->{name} = 'Internet Explorer';
301 4         10 $self->{version} = $1;
302 4         10 $self->{vendor} = 'Microsoft';
303             }
304             }
305              
306             sub _check_gecko {
307 1     1   3 my ( $self, $ua, $block ) = @_;
308 1         2 $self->{engine} = 'Gecko';
309 1         4 $self->{type} = 'Browser';
310 1 50 33     8 if( $block->{flock} ){
    50 0        
    0          
    0          
    0          
    0          
311 0         0 $self->{name} = 'Flock';
312 0         0 $self->{version} = $block->{flock};
313 0         0 $self->{vendor} = 'Flock';
314             }elsif( $block->{firefox} ||
315             $block->{granparadiso} ||
316             $block->{bonecho} ){
317 1         3 $self->{name} = 'Firefox';
318             $self->{version} = $block->{firefox} ||
319             $block->{granparadiso} ||
320 1   0     7 $block->{bonecho};
321 1 50       6 if( $self->{version} =~ /(^[^;,]+)/ ){
322 1         3 $self->{version} = $1;
323             }
324 1         3 $self->{vendor} = 'Mozilla';
325             }elsif( $block->{netscape} ){
326 0         0 $self->{name} = 'Netscape';
327 0         0 $self->{version} = $block->{netscape};
328 0         0 $self->{vendor} = 'Mozilla';
329             }elsif( $block->{iceweasel} ){
330 0         0 $self->{name} = 'Iceweasel';
331 0         0 $self->{version} = $block->{iceweasel};
332 0         0 $self->{vendor} = 'Debian Project';
333             }elsif( $block->{seamonkey} ){
334 0         0 $self->{name} = 'SeaMonkey';
335 0         0 $self->{version} = $block->{seamonkey};
336 0         0 $self->{vendor} = 'SeaMonkey Council';
337             }elsif( $block->{camino} ){
338 0         0 $self->{name} = 'Camino';
339 0         0 $self->{version} = $block->{camino};
340 0         0 $self->{vendor} = 'The Camino Project';
341             }else{
342 0         0 $self->{name} = 'Gecko';
343 0         0 $self->{version} = $block->{gecko};
344 0         0 $self->{vendor} = 'Unknown';
345             }
346             }
347              
348             sub _check_mobile {
349 13     13   27 my ( $self, $ua, $block ) = @_;
350 13   33     42 $ua = $self->{user_agent} || $ua;
351 13 100 66     132 if( $block->{docomo} ){
    100 66        
    100          
352 1         3 $self->{name} = 'docomo';
353 1 50       7 if( $ua =~ m{DoCoMo/\d\.\d[/\s]+([A-Za-z0-9]+)} ){
354 1         3 $self->{version} = $1;
355             }else{
356 0         0 $self->{version} = "Unknown";
357             }
358 1         3 $self->{vendor} = 'docomo';
359             }elsif( $block->{'up.browser'} && $ua =~ /^KDDI-(\S+)/ ){
360 1         3 $self->{name} = 'au';
361 1         3 $self->{version} = $1;
362 1         2 $self->{vendor} = 'KDDI';
363             }elsif( my $softbank =
364             $block->{softbank} ||
365             $block->{vodafone} ||
366             $block->{'j-phone'} ){
367 3 50       17 if( $ua =~ m{(?:SoftBank|Vodafone|J-PHONE)/[\d.]+/([A-Za-z0-9]+)} ){
368 3         7 $self->{name} = 'SoftBank';
369 3         7 $self->{version} = $1;
370 3         7 $self->{vendor} = 'SoftBank';
371             }
372             }
373 13 100       73 if( $self->{name} ){
374 5         11 $self->{type} = 'Mobile';
375 5         19 return 1;
376             }
377 8         42 return 0;
378             }
379              
380             sub _check_mobile_pc_viewer {
381 8     8   16 my ( $self, $ua, $block ) = @_;
382 8   33     30 $ua = $self->{user_agent} || $ua;
383 8 50 66     63 if( $ua =~ /jig browser(?: web)?(?:\D+([\d.]+))*/ ){
    50          
    50          
384 0         0 $self->{name} = 'Jig Browser';
385 0   0     0 $self->{version} = $1 || 'Unknown';
386 0         0 $self->{vendor} = 'jig';
387             }elsif( $ua =~ /ibisBrowser/ ){
388 0         0 $self->{name} = 'ibisBrowser';
389 0         0 $self->{version} = 'Unknown';
390 0         0 $self->{vendor} = 'ibis';
391             }elsif( $block->{mozilla} && $ua =~ /([A-Za-z0-9]+);\s*FOMA/ ){
392 0         0 $self->{name} = 'FOMA Full Browser';
393 0         0 $self->{version} = $1;
394 0         0 $self->{vendor} = 'DoCoMo';
395             }
396 8 50       23 if( $self->{name} ){
397 0         0 $self->{type} = 'Browser';
398 0         0 return 1;
399             }
400 8         47 return 0;
401             }
402              
403             sub _check_other_browsers {
404 8     8   16 my ( $self, $ua, $block ) = @_;
405 8 50       72 if( $block->{lynx} ){
    50          
    50          
406 0         0 $self->{name} = 'Lynx';
407 0         0 $self->{version} = $block->{lynx};
408 0         0 $self->{vendor} = 'The University of Kansas';
409             }elsif( $block->{w3m} ){
410 0         0 $self->{name} = 'w3m';
411 0         0 $self->{version} = $block->{w3m};
412 0         0 $self->{vendor} = 'Akinori Ito';
413             }elsif( $ua =~ m{konqueror/([\d.]+)} ){
414 0         0 $self->{name} = 'Konqueror';
415 0         0 $self->{version} = $1;
416 0         0 $self->{vendor} = 'KDE Team';
417             }
418 8 50       22 if( $self->{name} ){
419 0         0 $self->{type} = 'Browser';
420 0         0 return 1;
421             }
422 8         66 return 0;
423             }
424              
425             sub _check_portable {
426 3     3   6 my ( $self, $ua, $block ) = @_;
427 3 100       27 if( $ua =~ /playstation portable(?:\D+([\d.]+))*/ ){
    50          
428 2         5 $self->{name} = 'PSP';
429 2   100     10 $self->{version} = $1 || 'Unknown';
430 2         4 $self->{vendor} = 'Sony';
431             }elsif( $ua =~ /playstation 3(?:\D+([\d.]+))*/ ){
432 1         3 $self->{name} = 'Playstation 3';
433 1   50     5 $self->{version} = $1 || 'Unknown';
434 1         2 $self->{vendor} = 'Sony';
435             }
436 3 50       9 if( $self->{name} ){
437 3         7 $self->{type} = 'Browser';
438 3         6 return 1;
439             }
440             }
441              
442             sub _parse_os {
443 14     14   19 my ( $self, $ua ) = @_;
444 14 50       28 return unless $ua;
445 14 100       104 if( $ua =~ /iphone/ ){
    100          
    100          
    50          
446 1         4 $self->{os} = 'iPhone OS';
447             }elsif( $ua =~ /win(?:9[58]|dows|nt)/ ){
448 9         28 $self->{os} = 'Windows';
449             }elsif( $ua =~ /mac(?:intosh|_(?:powerpc|68000))/ ){
450 1         4 $self->{os} = 'Macintosh';
451             }elsif( $ua =~ /x11/ ){
452 0           $self->{os} = 'X11';
453             }
454             }
455              
456             1;
457              
458             __END__