summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/HTTP/Headers.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/HTTP/Headers.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/HTTP/Headers.pm31
1 files changed, 18 insertions, 13 deletions
diff --git a/Master/tlpkg/tlperl/lib/HTTP/Headers.pm b/Master/tlpkg/tlperl/lib/HTTP/Headers.pm
index 67f1d2e6406..532fefed8e8 100644
--- a/Master/tlpkg/tlperl/lib/HTTP/Headers.pm
+++ b/Master/tlpkg/tlperl/lib/HTTP/Headers.pm
@@ -4,7 +4,7 @@ use strict;
use Carp ();
use vars qw($VERSION $TRANSLATE_UNDERSCORE);
-$VERSION = "6.00";
+$VERSION = "6.05";
# The $TRANSLATE_UNDERSCORE variable controls whether '_' can be used
# as a replacement for '-' in header field names.
@@ -138,6 +138,9 @@ sub remove_content_headers
for my $f (grep $entity_header{$_} || /^content-/, keys %$self) {
$c->{$f} = delete $self->{$f};
}
+ if (exists $self->{'::std_case'}) {
+ $c->{'::std_case'} = $self->{'::std_case'};
+ }
$c;
}
@@ -146,14 +149,17 @@ sub _header
{
my($self, $field, $val, $op) = @_;
+ Carp::croak("Illegal field name '$field'")
+ if rindex($field, ':') > 1 || !length($field);
+
unless ($field =~ /^:/) {
$field =~ tr/_/-/ if $TRANSLATE_UNDERSCORE;
my $old = $field;
$field = lc $field;
- unless(defined $standard_case{$field}) {
- # generate a %standard_case entry for this field
+ unless($standard_case{$field} || $self->{'::std_case'}{$field}) {
+ # generate a %std_case entry for this field
$old =~ s/\b(\w)/\u$1/g;
- $standard_case{$field} = $old;
+ $self->{'::std_case'}{$field} = $old;
}
}
@@ -202,15 +208,15 @@ sub _sorted_field_names
return [ sort {
($header_order{$a} || 999) <=> ($header_order{$b} || 999) ||
$a cmp $b
- } keys %$self ];
+ } grep !/^::/, keys %$self ];
}
sub header_field_names {
my $self = shift;
- return map $standard_case{$_} || $_, @{ $self->_sorted_field_names },
+ return map $standard_case{$_} || $self->{'::std_case'}{$_} || $_, @{ $self->_sorted_field_names },
if wantarray;
- return keys %$self;
+ return grep !/^::/, keys %$self;
}
@@ -219,16 +225,15 @@ sub scan
my($self, $sub) = @_;
my $key;
for $key (@{ $self->_sorted_field_names }) {
- next if substr($key, 0, 1) eq '_';
my $vals = $self->{$key};
if (ref($vals) eq 'ARRAY') {
my $val;
for $val (@$vals) {
- $sub->($standard_case{$key} || $key, $val);
+ $sub->($standard_case{$key} || $self->{'::std_case'}{$key} || $key, $val);
}
}
else {
- $sub->($standard_case{$key} || $key, $vals);
+ $sub->($standard_case{$key} || $self->{'::std_case'}{$key} || $key, $vals);
}
}
}
@@ -245,7 +250,7 @@ sub as_string
my $vals = $self->{$key};
if ( ref($vals) eq 'ARRAY' ) {
for my $val (@$vals) {
- my $field = $standard_case{$key} || $key;
+ my $field = $standard_case{$key} || $self->{'::std_case'}{$key} || $key;
$field =~ s/^://;
if ( index($val, "\n") >= 0 ) {
$val = _process_newline($val, $endl);
@@ -254,7 +259,7 @@ sub as_string
}
}
else {
- my $field = $standard_case{$key} || $key;
+ my $field = $standard_case{$key} || $self->{'::std_case'}{$key} || $key;
$field =~ s/^://;
if ( index($vals, "\n") >= 0 ) {
$vals = _process_newline($vals, $endl);
@@ -272,7 +277,7 @@ sub _process_newline {
# must handle header values with embedded newlines with care
s/\s+$//; # trailing newlines and space must go
s/\n(\x0d?\n)+/\n/g; # no empty lines
- s/\n([^\040\t])/\n $1/g; # intial space for continuation
+ s/\n([^\040\t])/\n $1/g; # initial space for continuation
s/\n/$endl/g; # substitute with requested line ending
$_;
}