File Coverage

blib/lib/Parse/HTTP/UserAgent/Base/Accessors.pm
Criterion Covered Total %
statement 56 60 93.3
branch 5 6 83.3
condition 6 10 60.0
subroutine 16 18 88.8
pod 2 2 100.0
total 85 96 88.5


line stmt bran cond sub pod time code
1             package Parse::HTTP::UserAgent::Base::Accessors;
2 2     2   13 use strict;
  2         4  
  2         48  
3 2     2   9 use warnings;
  2         3  
  2         47  
4 2     2   11 use Parse::HTTP::UserAgent::Constants qw(:all);
  2         4  
  2         555  
5              
6             our $VERSION = '0.11';
7              
8             BEGIN {
9 2     2   11 my @simple = qw(
10             device
11             generic
12             lang
13             mobile
14             name
15             original_name
16             original_version
17             os
18             parser
19             robot
20             strength
21             tablet
22             touch
23             unknown
24             wap
25             );
26              
27 2         26 my @multi = qw(
28             mozilla
29             extras
30             dotnet
31             );
32              
33 2     2   13 no strict qw(refs); ## no critic (TestingAndDebugging::ProhibitNoStrict)
  2         4  
  2         321  
34 2         6 foreach my $name ( @simple ) {
35 30         61 my $id = 'UA_' . uc $name;
36 30         130 $id = __PACKAGE__->$id();
37 30   100 2561   82 *{ $name } = sub { return shift->[$id] || q{} };
  30         88  
  2561         100037  
38             }
39              
40 2         4 foreach my $name ( @multi ) {
41 6         12 my $id = 'UA_' . uc $name;
42 6         29 $id = __PACKAGE__->$id();
43 6         228 *{ $name } = sub {
44 638     638   1887 my $self = shift;
45 638 100       1885 return +() if ! $self->[ $id ];
46 281         486 my @rv = @{ $self->[ $id ] };
  281         764  
47 281 50       1060 return wantarray ? @rv : $rv[0];
48 6         16 };
49             }
50             }
51              
52             sub version {
53 554     554 1 1150 my $self = shift;
54 554   100     1813 my $type = shift || q{};
55 554   100     3681 return $self->[ $type eq 'raw' ? UA_VERSION_RAW : UA_VERSION ] || 0;
56             }
57              
58             sub toolkit {
59 277     277 1 1048 my $self = shift;
60 277         797 return Parse::HTTP::UserAgent::Base::Accessors::toolkit->new(
61             $self->[UA_TOOLKIT]
62             );
63             }
64              
65             package
66             Parse::HTTP::UserAgent::Base::Accessors::toolkit;
67 2     2   13 use strict;
  2         5  
  2         46  
68 2     2   11 use warnings;
  2         5  
  2         70  
69 2         13 use overload '""', => 'name',
70             '0+', => 'version',
71             fallback => 1,
72 2     2   9 ;
  2         7  
73 2     2   164 use constant ID_NAME => 0;
  2         4  
  2         101  
74 2     2   9 use constant ID_VERSION_RAW => 1;
  2         4  
  2         75  
75 2     2   9 use constant ID_VERSION => 2;
  2         4  
  2         245  
76              
77             sub new {
78 277     277   610 my($class, $tk) = @_;
79 277 100       1003 return bless [ $tk ? @{ $tk } : (undef) x 3 ], $class;
  129         563  
80             }
81              
82             sub name {
83 0     0     return shift->[ID_NAME];
84             }
85              
86             sub version {
87 0     0     my $self = shift;
88 0   0       my $type = shift || q{};
89 0   0       return $self->[ $type eq 'raw' ? ID_VERSION_RAW : ID_VERSION ] || 0;
90             }
91              
92             1;
93              
94             __END__