sub content_type {
my $self = shift;
my $ct = $self->{'content-type'};
$self->{'content-type'} = shift if @_;
$ct = $ct->[0] if ref($ct) eq 'ARRAY';
return '' unless defined($ct) && length($ct);
my @ct = split(/;\s*/, $ct, 2);
for ($ct[0]) {
s/\s+//g;
$_ = lc($_);
}
wantarray ? @ct : $ct[0];
}
sub content_is_html {
my $self = shift;
return $self->content_type eq 'text/html' || $self->content_is_xhtml;
}
sub content_is_xhtml {
my $ct = shift->content_type;
return $ct eq "application/xhtml+xml" ||
$ct eq "application/vnd.wap.xhtml+xml";
}
sub content_is_xml {
my $ct = shift->content_type;
return 1 if $ct eq "text/xml";
return 1 if $ct eq "application/xml";
return 1 if $ct =~ /\+xml$/;
return 0;
}
sub referer {
my $self = shift;
if (@_ && $_[0] =~ /#/) {
# Strip fragment per RFC 2616, section 14.36.
my $uri = shift;
if (ref($uri)) {
$uri = $uri->clone;
$uri->fragment(undef);
}
else {
$uri =~ s/\#.*//;
}
unshift @_, $uri;
}
($self->_header('Referer', @_))[0];
}
*referrer = \&referer; # on tchrist's request
sub title { (shift->_header('Title', @_))[0] }
sub content_encoding { (shift->_header('Content-Encoding', @_))[0] }
sub content_language { (shift->_header('Content-Language', @_))[0] }
sub content_length { (shift->_header('Content-Length', @_))[0] }
sub user_agent { (shift->_header('User-Agent', @_))[0] }
sub server { (shift->_header('Server', @_))[0] }
sub from { (shift->_header('From', @_))[0] }
sub warning { (shift->_header('Warning', @_))[0] }
sub www_authenticate { (shift->_header('WWW-Authenticate', @_))[0] }
sub authorization { (shift->_header('Authorization', @_))[0] }
sub proxy_authenticate { (shift->_header('Proxy-Authenticate', @_))[0] }
sub proxy_authorization { (shift->_header('Proxy-Authorization', @_))[0] }
sub authorization_basic { shift->_basic_auth("Authorization", @_) }
sub proxy_authorization_basic { shift->_basic_auth("Proxy-Authorization", @_) }
sub _basic_auth {
require MIME::Base64;
my($self, $h, $user, $passwd) = @_;
my($old) = $self->_header($h);
if (defined $user) {
Carp::croak("Basic authorization user name can't contain ':'")
if $user =~ /:/;
$passwd = '' unless defined $passwd;
$self->_header($h => 'Basic ' .
MIME::Base64::encode("$user:$passwd", ''));
}
if (defined $old && $old =~ s/^\s*Basic\s+//) {
my $val = MIME::Base64::decode($old);
return $val unless wantarray;
return split(/:/, $val, 2);
}
return;
}
1;
__END__
=head1 NAME
HTTP::Headers - Class encapsulating HTTP Message headers
=4= |