line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package PLP::Tie::Headers; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
36
|
|
4
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
29
|
|
5
|
1
|
|
|
1
|
|
5
|
use Carp; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
808
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '1.01'; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 PLP::Tie::Headers |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
Makes a hash case insensitive, and sets some headers. <_> equals <->, so C<$foo{CONTENT_TYPE}> is |
12
|
|
|
|
|
|
|
the same as C<$foo{'Content-Type'}>. |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
tie %somehash, 'PLP::Tie::Headers'; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
This module is part of the PLP internals and probably not of much use to others. |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=cut |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub TIEHASH { |
21
|
18
|
|
|
18
|
|
145
|
return bless [ # Defaults |
22
|
|
|
|
|
|
|
{ |
23
|
|
|
|
|
|
|
'Content-Type' => 'text/html', |
24
|
|
|
|
|
|
|
'X-PLP-Version' => $PLP::VERSION, |
25
|
|
|
|
|
|
|
}, |
26
|
|
|
|
|
|
|
{ |
27
|
|
|
|
|
|
|
'content-type' => 'Content-Type', |
28
|
|
|
|
|
|
|
'x-plp-version' => 'X-PLP-Version', |
29
|
|
|
|
|
|
|
}, |
30
|
|
|
|
|
|
|
1 # = content-type untouched |
31
|
|
|
|
|
|
|
], $_[0]; |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub FETCH { |
35
|
38
|
|
|
38
|
|
461
|
my ($self, $key) = @_; |
36
|
38
|
100
|
66
|
|
|
137
|
if ($self->[2] and defined $self->[0]->{'Content-Type'}) { |
37
|
18
|
|
|
|
|
31
|
my $utf8 = eval { grep {$_ eq "utf8"} PerlIO::get_layers(*STDOUT) }; |
|
18
|
|
|
|
|
88
|
|
|
19
|
|
|
|
|
56
|
|
38
|
18
|
100
|
|
|
|
46
|
$self->[0]->{'Content-Type'} .= '; charset=utf-8' if $utf8; |
39
|
18
|
|
|
|
|
28
|
$self->[2] = 0; |
40
|
|
|
|
|
|
|
} |
41
|
38
|
|
|
|
|
62
|
$key =~ tr/_/-/; |
42
|
38
|
50
|
|
|
|
114
|
defined ($key = $self->[1]->{lc $key}) or return; |
43
|
38
|
|
|
|
|
160
|
return $self->[0]->{$key}; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
sub STORE { |
47
|
4
|
|
|
4
|
|
10
|
my ($self, $key, $value) = @_; |
48
|
4
|
|
|
|
|
6
|
$key =~ tr/_/-/; |
49
|
4
|
100
|
|
|
|
9
|
if ($PLP::sentheaders) { |
50
|
1
|
|
|
|
|
5
|
my @caller = caller; |
51
|
1
|
|
|
|
|
20
|
die "Can't set headers after sending them at " . |
52
|
|
|
|
|
|
|
"$caller[1] line $caller[2].\n(Output started at " . |
53
|
|
|
|
|
|
|
"$PLP::sentheaders->[0] line $PLP::sentheaders->[1].)\n" |
54
|
|
|
|
|
|
|
} |
55
|
3
|
100
|
|
|
|
13
|
if (defined $self->[1]->{lc $key}){ |
56
|
1
|
|
|
|
|
3
|
$key = $self->[1]->{lc $key}; |
57
|
|
|
|
|
|
|
} else { |
58
|
2
|
|
|
|
|
7
|
$self->[1]->{lc $key} = $key; |
59
|
|
|
|
|
|
|
} |
60
|
3
|
50
|
|
|
|
8
|
$self->[2] = 0 if $key eq 'Content-Type'; |
61
|
3
|
|
|
|
|
60
|
return ($self->[0]->{$key} = $value); |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub DELETE { |
65
|
1
|
|
|
1
|
|
2
|
my ($self, $key) = @_; |
66
|
1
|
|
|
|
|
2
|
$key =~ tr/_/-/; |
67
|
1
|
50
|
|
|
|
9
|
defined ($key = delete $self->[1]->{lc $key}) or return; |
68
|
1
|
|
|
|
|
5
|
return delete $self->[0]->{$key}; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub CLEAR { |
72
|
0
|
|
|
0
|
|
0
|
my $self = $_[0]; |
73
|
0
|
|
|
|
|
0
|
return (@$self = ()); |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub EXISTS { |
77
|
0
|
|
|
0
|
|
0
|
my ($self, $key) = @_; |
78
|
0
|
|
|
|
|
0
|
$key =~ tr/_/-/; |
79
|
0
|
|
|
|
|
0
|
return exists $self->[1]->{lc $key}; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub FIRSTKEY { |
83
|
18
|
|
|
18
|
|
23
|
my $self = $_[0]; |
84
|
18
|
|
|
|
|
18
|
keys %{$self->[0]}; |
|
18
|
|
|
|
|
50
|
|
85
|
18
|
|
|
|
|
20
|
return each %{ $self->[0] }; # Key only, Tie::Hash doc is wrong. |
|
18
|
|
|
|
|
112
|
|
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub NEXTKEY { |
89
|
37
|
|
|
37
|
|
36
|
return each %{ $_[0]->[0] }; |
|
37
|
|
|
|
|
174
|
|
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
1; |
93
|
|
|
|
|
|
|
|