Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

more fixes for 5.8

  • Loading branch information...
commit 9ee6f9e73e47e1ed84a487d05b3684fb38d8eeb3 1 parent d9e6e21
lstein authored
Showing with 109 additions and 18 deletions.
  1. +7 −5 CGI.pm
  2. +11 −6 CGI/Pretty.pm
  3. +91 −7 t/pretty.t
View
12 CGI.pm
@@ -18,7 +18,7 @@ use Carp 'croak';
# The most recent version and complete docs are available at:
# http://stein.cshl.org/WWW/software/CGI/
-$CGI::revision = '$Id: CGI.pm,v 1.73 2002-10-11 15:07:05 lstein Exp $';
+$CGI::revision = '$Id: CGI.pm,v 1.74 2002-10-14 13:54:33 lstein Exp $';
$CGI::VERSION='2.88';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
@@ -3183,8 +3183,9 @@ sub new {
my $fv = ++$FH . $safename;
my $ref = \*{"Fh::$fv"};
$file =~ m!^([a-zA-Z0-9_ \'\":/.\$\\-]+)$! || return;
- sysopen($ref,$1,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600) || return;
- unlink($file) if $delete;
+ my $safe = $1;
+ sysopen($ref,$safe,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600) || return;
+ unlink($safe) if $delete;
CORE::delete $Fh::{$fv};
return bless $ref,$pack;
}
@@ -3483,8 +3484,9 @@ $MAXTRIES = 5000;
sub DESTROY {
my($self) = @_;
- $$self =~ /^(.+)$/; # untaint operation
- unlink $1; # get rid of the file
+ $$self =~ m!^([a-zA-Z0-9_ \'\":/.\$\\-]+)$! || return;
+ my $safe = $1; # untaint operation
+ unlink $safe; # get rid of the file
}
###############################################################################
View
17 CGI/Pretty.pm
@@ -10,7 +10,7 @@ package CGI::Pretty;
use strict;
use CGI ();
-$CGI::Pretty::VERSION = '1.06_00';
+$CGI::Pretty::VERSION = '1.07_00';
$CGI::DefaultClass = __PACKAGE__;
$CGI::Pretty::AutoloadClass = 'CGI';
@CGI::Pretty::ISA = qw( CGI );
@@ -22,6 +22,8 @@ sub _prettyPrint {
return if !$$input;
return if !$CGI::Pretty::LINEBREAK || !$CGI::Pretty::INDENT;
+# print STDERR "'", $$input, "'\n";
+
foreach my $i ( @CGI::Pretty::AS_IS ) {
if ( $$input =~ m{</$i>}si ) {
my ( $a, $b, $c ) = $$input =~ m{(.*)(<$i[\s/>].*?</$i>)(.*)}si;
@@ -90,6 +92,7 @@ sub _make_tag_func {
\$CGI::Pretty::LINEBREAK unless \@_;
my(\$tag,\$untag) = ("<\L$tagname\E\$attr>","</\L$tagname>\E");
+ my \%ASIS = map { lc("\$_") => 1 } \@CGI::Pretty::AS_IS;
my \@args;
if ( \$CGI::Pretty::LINEBREAK || \$CGI::Pretty::INDENT ) {
if(ref(\$_[0]) eq 'ARRAY') {
@@ -97,8 +100,10 @@ sub _make_tag_func {
} else {
foreach (\@_) {
\$args[0] .= \$_;
- chomp \$args[0];
- \$args[0] .= \$";
+ \$args[0] .= \$CGI::Pretty::LINEBREAK if \$args[0] !~ /\$CGI::Pretty::LINEBREAK\$/ && 0;
+ chomp \$args[0] if exists \$ASIS{ "\L$tagname\E" };
+
+ \$args[0] .= \$" if \$args[0] !~ /\$CGI::Pretty::LINEBREAK\$/ && 1;
}
chop \$args[0];
}
@@ -108,7 +113,7 @@ sub _make_tag_func {
}
my \@result;
- if ( exists( { map { lc("\$_") => 1 } \@CGI::Pretty::AS_IS }->{ "\L$tagname\E" } ) ) {
+ if ( exists \$ASIS{ "\L$tagname\E" } ) {
\@result = map { "\$tag\$_\$untag\$CGI::Pretty::LINEBREAK" }
\@args;
}
@@ -122,7 +127,7 @@ sub _make_tag_func {
\$untag . \$CGI::Pretty::LINEBREAK
} \@args;
}
- local \$" = "";
+ local \$" = "" if \$CGI::Pretty::LINEBREAK || \$CGI::Pretty::INDENT;
return "\@result";
}#;
}
@@ -156,7 +161,7 @@ sub initialize_globals {
$CGI::Pretty::LINEBREAK = $/;
# 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 td );
1;
}
View
98 t/pretty.t
@@ -1,21 +1,23 @@
-#!/usr/local/bin/perl -w
+#!/bin/perl -w
use strict;
-use lib 't/lib','../blib/lib','./blib/lib';
-use Test::More tests => 5;
+use lib '.', 't/lib','../blib/lib','./blib/lib';
+use Test::More tests => 18;
BEGIN { use_ok('CGI::Pretty') };
# This is silly use_ok should take arguments
use CGI::Pretty (':all');
-is(h1(), "<h1 />\n","single tag");
+is(h1(), '<h1 />
+',"single tag");
is(ol(li('fred'),li('ethel')), <<HTML, "basic indentation");
<ol>
<li>
fred
- </li> <li>
+ </li>
+ <li>
ethel
</li>
</ol>
@@ -24,14 +26,96 @@ HTML
is(p('hi',pre('there'),'frog'), <<HTML, "<pre> tags");
<p>
- hi <pre>there</pre> frog
+ hi <pre>there</pre>
+ frog
</p>
HTML
+is(h1({-align=>'CENTER'},'fred'), <<HTML, "open/close tag with attribute");
+<h1 align="CENTER">
+ fred
+</h1>
+HTML
+
+is(h1({-align=>undef},'fred'), <<HTML,"open/close tag with orphan attribute");
+<h1 align>
+ fred
+</h1>
+HTML
+
+is(h1({-align=>'CENTER'},['fred','agnes']), <<HTML, "distributive tag with attribute");
+<h1 align="CENTER">
+ fred
+</h1>
+<h1 align="CENTER">
+ agnes
+</h1>
+HTML
is(p('hi',a({-href=>'frog'},'there'),'frog'), <<HTML, "as-is");
<p>
- hi <a href="frog">there</a> frog
+ hi <a href="frog">there</a>
+ frog
</p>
HTML
+is(p([ qw( hi there frog ) ] ), <<HTML, "array-reference");
+<p>
+ hi
+</p>
+<p>
+ there
+</p>
+<p>
+ frog
+</p>
+HTML
+
+is(p(p(p('hi'), 'there' ), 'frog'), <<HTML, "nested tags");
+<p>
+ <p>
+ <p>
+ hi
+ </p>
+ there
+ </p>
+ frog
+</p>
+HTML
+
+is(table(TR(td(table(TR(td('hi', 'there', 'frog')))))), <<HTML, "nested as-is tags");
+<table>
+ <tr>
+ <td><table>
+ <tr>
+ <td>hi there frog</td>
+ </tr>
+ </table></td>
+ </tr>
+</table>
+HTML
+
+is(table(TR(td(table(TR(td( [ qw( hi there frog ) ])))))), <<HTML, "nested as-is array-reference");
+<table>
+ <tr>
+ <td><table>
+ <tr>
+ <td>hi</td>
+ <td>there</td>
+ <td>frog</td>
+ </tr>
+ </table></td>
+ </tr>
+</table>
+HTML
+
+$CGI::Pretty::INDENT = $CGI::Pretty::LINEBREAK = "";
+
+is(h1(), '<h1 />',"single tag (pretty turned off)");
+is(h1('fred'), '<h1>fred</h1>',"open/close tag (pretty turned off)");
+is(h1('fred','agnes','maura'), '<h1>fred agnes maura</h1>',"open/close tag multiple (pretty turned off)");
+is(h1({-align=>'CENTER'},'fred'), '<h1 align="CENTER">fred</h1>',"open/close tag with attribute (pretty turned off)");
+is(h1({-align=>undef},'fred'), '<h1 align>fred</h1>',"open/close tag with orphan attribute (pretty turned off)");
+is(h1({-align=>'CENTER'},['fred','agnes']), '<h1 align="CENTER">fred</h1> <h1 align="CENTER">agnes</h1>',
+ "distributive tag with attribute (pretty turned off)");
+

0 comments on commit 9ee6f9e

Please sign in to comment.
Something went wrong with that request. Please try again.