fix header key conversion to match documentation

[perl/plp/.git] / PLP / Tie / Headers.pm

diff --git a/PLP/Tie/Headers.pm b/PLP/Tie/Headers.pm
index e8f961c0e9e31850ac5e621be9b2d1cb12242866..566b19869a1609ae95e2649c7ed714148c1dd478 100644 (file)
--- a/PLP/Tie/Headers.pm
+++ b/PLP/Tie/Headers.pm
@@ -1,6 +1,5 @@
-#----------------------------#
-  package PLP::Tie::Headers;
-#----------------------------#
+package PLP::Tie::Headers;
+
 use strict;
 use Carp;
 
@@ -15,14 +14,8 @@ This module is part of the PLP internals and probably not of much use to others.
 
 =cut
 
-sub _lc($) {
-    local $_ = $_[0];
-    tr/_/-/;
-    return lc;
-}
-
 sub TIEHASH {
-    return bless [ # Defaults.
+    return bless [ # Defaults
         {
            'Content-Type'  => 'text/html',
            'X-PLP-Version' => $PLP::VERSION,
@@ -36,15 +29,22 @@ sub TIEHASH {
 
 sub FETCH {
     my ($self, $key) = @_;
-    return $self->[0]->{ $self->[1]->{_lc $key} };
+    $key =~ tr/_/-/;
+    return $self->[0]->{ $self->[1]->{lc $key} };
 }
 
 sub STORE {
     my ($self, $key, $value) = @_;
-    croak 'Can\'t set headers after sending them!' if $PLP::sentheaders;
-    if (defined $self->[1]->{_lc $key}){
-        $key = $self->[1]->{_lc $key};
-    }else{
+    $key =~ tr/_/-/;
+    if ($PLP::sentheaders) {
+       my @caller = caller;
+       die "Can't set headers after sending them at " .
+           "$caller[1] line $caller[2].\n(Output started at " .
+           "$PLP::sentheaders->[0] line $PLP::sentheaders->[1].)\n"
+    }
+    if (defined $self->[1]->{lc $key}){
+        $key = $self->[1]->{lc $key};
+    } else {
         $self->[1]->{lc $key} = $key;
     }
     return ($self->[0]->{$key} = $value);
@@ -52,8 +52,9 @@ sub STORE {
 
 sub DELETE {
     my ($self, $key) = @_;
+    $key =~ tr/_/-/;
     delete $self->[0]->{$key};
-    return delete $self->[1]->{_lc $key};
+    return delete $self->[1]->{lc $key};
 }
 
 sub CLEAR {
@@ -63,7 +64,8 @@ sub CLEAR {
 
 sub EXISTS {
     my ($self, $key) = @_;
-    return exists $self->[1]->{_lc $key};
+    $key =~ tr/_/-/;
+    return exists $self->[1]->{lc $key};
 }
 
 sub FIRSTKEY {