File Coverage

blib/lib/Furl/Headers.pm

Criterion	Covered	Total	%
statement	43	62	69.3
branch	9	14	64.2
condition			n/a
subroutine	10	20	50.0
pod	15	16	93.7
total	77	112	68.7

package Furl::Headers;
use strict;
use warnings;
use utf8;
use Carp ();

sub new {
    my ($class, $headers) = @_; # $headers is HashRef or ArrayRef
    my $self = {};
    if (ref $headers eq 'ARRAY') {
        my @h = @$headers; # copy
        while (my ($k, $v) = splice @h, 0, 2) {
            push @{$self->{lc $k}}, $v;
        }
    }
    elsif(ref $headers eq 'HASH') {
        while (my ($k, $v) = each %$headers) {
            push @{$self->{$k}}, ref($v) eq 'ARRAY' ? @$v : $v;
        }
    }
    else {
        Carp::confess($class . ': $headers must be an ARRAY or HASH reference');
    }

    bless $self, $class;
}

sub header {
    my ($self, $key, $new) = @_;
    if ($new) { # setter
        $new = [$new] unless ref $new;
        $self->{lc $key} = $new;
        return;
    } else {
        my $val = $self->{lc $key};
        return unless $val;
        return wantarray ? @$val : join(", ", @$val);
    }
}

sub remove_header {
    my ($self, $key) = @_;
    delete $self->{lc $key};
}

sub flatten {
    my $self = shift;
    my @ret;
    while (my ($k, $v) = each %$self) {
        for my $e (@$v) {
            push @ret, $k, $e;
        }
    }
    return @ret;
}

sub keys :method {
    my $self = shift;
    keys %$self;
}
sub header_field_names { shift->keys }

sub as_string {
    my $self = shift;
    my $ret = '';
    for my $k (sort keys %$self) {
        for my $e (@{$self->{$k}}) {
            $ret .= "$k: $e\015\012";
        }
    }
    return $ret;
}

sub as_http_headers {
    my ($self, $key) = @_;
    require HTTP::Headers;
    return HTTP::Headers->new($self->flatten);
}

# shortcut for popular headers.
sub referer           { [ shift->header( 'Referer'           => @_ ) ]->[0] }
sub expires           { [ shift->header( 'Expires'           => @_ ) ]->[0] }
sub last_modified     { [ shift->header( 'Last-Modified'     => @_ ) ]->[0] }
sub if_modified_since { [ shift->header( 'If-Modified-Since' => @_ ) ]->[0] }
sub content_type      { [ shift->header( 'Content-Type'      => @_ ) ]->[0] }
sub content_length    { [ shift->header( 'Content-Length'    => @_ ) ]->[0] }
sub content_encoding  { [ shift->header( 'Content-Encoding'  => @_ ) ]->[0] }

sub clone {
    require Storable;
    Storable::dclone($_[0]);
}

1;
__END__