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   879 use strict;
  6         11  
  6         167  
3 6     6   26 use warnings;
  6         11  
  6         133  
4 6     6   1888 use Duadua::Util;
  6         14  
  6         4141  
5              
6             my $BLANK_UA = {
7             name => 'UNKNOWN',
8             };
9              
10             sub parse {
11 412     412 1 760 my ($class, $d) = @_;
12              
13 412         544 for my $m (@{$d->parsers}) {
  412         827  
14 10885 100       34337 if ( my $res = $m->try($d) ) {
15 384         1581 return $res;
16             }
17             }
18              
19             # Blank or '-'
20 28 100 100     71 if ($d->ua eq '' || $d->ua eq '-') {
21 3         18 return $BLANK_UA;
22             }
23              
24 25 100       87 if ( my $browser = $class->_detect_general_browser($d) ) {
25 2         8 return $browser;
26             }
27              
28 23 100       81 if ( my $bot = $class->_detect_general_bot($d) ) {
29 18         70 return $bot;
30             }
31              
32 5         21 return $BLANK_UA;
33             }
34              
35             sub _detect_general_browser {
36 25     25   57 my ($class, $d) = @_;
37              
38 25         41 my %h = %{$BLANK_UA};
  25         115  
39              
40 25 100 100     77 if ( index($d->ua, 'Mozilla/') == 0 && index($d->ua, 'rowser') > 0 ) {
41 2 50       6 if ( $d->ua =~ m![^a-zA-Z]([a-zA-Z]+[bB]rowser)/([\d.]+)! ) {
42 2         16 ($h{name}, $h{version}) = ($1, $2);
43 2         11 return Duadua::Util->set_os($d, \%h);
44             }
45             }
46             }
47              
48             sub _detect_general_bot {
49 23     23   56 my ($class, $d) = @_;
50              
51 23         33 my %h = %{$BLANK_UA};
  23         69  
52              
53 23 100 100     54 if ( index($d->ua, 'http://') > -1 || index($d->ua, 'https://') > -1 ) {
54 18         38 $h{is_bot} = 1;
55 18 100 100     39 if ( index($d->ua, 'Mozilla/') != 0 && $d->ua =~ m!^([^/;]+)/(v?[\d.]+)! ) {
    100          
    50          
56 9         52 my ($name, $version) = ($1, $2);
57 9         21 $h{name} = $name;
58 9         39 $h{version} = $version;
59             }
60             elsif ( $d->ua =~ m![\s\(]([^/\s:;]+(?:bot|crawl|crawler|spider|fetcher))/(v?[\d.]+)!i ) {
61 8         52 my ($name, $version) = ($1, $2);
62 8         21 $h{name} = $1;
63 8         20 $h{version} = $version;
64             }
65             elsif ( $d->ua =~ m!([a-zA-Z0-9\-\_\.\!]+(?:bot|crawler))!i ) {
66 1         4 $h{name} = $1;
67             }
68              
69 18         83 return \%h;
70             }
71             }
72              
73             1;
74              
75             __END__