1#!/usr/local/bin/perl -w 2 3# Test ability to retrieve HTTP request info 4######################### We start with some black magic to print on failure. 5use lib '../blib/lib','../blib/arch'; 6 7END {print "not ok 1\n" unless $loaded;} 8use CGI (':standard','-no_debug','*h3','start_table'); 9$loaded = 1; 10print "ok 1\n"; 11 12BEGIN { 13 $| = 1; print "1..28\n"; 14 if( $] > 5.006 ) { 15 # no utf8 16 require utf8; # we contain Latin-1 17 utf8->unimport; 18 } 19} 20 21######################### End of black magic. 22 23my $CRLF = "\015\012"; 24if ($^O eq 'VMS') { 25 $CRLF = "\n"; # via web server carriage is inserted automatically 26} 27if (ord("\t") != 9) { # EBCDIC? 28 $CRLF = "\r\n"; 29} 30 31 32# util 33sub test { 34 local($^W) = 0; 35 my($num, $true,$msg) = @_; 36 print($true ? "ok $num\n" : "not ok $num $msg\n"); 37} 38 39# all the automatic tags 40test(2,h1() eq '<h1 />',"single tag"); 41test(3,h1('fred') eq '<h1>fred</h1>',"open/close tag"); 42test(4,h1('fred','agnes','maura') eq '<h1>fred agnes maura</h1>',"open/close tag multiple"); 43test(5,h1({-align=>'CENTER'},'fred') eq '<h1 align="CENTER">fred</h1>',"open/close tag with attribute"); 44test(6,h1({-align=>undef},'fred') eq '<h1 align>fred</h1>',"open/close tag with orphan attribute"); 45test(7,h1({-align=>'CENTER'},['fred','agnes']) eq 46 '<h1 align="CENTER">fred</h1> <h1 align="CENTER">agnes</h1>', 47 "distributive tag with attribute"); 48{ 49 local($") = '-'; 50 test(8,h1('fred','agnes','maura') eq '<h1>fred-agnes-maura</h1>',"open/close tag \$\" interpolation"); 51} 52test(9,header() eq "Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","header()"); 53test(10,header(-type=>'image/gif') eq "Content-Type: image/gif${CRLF}${CRLF}","header()"); 54test(11,header(-type=>'image/gif',-status=>'500 Sucks') eq "Status: 500 Sucks${CRLF}Content-Type: image/gif${CRLF}${CRLF}","header()"); 55test(12,header(-nph=>1) =~ m!HTTP/1.0 200 OK${CRLF}Server: cmdline${CRLF}Date:.+${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!,"header()"); 56test(13,start_html() eq <<END,"start_html()"); 57<!DOCTYPE html 58 PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" 59 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> 60<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US"> 61<head> 62<title>Untitled Document</title> 63<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" /> 64</head> 65<body> 66END 67 ; 68test(14,start_html(-Title=>'The world of foo') eq <<END,"start_html()"); 69<!DOCTYPE html 70 PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" 71 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> 72<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US"> 73<head> 74<title>The world of foo</title> 75<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" /> 76</head> 77<body> 78END 79 ; 80# Note that this test will turn off XHTML until we make a new CGI object. 81test(15,start_html(-dtd=>"-//IETF//DTD HTML 3.2//FR",-lang=>'fr') eq <<END,"start_html()"); 82<!DOCTYPE html 83 PUBLIC "-//IETF//DTD HTML 3.2//FR"> 84<html lang="fr"><head><title>Untitled Document</title> 85</head> 86<body> 87END 88 ; 89test(16,($cookie=cookie(-name=>'fred',-value=>['chocolate','chip'],-path=>'/')) eq 'fred=chocolate&chip; path=/',"cookie()"); 90my $h = header(-Cookie=>$cookie); 91test(17,$h =~ m!^Set-Cookie: fred=chocolate&chip\; path=/${CRLF}Date:.*${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!s, 92 "header(-cookie)"); 93test(18,start_h3 eq '<h3>'); 94test(19,end_h3 eq '</h3>'); 95test(20,start_table({-border=>undef}) eq '<table border>'); 96test(21,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is <not> ‹right›</h1>'); 97charset('utf-8'); 98if (ord("\t") == 9) { 99test(22,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is <not> �right�</h1>'); 100} 101else { 102test(22,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is <not> �right�</h1>'); 103} 104test(23,i(p('hello there')) eq '<i><p>hello there</p></i>'); 105my $q = new CGI; 106test(24,$q->h1('hi') eq '<h1>hi</h1>'); 107 108$q->autoEscape(1); 109test(25,$q->p({title=>"hello worldè"},'hello á') eq '<p title="hello world&egrave;">hello á</p>'); 110$q->autoEscape(0); 111test(26,$q->p({title=>"hello worldè"},'hello á') eq '<p title="hello worldè">hello á</p>'); 112test(27,p({title=>"hello worldè"},'hello á') eq '<p title="hello world&egrave;">hello á</p>'); 113test(28,header(-type=>'image/gif',-charset=>'UTF-8') eq "Content-Type: image/gif; charset=UTF-8${CRLF}${CRLF}","header()"); 114