File Coverage

blib/lib/WWW/Tracking/Data/Plugin/Headers.pm
Criterion Covered Total %
statement 27 27 100.0
branch 5 10 50.0
condition 7 14 50.0
subroutine 6 6 100.0
pod 0 1 0.0
total 45 58 77.5


line stmt bran cond sub pod time code
1             package WWW::Tracking::Data::Plugin::Headers;
2              
3 1     1   1470 use strict;
  1         1  
  1         23  
4 1     1   3 use warnings;
  1         1  
  1         34  
5              
6             our $VERSION = '0.02';
7              
8 1     1   3 use WWW::Tracking::Data;
  1         1  
  1         5  
9              
10             1;
11              
12             package WWW::Tracking::Data;
13              
14 1     1   23 use Carp::Clan 'croak';
  1         2  
  1         6  
15 1     1   1659 use CGI::Cookie;
  1         4991  
  1         142  
16              
17             sub from_headers {
18 1     1 0 2 my $class = shift;
19 1   50     3 my $args = shift || {};
20            
21 1 50       4 my $headers = $args->{'headers'}
22             or croak 'headers is mandatory argument';
23 1 50       3 my $request_uri = $args->{'request_uri'}
24             or croak 'request_uri is mandatory argument';
25 1 50       4 my $remote_ip = $args->{'remote_ip'}
26             or croak 'remote_ip is mandatory argument';
27 1         2 my $visitor_id = $args->{'visitor_id'};
28 1   50     3 my $visitor_cookie_name = $args->{'visitor_cookie_name'} || '__vcid';
29            
30 1 50       2 unless ($visitor_id) {
31 1         3 my $cookies_header = $headers->header('Cookie');
32 1         23 my %cookies = CGI::Cookie->parse($cookies_header);
33             $visitor_id = $cookies{$visitor_cookie_name}->value
34 1 50       382 if $cookies{$visitor_cookie_name};
35             }
36            
37 1   50     103 return $class->new(
      50        
      50        
      50        
      50        
38             hostname => $headers->header('Host') || undef,
39             request_uri => $request_uri,
40             remote_ip => $remote_ip,
41             user_agent => $headers->user_agent || undef,
42             referer => $headers->referer || undef,
43             browser_language => $headers->header('Accept-Language') || undef,
44             encoding => $headers->header('Accept-Charset') || undef,
45             visitor_id => $visitor_id,
46             );
47             }
48              
49             1;
50              
51              
52             __END__