Permalink
Browse files

This is version 2.69, with scary XHTML support.

  • Loading branch information...
1 parent 04009eb commit f0b284b04b04e5c78398f2a518f106c8828d0826 lstein committed Jul 28, 2000
Showing with 187 additions and 168 deletions.
  1. +105 −92 CGI.pm
  2. +2 −2 CGI/Pretty.pm
  3. +3 −3 CGI/Util.pm
  4. +3 −0 README
  5. +15 −13 cgi_docs.html
  6. +22 −22 t/form.t
  7. +3 −4 t/function.t
  8. +26 −24 t/html.t
  9. +8 −8 t/pretty.t
View
197 CGI.pm

Large diffs are not rendered by default.

Oops, something went wrong.
View
@@ -72,7 +72,7 @@ sub _make_tag_func {
\$attr = " \@attr" if \@attr;
}
- my(\$tag,\$untag) = ("\U<$tagname\E\$attr>","\U</$tagname>\E");
+ my(\$tag,\$untag) = ("\L<$tagname\E\$attr>","\L</$tagname>\E");
return \$tag unless \@_;
my \@result;
@@ -128,7 +128,7 @@ sub initialize_globals {
$CGI::Pretty::LINEBREAK = "\n";
# These tags are not prettify'd.
- @CGI::Pretty::AS_IS = qw( A PRE CODE SCRIPT TEXTAREA );
+ @CGI::Pretty::AS_IS = qw( a pre code script textarea );
1;
}
View
@@ -48,14 +48,14 @@ sub rearrange {
my ($i,%pos);
$i = 0;
foreach (@$order) {
- foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{$_} = $i; }
+ foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{lc($_)} = $i; }
$i++;
}
my (@result,%leftover);
$#result = $#$order; # preextend
while (@param) {
- my $key = uc(shift(@param));
+ my $key = lc(shift(@param));
$key =~ s/^\-//;
if (exists $pos{$key}) {
$result[$pos{$key}] = shift(@param);
@@ -76,7 +76,7 @@ sub make_attributes {
foreach (keys %{$attr}) {
my($key) = $_;
$key=~s/^\-//; # get rid of initial - if present
- $key=~tr/a-z_/A-Z-/; # parameters are upper case, use dashes
+ $key=~tr/A-Z_/a-z-/; # parameters are lower case, use dashes
my $value = $escape ? simple_escape($attr->{$_}) : $attr->{$_};
push(@att,defined($attr->{$_}) ? qq/$key="$value"/ : qq/$key/);
}
View
3 README
@@ -63,6 +63,9 @@ May 1998. If you like CGI.pm, you'll love this book.
IMPORTANT NOTES:
+Version 2.69 emits XHTML by default. To get the old behavior, use the
+-no_xhtml pragma.
+
Versions 2.44-2.46 introduce two API changes that will affect
users of previous versions:
View
@@ -132,8 +132,11 @@
<P>
-There is also a beta of version 3.0X available, courtesy David James. Please try and report any
- bugs or misfeatures to <a href="mailto:lstein@cshl.org">me</a>.
+<h2><font color="red">Beta Test Version</font></h2>
+
+There is a beta of version 3.0X available, courtesy David James.
+Please try and report any bugs or misfeatures to <a
+href="mailto:lstein@cshl.org">me</a>.
<ul>
<li><a href="CGI.pm-3.01.tar.gz">Download 3.01 BETA</a></li>
@@ -2582,15 +2585,11 @@
<dd>Turns off "sticky" behavior in fill-out forms. Every form
element will act as if you passed -override.
<p>
- <dt><b>-xhtml</b>
- <dd>Enable support for XHTML (<a
-href="http://www.w3.org/TR/xhtml1/">http://www.w3.org/TR/xhtml1/</a>)
- output. This
- changes the default DTD and adds a closing / to all unpaired tags,
- such as &lt;BR /&gt;.
- <p>
- This doesn't yet (May 2000) make the document fully XHTML compliant, because
- the tags are still in all-caps.
+ <dt><b>-no_xhtml</b>
+ <dd>By default, CGI.pm versions 2.69 and higher emit XHTML
+ (<a href="http://www.w3.org/TR/xhtml1/">http://www.w3.org/TR/xhtml1/</a>).
+ The -no_xhtml pragma disables this feature. Thanks to Michalis Kabrianis
+ &lt;kabrianis@hellug.gr&gt; for this feature.
<p>
<dt><b>-nph</b>
<dd>This makes CGI.pm produce a header appropriate for an NPH (no
@@ -4647,8 +4646,11 @@
<h3>Version 2.69</h3>
<ol>
- <li>starform() now creates default ACTION for POSTs as well as GETs.
+ <li>startform() now creates default ACTION for POSTs as well as GETs.
This may break some browsers, but it no longer violates the HTML spec.
+ <li>CGI.pm now emits XHTML by default. Disable with -no_xhtml.
+ <li>We no longer interpret &#ddd sequences in non-latin character
+ sets.
</ol>
<h3>Version 2.68</h3>
@@ -5479,6 +5481,6 @@
<a href="http://www.cshl.org/">Cold Spring Harbor Laboratory</a></ADDRESS>
<P>
<!-- hhmts start -->
-Last modified: Thu Jul 27 22:31:38 EDT 2000
+Last modified: Thu Jul 27 22:59:03 EDT 2000
<!-- hhmts end -->
</BODY> </HTML>
View
@@ -30,48 +30,48 @@ $ENV{SERVER_PORT} = 8080;
$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
test(2,start_form(-action=>'foobar',-method=>GET) eq
- qq(<FORM METHOD="GET" ACTION="foobar" ENCTYPE="application/x-www-form-urlencoded">\n),
+ qq(<form method="GET" action="foobar" enctype="application/x-www-form-urlencoded">\n),
"start_form()");
-test(3,submit() eq qq(<INPUT TYPE="submit" NAME=".submit">),"submit()");
-test(4,submit(-name=>'foo',-value=>'bar') eq qq(<INPUT TYPE="submit" NAME="foo" VALUE="bar">),"submit(-name,-value)");
-test(5,submit({-name=>'foo',-value=>'bar'}) eq qq(<INPUT TYPE="submit" NAME="foo" VALUE="bar">),"submit({-name,-value})");
-test(6,textfield(-name=>'weather') eq qq(<INPUT TYPE="text" NAME="weather" VALUE="dull">),"textfield({-name})");
-test(7,textfield(-name=>'weather',-value=>'nice') eq qq(<INPUT TYPE="text" NAME="weather" VALUE="dull">),"textfield({-name,-value})");
-test(8,textfield(-name=>'weather',-value=>'nice',-override=>1) eq qq(<INPUT TYPE="text" NAME="weather" VALUE="nice">),
+test(3,submit() eq qq(<input type="submit" name=".submit" />),"submit()");
+test(4,submit(-name=>'foo',-value=>'bar') eq qq(<input type="submit" name="foo" value="bar" />),"submit(-name,-value)");
+test(5,submit({-name=>'foo',-value=>'bar'}) eq qq(<input type="submit" name="foo" value="bar" />),"submit({-name,-value})");
+test(6,textfield(-name=>'weather') eq qq(<input type="text" name="weather" value="dull" />),"textfield({-name})");
+test(7,textfield(-name=>'weather',-value=>'nice') eq qq(<input type="text" name="weather" value="dull" />),"textfield({-name,-value})");
+test(8,textfield(-name=>'weather',-value=>'nice',-override=>1) eq qq(<input type="text" name="weather" value="nice" />),
"textfield({-name,-value,-override})");
-test(9,checkbox(-name=>'weather',-value=>'nice') eq qq(<INPUT TYPE="checkbox" NAME="weather" VALUE="nice">weather),
+test(9,checkbox(-name=>'weather',-value=>'nice') eq qq(<input type="checkbox" name="weather" value="nice" />weather),
"checkbox()");
test(10,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast') eq
- qq(<INPUT TYPE="checkbox" NAME="weather" VALUE="nice">forecast),
+ qq(<input type="checkbox" name="weather" value="nice" />forecast),
"checkbox()");
test(11,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast',-checked=>1,-override=>1) eq
- qq(<INPUT TYPE="checkbox" NAME="weather" VALUE="nice" CHECKED>forecast),
+ qq(<input type="checkbox" name="weather" value="nice" checked="yes" />forecast),
"checkbox()");
test(12,checkbox(-name=>'weather',-value=>'dull',-label=>'forecast') eq
- qq(<INPUT TYPE="checkbox" NAME="weather" VALUE="dull" CHECKED>forecast),
+ qq(<input type="checkbox" name="weather" value="dull" checked="yes" />forecast),
"checkbox()");
test(13,radio_group(-name=>'game') eq
- qq(<INPUT TYPE="radio" NAME="game" VALUE="chess" CHECKED>chess <INPUT TYPE="radio" NAME="game" VALUE="checkers">checkers),
+ qq(<input type="radio" name="game" value="chess" checked="yes" />chess <input type="radio" name="game" value="checkers" />checkers),
'radio_group()');
test(14,radio_group(-name=>'game',-labels=>{'chess'=>'ping pong'}) eq
- qq(<INPUT TYPE="radio" NAME="game" VALUE="chess" CHECKED>ping pong <INPUT TYPE="radio" NAME="game" VALUE="checkers">checkers),
+ qq(<input type="radio" name="game" value="chess" checked="yes" />ping pong <input type="radio" name="game" value="checkers" />checkers),
'radio_group()');
test(15, checkbox_group(-name=>'game',-Values=>[qw/checkers chess cribbage/]) eq
- qq(<INPUT TYPE="checkbox" NAME="game" VALUE="checkers" CHECKED>checkers <INPUT TYPE="checkbox" NAME="game" VALUE="chess" CHECKED>chess <INPUT TYPE="checkbox" NAME="game" VALUE="cribbage">cribbage),
+ qq(<input type="checkbox" name="game" value="checkers" checked="yes" />checkers <input type="checkbox" name="game" value="chess" checked="yes" />chess <input type="checkbox" name="game" value="cribbage" />cribbage),
'checkbox_group()');
-test(16, checkbox_group(-name=>'game',-Values=>[qw/checkers chess cribbage/],-Defaults=>['cribbage'],-override=>1) eq
- qq(<INPUT TYPE="checkbox" NAME="game" VALUE="checkers">checkers <INPUT TYPE="checkbox" NAME="game" VALUE="chess">chess <INPUT TYPE="checkbox" NAME="game" VALUE="cribbage" CHECKED>cribbage),
+test(16, checkbox_group(-name=>'game',-values=>[qw/checkers chess cribbage/],-defaults=>['cribbage'],-override=>1) eq
+ qq(<input type="checkbox" name="game" value="checkers" />checkers <input type="checkbox" name="game" value="chess" />chess <input type="checkbox" name="game" value="cribbage" checked="yes" />cribbage),
'checkbox_group()');
-test(17, popup_menu(-name=>'game',-Values=>[qw/checkers chess cribbage/],-Default=>'cribbage',-override=>1) eq <<END,'checkbox_group()');
-<SELECT NAME="game">
-<OPTION VALUE="checkers">checkers</OPTION>
-<OPTION VALUE="chess">chess</OPTION>
-<OPTION SELECTED VALUE="cribbage">cribbage</OPTION>
-</SELECT>
+test(17, popup_menu(-name=>'game',-values=>[qw/checkers chess cribbage/],-default=>'cribbage',-override=>1) eq <<END,'checkbox_group()');
+<select name="game">
+<option value="checkers">checkers</option>
+<option value="chess">chess</option>
+<option selected="yes" value="cribbage">cribbage</option>
+</select>
END
View
@@ -81,7 +81,6 @@ if ($Config{d_fork}) {
print "ok 23 # Skip\n";
print "ok 24 # Skip\n";
}
-
-test(25,redirect('http://somewhere.else') eq "Status: 302 Moved${CRLF}Location: http://somewhere.else${CRLF}${CRLF}","CGI::redirect() 1");
-test(26,redirect(-Location=>'http://somewhere.else',-Type=>'text/html') eq "Status: 302 Moved${CRLF}Location: http://somewhere.else${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
-test(27,redirect(-Location=>'http://somewhere.else/bin/foo&bar',-Type=>'text/html') eq "Status: 302 Moved${CRLF}Location: http://somewhere.else/bin/foo&bar${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
+test(25,redirect('http://somewhere.else') eq "Status: 302 Moved${CRLF}location: http://somewhere.else${CRLF}${CRLF}","CGI::redirect() 1");
+test(26,redirect(-Location=>'http://somewhere.else',-Type=>'text/html') eq "Status: 302 Moved${CRLF}location: http://somewhere.else${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
+test(27,redirect(-Location=>'http://somewhere.else/bin/foo&bar',-Type=>'text/html') eq "Status: 302 Moved${CRLF}location: http://somewhere.else/bin/foo&bar${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
View
@@ -4,7 +4,7 @@
######################### We start with some black magic to print on failure.
use lib '../blib/lib','../blib/arch';
-BEGIN {$| = 1; print "1..23\n"; }
+BEGIN {$| = 1; print "1..24\n"; }
END {print "not ok 1\n" unless $loaded;}
use CGI (':standard','-no_debug','*h3','start_table');
$loaded = 1;
@@ -20,52 +20,54 @@ sub test {
}
# all the automatic tags
-test(2,h1() eq '<H1>',"single tag");
-test(3,h1('fred') eq '<H1>fred</H1>',"open/close tag");
-test(4,h1('fred','agnes','maura') eq '<H1>fred agnes maura</H1>',"open/close tag multiple");
-test(5,h1({-align=>'CENTER'},'fred') eq '<H1 ALIGN="CENTER">fred</H1>',"open/close tag with attribute");
-test(6,h1({-align=>undef},'fred') eq '<H1 ALIGN>fred</H1>',"open/close tag with orphan attribute");
+test(2,h1() eq '<h1 />',"single tag");
+test(3,h1('fred') eq '<h1>fred</h1>',"open/close tag");
+test(4,h1('fred','agnes','maura') eq '<h1>fred agnes maura</h1>',"open/close tag multiple");
+test(5,h1({-align=>'CENTER'},'fred') eq '<h1 align="CENTER">fred</h1>',"open/close tag with attribute");
+test(6,h1({-align=>undef},'fred') eq '<h1 align>fred</h1>',"open/close tag with orphan attribute");
test(7,h1({-align=>'CENTER'},['fred','agnes']) eq
- '<H1 ALIGN="CENTER">fred</H1> <H1 ALIGN="CENTER">agnes</H1>',
+ '<h1 align="CENTER">fred</h1> <h1 align="CENTER">agnes</h1>',
"distributive tag with attribute");
{
local($") = '-';
- test(8,h1('fred','agnes','maura') eq '<H1>fred-agnes-maura</H1>',"open/close tag \$\" interpolation");
+ test(8,h1('fred','agnes','maura') eq '<h1>fred-agnes-maura</h1>',"open/close tag \$\" interpolation");
}
test(9,header() eq "Content-Type: text/html; charset=ISO-8859-1\015\012\015\012","header()");
test(10,header(-type=>'image/gif') eq "Content-Type: image/gif\015\012\015\012","header()");
test(11,header(-type=>'image/gif',-status=>'500 Sucks') eq "Status: 500 Sucks\015\012Content-Type: image/gif\015\012\015\012","header()");
test(12,header(-nph=>1) eq "HTTP/1.0 200 OK\015\012Content-Type: text/html; charset=ISO-8859-1\015\012\015\012","header()");
test(13,start_html() ."\n" eq <<END,"start_html()");
<!DOCTYPE HTML
- PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
- "http://www.w3.org/TR/html4/loose.dtd">
-<HTML LANG="en-US"><HEAD><TITLE>Untitled Document</TITLE>
-</HEAD><BODY>
+ PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>Untitled Document</title>
+</head><body>
END
;
test(14,start_html(-dtd=>"-//IETF//DTD HTML 3.2//FR") ."\n" eq <<END,"start_html()");
<!DOCTYPE HTML
PUBLIC "-//IETF//DTD HTML 3.2//FR">
-<HTML LANG="en-US"><HEAD><TITLE>Untitled Document</TITLE>
-</HEAD><BODY>
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>Untitled Document</title>
+</head><body>
END
;
test(15,start_html(-Title=>'The world of foo') ."\n" eq <<END,"start_html()");
<!DOCTYPE HTML
- PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
- "http://www.w3.org/TR/html4/loose.dtd">
-<HTML LANG="en-US"><HEAD><TITLE>The world of foo</TITLE>
-</HEAD><BODY>
+ PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>The world of foo</title>
+</head><body>
END
;
test(16,($cookie=cookie(-name=>'fred',-value=>['chocolate','chip'],-path=>'/')) eq 'fred=chocolate&chip; path=/',"cookie()");
test(17,header(-Cookie=>$cookie) =~ m!^Set-Cookie: fred=chocolate&chip\; path=/\015\012Date:.*\015\012Content-Type: text/html\015\012\015\012!s,
"header(-cookie)");
-test(18,start_h3 eq '<H3>');
-test(19,end_h3 eq '</H3>');
-test(20,start_table({-border=>undef}) eq '<TABLE BORDER>');
-test(21,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<H1>this is &lt;not&gt; &#139;right&#155;</H1>');
-test(22,i(p('hello there')) eq '<I><P>hello there</P></I>');
+test(18,start_h3 eq '<h3>');
+test(19,end_h3 eq '</h3>');
+test(20,start_table({-border=>undef}) eq '<table border>');
+test(21,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is &lt;not&gt; &#139;right&#155;</h1>');
+charset('utf-8');
+test(22,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is &lt;not&gt; ‹right›</h1>');
+test(23,i(p('hello there')) eq '<i><p>hello there</p></i>');
my $q = new CGI;
-test(23,$q->h1('hi') eq '<H1>hi</H1>');
+test(24,$q->h1('hi') eq '<h1>hi</h1>');
View
@@ -20,17 +20,17 @@ sub test {
}
# all the automatic tags
-test(2,h1() eq '<H1>',"single tag");
-test(3,ol(li('fred'),li('ethel')) eq "<OL>\n\t<LI>\n\t\tfred\n\t</LI>\n\t <LI>\n\t\tethel\n\t</LI>\n</OL>\n","basic indentation");
+test(2,h1() eq '<h1>',"single tag");
+test(3,ol(li('fred'),li('ethel')) eq "<ol>\n\t<li>\n\t\tfred\n\t</li>\n\t <li>\n\t\tethel\n\t</li>\n</ol>\n","basic indentation");
test(4,p('hi',pre('there'),'frog') eq
-'<P>
- hi <PRE>there</PRE>
+'<p>
+ hi <pre>there</pre>
frog
-</P>
+</p>
',"<pre> tags");
test(5,p('hi',a({-href=>'frog'},'there'),'frog') eq
-'<P>
- hi <A HREF="frog">there</A>
+'<p>
+ hi <a href="frog">there</a>
frog
-</P>
+</p>
',"as-is");

0 comments on commit f0b284b

Please sign in to comment.