File Coverage

blib/lib/CGI/BrowserDetect.pm
Criterion Covered Total %
statement 33 33 100.0
branch 14 14 100.0
condition 4 6 66.6
subroutine 11 11 100.0
pod 7 7 100.0
total 69 71 97.1


line stmt bran cond sub pod time code
1             package CGI::BrowserDetect;
2 2     2   112652 use 5.006; use strict; use warnings; our $VERSION = '0.03';
  2     2   16  
  2     2   8  
  2         4  
  2         40  
  2         9  
  2         3  
  2         89  
3 2     2   11 use base qw/HTTP::BrowserDetect/;
  2         3  
  2         1464  
4              
5             sub new {
6 4     4 1 1736 my $pkg = shift;
7 4         7 my $count = scalar @_;
8              
9 4 100       20 my %args = $count == 2
    100          
10             ? (HTTP_USER_AGENT => shift, HTTP_ACCEPT_LANGUAGE => shift)
11             : $count == 1
12             ? (HTTP_USER_AGENT => shift)
13             : @_;
14              
15 4         18 my $self = $pkg->SUPER::new($args{HTTP_USER_AGENT});
16              
17 4 100       279 if ($args{HTTP_ACCEPT_LANGUAGE}) {
18 2         5 $self->{accept_language} = $args{HTTP_ACCEPT_LANGUAGE};
19 2         13 ($self->{_lang}, $self->{_cnty}) = $self->{accept_language} =~ /([a-z]{2})\-([A-Z]{2})/;
20             }
21              
22 4         23 return $self;
23             }
24              
25             sub detect {
26 4     4 1 25 my ($self, @want) = @_;
27             my %provide = map {
28 4 100       8 $self->$_ ? ( $_ => $self->$_ ) : ()
  24         618  
29             } @want;
30 4 100       58 return wantarray ? %provide : \%provide;
31             }
32              
33             sub device_type {
34 8     8 1 55 my ($self) = @_;
35              
36 8 100       19 return $self->mobile
    100          
37             ? 'mobile'
38             : $self->tablet
39             ? 'tablet'
40             : 'computer';
41             }
42              
43 4     4 1 9 sub lang { language(@_); } # backward comp
44              
45             sub language {
46 11     11 1 16 my ($self) = @_;
47 11         24 my $language = $self->SUPER::language();
48 11   66     426 return $language || $self->{_lang};
49             }
50              
51 4     4 1 10 sub cnty { country(@_); } # backwards
52              
53             sub country {
54 11     11 1 17 my ($self) = @_;
55 11         26 my $country = $self->SUPER::country();
56 11   66     312 return $country || $self->{_cnty};
57             }
58              
59             1;
60              
61             __END__