File Coverage

blib/lib/Duadua/Parser.pm
Criterion Covered Total %
statement 42 42 100.0
branch 18 20 90.0
condition 12 12 100.0
subroutine 6 6 100.0
pod 1 1 100.0
total 79 81 97.5


line stmt bran cond sub pod time code
1             package Duadua::Parser;
2 6     6   41 use strict;
  6         11  
  6         167  
3 6     6   27 use warnings;
  6         12  
  6         129  
4 6     6   1900 use Duadua::Util;
  6         14  
  6         4143  
5              
6             my $BLANK_UA = {
7             name => 'UNKNOWN',
8             };
9              
10             sub parse {
11 411     411 1 850 my ($class, $d) = @_;
12              
13 411         562 for my $m (@{$d->parsers}) {
  411         832  
14 10661 100       34341 if ( my $res = $m->try($d) ) {
15 383         1540 return $res;
16             }
17             }
18              
19             # Blank or '-'
20 28 100 100     81 if ($d->ua eq '' || $d->ua eq '-') {
21 3         24 return $BLANK_UA;
22             }
23              
24 25 100       185 if ( my $browser = $class->_detect_general_browser($d) ) {
25 2         6 return $browser;
26             }
27              
28 23 100       114 if ( my $bot = $class->_detect_general_bot($d) ) {
29 18         71 return $bot;
30             }
31              
32 5         19 return $BLANK_UA;
33             }
34              
35             sub _detect_general_browser {
36 25     25   130 my ($class, $d) = @_;
37              
38 25         53 my %h = %{$BLANK_UA};
  25         127  
39              
40 25 100 100     76 if ( index($d->ua, 'Mozilla/') == 0 && index($d->ua, 'rowser') > 0 ) {
41 2 50       8 if ( $d->ua =~ m![^a-zA-Z]([a-zA-Z]+[bB]rowser)/([\d.]+)! ) {
42 2         11 ($h{name}, $h{version}) = ($1, $2);
43 2         10 return Duadua::Util->set_os($d, \%h);
44             }
45             }
46             }
47              
48             sub _detect_general_bot {
49 23     23   59 my ($class, $d) = @_;
50              
51 23         41 my %h = %{$BLANK_UA};
  23         74  
52              
53 23 100 100     74 if ( index($d->ua, 'http://') > -1 || index($d->ua, 'https://') > -1 ) {
54 18         55 $h{is_bot} = 1;
55 18 100 100     44 if ( index($d->ua, 'Mozilla/') != 0 && $d->ua =~ m!^([^/;]+)/(v?[\d.]+)! ) {
    100          
    50          
56 9         53 my ($name, $version) = ($1, $2);
57 9         24 $h{name} = $name;
58 9         25 $h{version} = $version;
59             }
60             elsif ( $d->ua =~ m![\s\(]([^/\s:;]+(?:bot|crawl|crawler|spider|fetcher))/(v?[\d.]+)!i ) {
61 8         43 my ($name, $version) = ($1, $2);
62 8         22 $h{name} = $1;
63 8         21 $h{version} = $version;
64             }
65             elsif ( $d->ua =~ m!([a-zA-Z0-9\-\_\.\!]+(?:bot|crawler))!i ) {
66 1         5 $h{name} = $1;
67             }
68              
69 18         93 return \%h;
70             }
71             }
72              
73             1;
74              
75             __END__