Upgrade to CGI.pm 3.08

[p5sagit/p5-mst-13.2.git] / lib / CGI / Pretty.pm

diff --git a/lib/CGI/Pretty.pm b/lib/CGI/Pretty.pm
index 4f2eed4..2147143 100644 (file)
--- a/lib/CGI/Pretty.pm
+++ b/lib/CGI/Pretty.pm
@@ -10,7 +10,7 @@ package CGI::Pretty;
 use strict;
 use CGI ();
 
-$CGI::Pretty::VERSION = '1.03';
+$CGI::Pretty::VERSION = '1.08';
 $CGI::DefaultClass = __PACKAGE__;
 $CGI::Pretty::AutoloadClass = 'CGI';
 @CGI::Pretty::ISA = qw( CGI );
@@ -19,14 +19,23 @@ initialize_globals();
 
 sub _prettyPrint {
     my $input = shift;
+    return if !$$input;
+    return if !$CGI::Pretty::LINEBREAK || !$CGI::Pretty::INDENT;
+
+#    print STDERR "'", $$input, "'\n";
 
     foreach my $i ( @CGI::Pretty::AS_IS ) {
-       if ( $$input =~ /<\/$i>/si ) {
-           my ( $a, $b, $c, $d, $e ) = $$input =~ /(.*)<$i(\s?)(.*?)>(.*?)<\/$i>(.*)/si;
-           _prettyPrint( \$a );
-           _prettyPrint( \$e );
+       if ( $$input =~ m{</$i>}si ) {
+           my ( $a, $b, $c ) = $$input =~ m{(.*)(<$i[\s/>].*?</$i>)(.*)}si;
+           next if !$b;
+           $a ||= "";
+           $c ||= "";
+
+           _prettyPrint( \$a ) if $a;
+           _prettyPrint( \$c ) if $c;
            
-           $$input = "$a<$i$b$c>$d</$i>$e";
+           $b ||= "";
+           $$input = "$a$b$c";
            return;
        }
     }
@@ -37,14 +46,13 @@ sub comment {
     my($self,@p) = CGI::self_or_CGI(@_);
 
     my $s = "@p";
-    $s =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g; 
+    $s =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g if $CGI::Pretty::LINEBREAK; 
     
     return $self->SUPER::comment( "$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT$s$CGI::Pretty::LINEBREAK" ) . $CGI::Pretty::LINEBREAK;
 }
 
 sub _make_tag_func {
     my ($self,$tagname) = @_;
-    return $self->SUPER::_make_tag_func($tagname) if $tagname=~/^(start|end)_/;
 
     # As Lincoln as noted, the last else clause is VERY hairy, and it
     # took me a while to figure out what I was trying to do.
@@ -57,51 +65,74 @@ sub _make_tag_func {
     # guru, so if anybody wants to contribute something that would
     # be quicker, easier to read, etc, I would be more than
     # willing to put it in - Brian
-    
-    return qq{
-       sub $tagname { 
-           # handle various cases in which we're called
-           # most of this bizarre stuff is to avoid -w errors
-           shift if \$_[0] && 
-               (!ref(\$_[0]) && \$_[0] eq \$CGI::DefaultClass) ||
-                   (ref(\$_[0]) &&
-                    (substr(ref(\$_[0]),0,3) eq 'CGI' ||
-                   UNIVERSAL::isa(\$_[0],'CGI')));
-           
-           my(\$attr) = '';
-           if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') {
-               my(\@attr) = make_attributes('',shift);
-               \$attr = " \@attr" if \@attr;
-           }
-
-           my(\$tag,\$untag) = ("\U<$tagname\E\$attr>","\U</$tagname>\E");
-           return \$tag unless \@_;
 
-           my \@result;
-           my \$NON_PRETTIFY_ENDTAGS =  join "", map { "</\$_>" } \@CGI::Pretty::AS_IS;
-
-           if ( \$NON_PRETTIFY_ENDTAGS =~ /\$untag/ ) {
+    my $func = qq"
+       sub $tagname {";
+
+    $func .= q'
+            shift if $_[0] && 
+                    (ref($_[0]) &&
+                     (substr(ref($_[0]),0,3) eq "CGI" ||
+                    UNIVERSAL::isa($_[0],"CGI")));
+           my($attr) = "";
+           if (ref($_[0]) && ref($_[0]) eq "HASH") {
+               my(@attr) = make_attributes(shift()||undef,1);
+               $attr = " @attr" if @attr;
+           }';
+
+    if ($tagname=~/start_(\w+)/i) {
+       $func .= qq! 
+            return "<\L$1\E\$attr>\$CGI::Pretty::LINEBREAK";} !;
+    } elsif ($tagname=~/end_(\w+)/i) {
+       $func .= qq! 
+            return "<\L/$1\E>\$CGI::Pretty::LINEBREAK"; } !;
+    } else {
+       $func .= qq#
+           return ( \$CGI::XHTML ? "<\L$tagname\E\$attr />" : "<\L$tagname\E\$attr>" ) .
+                   \$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') {
+                 \@args = \@{\$_[0]}
+              } else {
+                  foreach (\@_) {
+                     \$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];
+             }
+            }
+            else {
+              \@args = ref(\$_[0]) eq 'ARRAY' ? \@{\$_[0]} : "\@_";
+            }
+
+            my \@result;
+            if ( exists \$ASIS{ "\L$tagname\E" } ) {
                \@result = map { "\$tag\$_\$untag\$CGI::Pretty::LINEBREAK" } 
-                (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
+                \@args;
            }
            else {
                \@result = map { 
                    chomp; 
-                   if ( \$_ !~ /<\\// ) {
-                       s/\$CGI::Pretty::LINEBREAK/\$CGI::Pretty::LINEBREAK\$CGI::Pretty::INDENT/g; 
-                   } 
-                   else {
-                       my \$tmp = \$_;
-                       CGI::Pretty::_prettyPrint( \\\$tmp );
-                       \$_ = \$tmp;
-                   }
-                   "\$tag\$CGI::Pretty::LINEBREAK\$CGI::Pretty::INDENT\$_\$CGI::Pretty::LINEBREAK\$untag\$CGI::Pretty::LINEBREAK" } 
-               (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
+                   my \$tmp = \$_;
+                   CGI::Pretty::_prettyPrint( \\\$tmp );
+                    \$tag . \$CGI::Pretty::LINEBREAK .
+                    \$CGI::Pretty::INDENT . \$tmp . \$CGI::Pretty::LINEBREAK . 
+                    \$untag . \$CGI::Pretty::LINEBREAK
+                } \@args;
            }
-           local \$" = "";
+           local \$" = "" if \$CGI::Pretty::LINEBREAK || \$CGI::Pretty::INDENT;
            return "\@result";
-       }
-    };
+       }#;
+    }    
+
+    return $func;
 }
 
 sub start_html {
@@ -116,7 +147,16 @@ sub new {
     my $class = shift;
     my $this = $class->SUPER::new( @_ );
 
-    Apache->request->register_cleanup(\&CGI::Pretty::_reset_globals) if ($CGI::MOD_PERL);
+    if ($CGI::MOD_PERL) {
+        if ($CGI::MOD_PERL == 1) {
+            my $r = Apache->request;
+            $r->register_cleanup(\&CGI::Pretty::_reset_globals);
+        }
+        else {
+            my $r = Apache2::RequestUtil->request;
+            $r->pool->cleanup_register(\&CGI::Pretty::_reset_globals);
+        }
+    }
     $class->_reset_globals if $CGI::PERLEX;
 
     return bless $this, $class;
@@ -127,10 +167,10 @@ sub initialize_globals {
     $CGI::Pretty::INDENT = "\t";
     
     # This is the string used for seperation between tags
-    $CGI::Pretty::LINEBREAK = "\n";
+    $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;
 }