package HTTP::Headers;
use strict;
use Carp ();
use vars qw($VERSION $TRANSLATE_UNDERSCORE);
$VERSION = "5.818";
# The $TRANSLATE_UNDERSCORE variable controls whether '_' can be used
# as a replacement for '-' in header field names.
$TRANSLATE_UNDERSCORE = 1 unless defined $TRANSLATE_UNDERSCORE;
# "Good Practice" order of HTTP message headers:
# - General-Headers
# - Request-Headers
# - Response-Headers
# - Entity-Headers
my @general_headers = qw(
Cache-Control Connection Date Pragma Trailer Transfer-Encoding Upgrade
Via Warning
);
my @request_headers = qw(
Accept Accept-Charset Accept-Encoding Accept-Language
Authorization Expect From Host
If-Match If-Modified-Since If-None-Match If-Range If-Unmodified-Since
Max-Forwards Proxy-Authorization Range Referer TE User-Agent
);
my @response_headers = qw(
Accept-Ranges Age ETag Location Proxy-Authenticate Retry-After Server
Vary WWW-Authenticate
);
my @entity_headers = qw(
Allow Content-Encoding Content-Language Content-Length Content-Location
Content-MD5 Content-Range Content-Type Expires Last-Modified
);
my %entity_header = map { lc($_) => 1 } @entity_headers;
my @header_order = (
@general_headers,
@request_headers,
@response_headers,
@entity_headers,
);
# Make alternative representations of @header_order. This is used
# for sorting and case matching.
my %header_order;
my %standard_case;
{
my $i = 0;
for (@header_order) {
my $lc = lc $_;
$header_order{$lc} = ++$i;
$standard_case{$lc} = $_;
}
}
sub new
{
my($class) = shift;
my $self = bless {}, $class;
$self->header(@_) if @_; # set up initial headers
$self;
}
sub header
{
my $self = shift;
Carp::croak('Usage: $h->header($field, ...)') unless @_;
my(@old);
my %seen;
while (@_) {
my $field = shift;
my $op = @_ ? ($seen{lc($field)}++ ? 'PUSH' : 'SET') : 'GET';
@old = $self->_header($field, shift, $op);
}
return @old if wantarray;
return $old[0] if @old <= 1;
join(", ", @old);
}
sub clear
{
my $self = shift;
%$self = ();
}
sub push_header
{
my $self = shift;
=1= |