1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
require HTTP::Headers;
print "1..11\n";
$h = new HTTP::Headers
mime_version => "1.0",
content_type => "text/html";
$h->header(URI => "http://www.oslonett.no/");
if ($h->header("MIME-Version") eq "1.0") {
print "ok 1\n";
} else {
print "not ok 1\n";
}
if ($h->header('Uri') =~ /^http:/) {
print "ok 2\n";
} else {
print "not ok 2\n";
}
$h->header("MY-header" => "foo",
"Date" => "somedate",
"Accept" => ["text/plain", "image/*"],
);
$h->push_header("accept" => "audio/basic");
if ($h->header("date") eq "somedate") {
print "ok 3\n";
}
@accept = $h->header("accept");
if (@accept == 3) {
print "ok 4\n";
}
$h->remove_header("uri", "date");
$str = $h->as_string;
print "\nHeader looks like this now:\n$str\n";
$lines = ($str =~ tr/\n/\n/);
if ($lines == 6) {
print "ok 5\n";
} else {
print "Header has $lines lines\n";
print "not ok 5\n";
}
$h2 = $h->clone;
$h->header("accept", "*/*");
$h->remove_header("my-header");
@accept = $h2->header("accept");
if (@accept == 3) {
print "ok 6\n";
}
@accept = $h->header("accept");
if (@accept == 1) {
print "ok 7\n";
}
# Check order of headers, but first remove this one
$h2->remove_header('mime_version');
# and add this general header
$h2->header(Connection => 'close');
@x = ();
$h2->scan(sub {push(@x, shift);});
$str = join(";", @x);
$expected = "Connection;Accept;Accept;Accept;Content-Type;MY-Header";
if ($str eq $expected) {
print "ok 8\n";
} else {
print "Headers are '$str',\nexpected '$expected'\n";
print "not ok 8\n";
}
# Check headers with embedded newlines:
$h = new HTTP::Headers
a => "foo\n\n",
b => "foo\nbar",
c => "foo\n\nbar\n\n",
d => "foo\n\tbar";
$str = $h->as_string("<<\n");
print "-----\n$str------\n";
print "not " unless $str =~ /^A:\s*foo<<\n
B:\s*foo<<\n
\s+bar<<\n
C:\s*foo<<\n
\s+bar<<\n
D:\s*foo<<\n
\t bar<<\n
$/x;
print "ok 9\n";
# Check with FALSE $HTML::Headers::TRANSLATE_UNDERSCORE
local($HTTP::Headers::TRANSLATE_UNDERSCORE);
$HTTP::Headers::TRANSLATE_UNDERSCORE = undef; # avoid -w warning
$h = HTTP::Headers->new;
$h->header(abc_abc => "foo");
$h->header("abc-abc" => "bar");
#print $h->as_string;
print "not " unless $h->header("ABC_ABC") eq "foo" &&
$h->header("ABC-ABC") eq "bar";
print "ok 10\n";
$h->remove_header("Abc_Abc");
print "not " unless !defined($h->header("abc_abc")) &&
$h->header("ABC-ABC") eq "bar";
print "ok 11\n";
|
