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