Upgrade to CGI.pm-3.48
[perl.git] / cpan / CGI / t / html.t
1 #!/usr/local/bin/perl -w
2
3 use Test::More tests => 33;
4
5 END { ok $loaded; }
6 use CGI ( ':standard', '-no_debug', '*h3', 'start_table' );
7 $loaded = 1;
8 ok 1;
9
10 BEGIN {
11     $| = 1;
12     if ( $] > 5.006 ) {
13
14         # no utf8
15         require utf8;    # we contain Latin-1
16         utf8->unimport;
17     }
18 }
19
20 ######################### End of black magic.
21
22 my $CRLF = "\015\012";
23 if ( $^O eq 'VMS' ) {
24     $CRLF = "\n";        # via web server carriage is inserted automatically
25 }
26 if ( ord("\t") != 9 ) {    # EBCDIC?
27     $CRLF = "\r\n";
28 }
29
30 # util
31 sub test {
32     local ($^W) = 0;
33     my ( undef, $true, $msg ) = @_;
34     ok $true => $msg;
35 }
36
37 # all the automatic tags
38 is h1(), '<h1 />', "single tag";
39
40 is h1('fred'), '<h1>fred</h1>', "open/close tag";
41
42 is h1( 'fred', 'agnes', 'maura' ), '<h1>fred agnes maura</h1>',
43   "open/close tag multiple";
44
45 is h1( { -align => 'CENTER' }, 'fred' ), '<h1 align="CENTER">fred</h1>',
46   "open/close tag with attribute";
47
48 is h1( { -align => undef }, 'fred' ), '<h1 align>fred</h1>',
49   "open/close tag with orphan attribute";
50
51 is h1( { -align => 'CENTER' }, [ 'fred', 'agnes' ] ),
52   '<h1 align="CENTER">fred</h1> <h1 align="CENTER">agnes</h1>',
53   "distributive tag with attribute";
54
55 {
56     local $" = '-';
57
58     is h1( 'fred', 'agnes', 'maura' ), '<h1>fred-agnes-maura</h1>',
59       "open/close tag \$\" interpolation";
60
61 }
62
63 is header(), "Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}",
64   "header()";
65
66 is header( -type => 'image/gif' ), "Content-Type: image/gif${CRLF}${CRLF}",
67   "header()";
68
69 is header( -type => 'image/gif', -status => '500 Sucks' ),
70   "Status: 500 Sucks${CRLF}Content-Type: image/gif${CRLF}${CRLF}", "header()";
71
72 like header( -nph => 1 ),
73   qr!HTTP/1.0 200 OK${CRLF}Server: cmdline${CRLF}Date:.+${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!,
74   "header()";
75
76 is start_html(), <<END, "start_html()";
77 <!DOCTYPE html
78         PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
79          "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
80 <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
81 <head>
82 <title>Untitled Document</title>
83 <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
84 </head>
85 <body>
86 END
87
88 is start_html( -Title => 'The world of foo' ), <<END, "start_html()";
89 <!DOCTYPE html
90         PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
91          "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
92 <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
93 <head>
94 <title>The world of foo</title>
95 <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
96 </head>
97 <body>
98 END
99
100 for my $v (qw/ 2.0 3.2 4.0 4.01 /) {
101     local $CGI::XHTML = 1;
102     is
103       start_html( -dtd => "-//IETF//DTD HTML $v//FR", -lang => 'fr' ),
104       <<"END", 'start_html()';
105 <!DOCTYPE html
106         PUBLIC "-//IETF//DTD HTML $v//FR">
107 <html lang="fr"><head><title>Untitled Document</title>
108 </head>
109 <body>
110 END
111 }
112
113 is
114   start_html( -dtd => "-//IETF//DTD HTML 9.99//FR", -lang => 'fr' ),
115   <<"END", 'start_html()';
116 <!DOCTYPE html
117         PUBLIC "-//IETF//DTD HTML 9.99//FR">
118 <html xmlns="http://www.w3.org/1999/xhtml" lang="fr" xml:lang="fr">
119 <head>
120 <title>Untitled Document</title>
121 <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
122 </head>
123 <body>
124 END
125
126 my $cookie =
127   cookie( -name => 'fred', -value => [ 'chocolate', 'chip' ], -path => '/' );
128
129 is $cookie, 'fred=chocolate&chip; path=/', "cookie()";
130
131 my $h = header( -Cookie => $cookie );
132
133 like $h,
134   qr!^Set-Cookie: fred=chocolate&chip\; path=/${CRLF}Date:.*${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!s,
135   "header(-cookie)";
136
137 is start_h3, '<h3>';
138
139 is end_h3, '</h3>';
140
141 is start_table( { -border => undef } ), '<table border>';
142 is h1( escapeHTML("this is <not> \x8bright\x9b") ),
143   '<h1>this is &lt;not&gt; &#8249;right&#8250;</h1>';
144
145 charset('utf-8');
146
147 is h1( escapeHTML("this is <not> \x8bright\x9b") ),
148   ord("\t") == 9
149   ? '<h1>this is &lt;not&gt; �right�</h1>'
150   : '<h1>this is &lt;not&gt; �right�</h1>';
151
152 is i( p('hello there') ), '<i><p>hello there</p></i>';
153
154 my $q = CGI->new;
155 is $q->h1('hi'), '<h1>hi</h1>';
156
157 $q->autoEscape(1);
158
159 is $q->p( { title => "hello world&egrave;" }, 'hello &aacute;' ),
160   '<p title="hello world&amp;egrave;">hello &aacute;</p>';
161
162 $q->autoEscape(0);
163
164 is $q->p( { title => "hello world&egrave;" }, 'hello &aacute;' ),
165   '<p title="hello world&egrave;">hello &aacute;</p>';
166
167 is p( { title => "hello world&egrave;" }, 'hello &aacute;' ),
168   '<p title="hello world&amp;egrave;">hello &aacute;</p>';
169
170 is header( -type => 'image/gif', -charset => 'UTF-8' ),
171   "Content-Type: image/gif; charset=UTF-8${CRLF}${CRLF}", "header()";