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         50  
3 2     2   8 use warnings;
  2         3  
  2         48  
4 2     2   9 use Parse::HTTP::UserAgent::Constants qw(:all);
  2         3  
  2         497  
5              
6             our $VERSION = '0.11';
7              
8             BEGIN {
9 2     2   10 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         4 my @multi = qw(
28             mozilla
29             extras
30             dotnet
31             );
32              
33 2     2   12 no strict qw(refs); ## no critic (TestingAndDebugging::ProhibitNoStrict)
  2         3  
  2         276  
34 2         4 foreach my $name ( @simple ) {
35 30         78 my $id = 'UA_' . uc $name;
36 30         154 $id = __PACKAGE__->$id();
37 30   100 2597   115 *{ $name } = sub { return shift->[$id] || q{} };
  30         121  
  2597         89101  
38             }
39              
40 2         7 foreach my $name ( @multi ) {
41 6         16 my $id = 'UA_' . uc $name;
42 6         38 $id = __PACKAGE__->$id();
43 6         243 *{ $name } = sub {
44 646     646   1397 my $self = shift;
45 646 100       1457 return +() if ! $self->[ $id ];
46 286         355 my @rv = @{ $self->[ $id ] };
  286         593  
47 286 50       818 return wantarray ? @rv : $rv[0];
48 6         23 };
49             }
50             }
51              
52             sub version {
53 562     562 1 963 my $self = shift;
54 562   100     1499 my $type = shift || q{};
55 562   100     2675 return $self->[ $type eq 'raw' ? UA_VERSION_RAW : UA_VERSION ] || 0;
56             }
57              
58             sub toolkit {
59 281     281 1 682 my $self = shift;
60 281         650 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         3  
  2         36  
68 2     2   8 use warnings;
  2         4  
  2         85  
69 2         9 use overload '""', => 'name',
70             '0+', => 'version',
71             fallback => 1,
72 2     2   9 ;
  2         4  
73 2     2   157 use constant ID_NAME => 0;
  2         4  
  2         100  
74 2     2   10 use constant ID_VERSION_RAW => 1;
  2         4  
  2         78  
75 2     2   9 use constant ID_VERSION => 2;
  2         4  
  2         246  
76              
77             sub new {
78 281     281   523 my($class, $tk) = @_;
79 281 100       803 return bless [ $tk ? @{ $tk } : (undef) x 3 ], $class;
  133         447  
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__