File Coverage

blib/lib/Furl/Headers.pm
Criterion Covered Total %
statement 23 62 37.1
branch 4 14 28.5
condition n/a
subroutine 5 20 25.0
pod 15 16 93.7
total 47 112 41.9


line stmt bran cond sub pod time code
1             package Furl::Headers;
2 12     12   47304 use strict;
  12         134  
  12         348  
3 12     12   63 use warnings;
  12         18  
  12         267  
4 12     12   399 use utf8;
  12         30  
  12         51  
5 12     12   252 use Carp ();
  12         24  
  12         7673  
6              
7             sub new {
8 2     2 1 6 my ($class, $headers) = @_; # $headers is HashRef or ArrayRef
9 2         4 my $self = {};
10 2 100       10 if (ref $headers eq 'ARRAY') {
    50          
11 1         4 my @h = @$headers; # copy
12 1         12 while (my ($k, $v) = splice @h, 0, 2) {
13 2         15 push @{$self->{lc $k}}, $v;
  2         13  
14             }
15             }
16             elsif(ref $headers eq 'HASH') {
17 1         4 while (my ($k, $v) = each %$headers) {
18 3 50       5 push @{$self->{$k}}, ref($v) eq 'ARRAY' ? @$v : $v;
  3         11  
19             }
20             }
21             else {
22 0         0 Carp::confess($class . ': $headers must be an ARRAY or HASH reference');
23             }
24              
25 2         21 bless $self, $class;
26             }
27              
28             sub header {
29 0     0 1   my ($self, $key, $new) = @_;
30 0 0         if ($new) { # setter
31 0 0         $new = [$new] unless ref $new;
32 0           $self->{lc $key} = $new;
33 0           return;
34             } else {
35 0           my $val = $self->{lc $key};
36 0 0         return unless $val;
37 0 0         return wantarray ? @$val : join(", ", @$val);
38             }
39             }
40              
41             sub remove_header {
42 0     0 1   my ($self, $key) = @_;
43 0           delete $self->{lc $key};
44             }
45              
46             sub flatten {
47 0     0 1   my $self = shift;
48 0           my @ret;
49 0           while (my ($k, $v) = each %$self) {
50 0           for my $e (@$v) {
51 0           push @ret, $k, $e;
52             }
53             }
54 0           return @ret;
55             }
56              
57             sub keys :method {
58 0     0 1   my $self = shift;
59 0           keys %$self;
60             }
61 0     0 1   sub header_field_names { shift->keys }
62              
63             sub as_string {
64 0     0 1   my $self = shift;
65 0           my $ret = '';
66 0           for my $k (sort keys %$self) {
67 0           for my $e (@{$self->{$k}}) {
  0            
68 0           $ret .= "$k: $e\015\012";
69             }
70             }
71 0           return $ret;
72             }
73              
74             sub as_http_headers {
75 0     0 0   my ($self, $key) = @_;
76 0           require HTTP::Headers;
77 0           return HTTP::Headers->new($self->flatten);
78             }
79              
80             # shortcut for popular headers.
81 0     0 1   sub referer { [ shift->header( 'Referer' => @_ ) ]->[0] }
82 0     0 1   sub expires { [ shift->header( 'Expires' => @_ ) ]->[0] }
83 0     0 1   sub last_modified { [ shift->header( 'Last-Modified' => @_ ) ]->[0] }
84 0     0 1   sub if_modified_since { [ shift->header( 'If-Modified-Since' => @_ ) ]->[0] }
85 0     0 1   sub content_type { [ shift->header( 'Content-Type' => @_ ) ]->[0] }
86 0     0 1   sub content_length { [ shift->header( 'Content-Length' => @_ ) ]->[0] }
87 0     0 1   sub content_encoding { [ shift->header( 'Content-Encoding' => @_ ) ]->[0] }
88              
89             sub clone {
90 0     0 1   require Storable;
91 0           Storable::dclone($_[0]);
92             }
93              
94             1;
95             __END__