File Coverage

blib/lib/WWW/Tracking/Data.pm
Criterion Covered Total %
statement 34 36 94.4
branch 3 4 75.0
condition 1 3 33.3
subroutine 9 10 90.0
pod 5 5 100.0
total 52 58 89.6


line stmt bran cond sub pod time code
1             package WWW::Tracking::Data;
2              
3 5     5   33175 use warnings;
  5         5  
  5         128  
4 5     5   15 use strict;
  5         5  
  5         135  
5              
6             our $VERSION = '0.02';
7              
8 5     5   15 use base 'Class::Accessor::Fast';
  5         5  
  5         764  
9              
10 5     5   2069 use Digest::MD5 qw(md5_hex);
  5         5  
  5         225  
11 5     5   2853 use Math::BaseCnv 'dec';
  5         149835  
  5         1543  
12              
13             our @TRACKING_PROPERTIES = qw(
14             hostname
15             request_uri
16             remote_ip
17             user_agent
18             referer
19             browser_language
20             timestamp
21             encoding
22             screen_color_depth
23             screen_resolution
24             visitor_id
25              
26             pdf_support
27             cookie_support
28              
29             flash_version
30             java_version
31             quicktime_version
32             realplayer_version
33             mediaplayer_version
34             gears_version
35             silverlight_version
36             );
37              
38             __PACKAGE__->mk_accessors(
39             @TRACKING_PROPERTIES,
40             '_tracking',
41             '_gen_new_visitor_id',
42             );
43              
44             sub new {
45 8     8 1 2142 my $class = shift;
46 8         93 my $self = $class->SUPER::new({
47             'timestamp' => time(),
48             @_
49             });
50            
51 8         94 return $self;
52             }
53              
54             sub as_hash {
55 2     2 1 22 my $self = shift;
56            
57             return {
58 22         63 map { $_ => $self->$_ }
59 2         5 grep { defined $self->$_ }
  40         159  
60             @TRACKING_PROPERTIES
61             };
62             }
63              
64             sub from_hash {
65 4     4 1 5 my $class = shift;
66 4         5 my $data = shift;
67            
68 4         13 my $self = $class->new;
69 4         12 foreach my $property_name (@TRACKING_PROPERTIES) {
70             $self->{$property_name} = $data->{$property_name}
71 80 100       148 if (exists $data->{$property_name});
72             }
73 4   33     12 $self->{'timestamp'} ||= time();
74            
75 4         10 return $self;
76             }
77              
78             sub new_visitor_id {
79 1     1 1 7 my $self = shift;
80            
81 1         3 my $gen_new_visitor_id = $self->_gen_new_visitor_id;
82 1 50       5 return $gen_new_visitor_id->()
83             if $gen_new_visitor_id;
84            
85 1         4 $self->visitor_id(substr(dec(md5_hex($self->user_agent.int(rand(0x7fffffff)))),0,32));
86            
87 1         4780 return $self;
88             }
89              
90             sub full_request_url {
91 0     0 1   my $self = shift;
92 0           return 'http://'.$self->hostname.$self->request_uri;
93             }
94              
95             1;
96              
97              
98             __END__