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
     $_;
 }