1package CGI::Pretty; 2 3# See the bottom of this file for the POD documentation. Search for the 4# string '=head'. 5 6# You can run this file through either pod2man or pod2html to produce pretty 7# documentation in manual or html file format (these utilities are part of the 8# Perl 5 distribution). 9 10use strict; 11use CGI (); 12 13$CGI::Pretty::VERSION = '1.08'; 14$CGI::DefaultClass = __PACKAGE__; 15$CGI::Pretty::AutoloadClass = 'CGI'; 16@CGI::Pretty::ISA = qw( CGI ); 17 18initialize_globals(); 19 20sub _prettyPrint { 21 my $input = shift; 22 return if !$$input; 23 return if !$CGI::Pretty::LINEBREAK || !$CGI::Pretty::INDENT; 24 25# print STDERR "'", $$input, "'\n"; 26 27 foreach my $i ( @CGI::Pretty::AS_IS ) { 28 if ( $$input =~ m{</$i>}si ) { 29 my ( $a, $b, $c ) = $$input =~ m{(.*)(<$i[\s/>].*?</$i>)(.*)}si; 30 next if !$b; 31 $a ||= ""; 32 $c ||= ""; 33 34 _prettyPrint( \$a ) if $a; 35 _prettyPrint( \$c ) if $c; 36 37 $b ||= ""; 38 $$input = "$a$b$c"; 39 return; 40 } 41 } 42 $$input =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g; 43} 44 45sub comment { 46 my($self,@p) = CGI::self_or_CGI(@_); 47 48 my $s = "@p"; 49 $s =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g if $CGI::Pretty::LINEBREAK; 50 51 return $self->SUPER::comment( "$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT$s$CGI::Pretty::LINEBREAK" ) . $CGI::Pretty::LINEBREAK; 52} 53 54sub _make_tag_func { 55 my ($self,$tagname) = @_; 56 57 # As Lincoln as noted, the last else clause is VERY hairy, and it 58 # took me a while to figure out what I was trying to do. 59 # What it does is look for tags that shouldn't be indented (e.g. PRE) 60 # and makes sure that when we nest tags, those tags don't get 61 # indented. 62 # For an example, try print td( pre( "hello\nworld" ) ); 63 # If we didn't care about stuff like that, the code would be 64 # MUCH simpler. BTW: I won't claim to be a regular expression 65 # guru, so if anybody wants to contribute something that would 66 # be quicker, easier to read, etc, I would be more than 67 # willing to put it in - Brian 68 69 my $func = qq" 70 sub $tagname {"; 71 72 $func .= q' 73 shift if $_[0] && 74 (ref($_[0]) && 75 (substr(ref($_[0]),0,3) eq "CGI" || 76 UNIVERSAL::isa($_[0],"CGI"))); 77 my($attr) = ""; 78 if (ref($_[0]) && ref($_[0]) eq "HASH") { 79 my(@attr) = make_attributes(shift()||undef,1); 80 $attr = " @attr" if @attr; 81 }'; 82 83 if ($tagname=~/start_(\w+)/i) { 84 $func .= qq! 85 return "<\L$1\E\$attr>\$CGI::Pretty::LINEBREAK";} !; 86 } elsif ($tagname=~/end_(\w+)/i) { 87 $func .= qq! 88 return "<\L/$1\E>\$CGI::Pretty::LINEBREAK"; } !; 89 } else { 90 $func .= qq# 91 return ( \$CGI::XHTML ? "<\L$tagname\E\$attr />" : "<\L$tagname\E\$attr>" ) . 92 \$CGI::Pretty::LINEBREAK unless \@_; 93 my(\$tag,\$untag) = ("<\L$tagname\E\$attr>","</\L$tagname>\E"); 94 95 my \%ASIS = map { lc("\$_") => 1 } \@CGI::Pretty::AS_IS; 96 my \@args; 97 if ( \$CGI::Pretty::LINEBREAK || \$CGI::Pretty::INDENT ) { 98 if(ref(\$_[0]) eq 'ARRAY') { 99 \@args = \@{\$_[0]} 100 } else { 101 foreach (\@_) { 102 \$args[0] .= \$_; 103 \$args[0] .= \$CGI::Pretty::LINEBREAK if \$args[0] !~ /\$CGI::Pretty::LINEBREAK\$/ && 0; 104 chomp \$args[0] if exists \$ASIS{ "\L$tagname\E" }; 105 106 \$args[0] .= \$" if \$args[0] !~ /\$CGI::Pretty::LINEBREAK\$/ && 1; 107 } 108 chop \$args[0]; 109 } 110 } 111 else { 112 \@args = ref(\$_[0]) eq 'ARRAY' ? \@{\$_[0]} : "\@_"; 113 } 114 115 my \@result; 116 if ( exists \$ASIS{ "\L$tagname\E" } ) { 117 \@result = map { "\$tag\$_\$untag\$CGI::Pretty::LINEBREAK" } 118 \@args; 119 } 120 else { 121 \@result = map { 122 chomp; 123 my \$tmp = \$_; 124 CGI::Pretty::_prettyPrint( \\\$tmp ); 125 \$tag . \$CGI::Pretty::LINEBREAK . 126 \$CGI::Pretty::INDENT . \$tmp . \$CGI::Pretty::LINEBREAK . 127 \$untag . \$CGI::Pretty::LINEBREAK 128 } \@args; 129 } 130 local \$" = "" if \$CGI::Pretty::LINEBREAK || \$CGI::Pretty::INDENT; 131 return "\@result"; 132 }#; 133 } 134 135 return $func; 136} 137 138sub start_html { 139 return CGI::start_html( @_ ) . $CGI::Pretty::LINEBREAK; 140} 141 142sub end_html { 143 return CGI::end_html( @_ ) . $CGI::Pretty::LINEBREAK; 144} 145 146sub new { 147 my $class = shift; 148 my $this = $class->SUPER::new( @_ ); 149 150 if ($CGI::MOD_PERL) { 151 if ($CGI::MOD_PERL == 1) { 152 my $r = Apache->request; 153 $r->register_cleanup(\&CGI::Pretty::_reset_globals); 154 } 155 else { 156 my $r = Apache2::RequestUtil->request; 157 $r->pool->cleanup_register(\&CGI::Pretty::_reset_globals); 158 } 159 } 160 $class->_reset_globals if $CGI::PERLEX; 161 162 return bless $this, $class; 163} 164 165sub initialize_globals { 166 # This is the string used for indentation of tags 167 $CGI::Pretty::INDENT = "\t"; 168 169 # This is the string used for seperation between tags 170 $CGI::Pretty::LINEBREAK = $/; 171 172 # These tags are not prettify'd. 173 @CGI::Pretty::AS_IS = qw( a pre code script textarea td ); 174 175 1; 176} 177sub _reset_globals { initialize_globals(); } 178 1791; 180 181=head1 NAME 182 183CGI::Pretty - module to produce nicely formatted HTML code 184 185=head1 SYNOPSIS 186 187 use CGI::Pretty qw( :html3 ); 188 189 # Print a table with a single data element 190 print table( TR( td( "foo" ) ) ); 191 192=head1 DESCRIPTION 193 194CGI::Pretty is a module that derives from CGI. It's sole function is to 195allow users of CGI to output nicely formatted HTML code. 196 197When using the CGI module, the following code: 198 print table( TR( td( "foo" ) ) ); 199 200produces the following output: 201 <TABLE><TR><TD>foo</TD></TR></TABLE> 202 203If a user were to create a table consisting of many rows and many columns, 204the resultant HTML code would be quite difficult to read since it has no 205carriage returns or indentation. 206 207CGI::Pretty fixes this problem. What it does is add a carriage 208return and indentation to the HTML code so that one can easily read 209it. 210 211 print table( TR( td( "foo" ) ) ); 212 213now produces the following output: 214 <TABLE> 215 <TR> 216 <TD> 217 foo 218 </TD> 219 </TR> 220 </TABLE> 221 222 223=head2 Tags that won't be formatted 224 225The <A> and <PRE> tags are not formatted. If these tags were formatted, the 226user would see the extra indentation on the web browser causing the page to 227look different than what would be expected. If you wish to add more tags to 228the list of tags that are not to be touched, push them onto the C<@AS_IS> array: 229 230 push @CGI::Pretty::AS_IS,qw(CODE XMP); 231 232=head2 Customizing the Indenting 233 234If you wish to have your own personal style of indenting, you can change the 235C<$INDENT> variable: 236 237 $CGI::Pretty::INDENT = "\t\t"; 238 239would cause the indents to be two tabs. 240 241Similarly, if you wish to have more space between lines, you may change the 242C<$LINEBREAK> variable: 243 244 $CGI::Pretty::LINEBREAK = "\n\n"; 245 246would create two carriage returns between lines. 247 248If you decide you want to use the regular CGI indenting, you can easily do 249the following: 250 251 $CGI::Pretty::INDENT = $CGI::Pretty::LINEBREAK = ""; 252 253=head1 BUGS 254 255This section intentionally left blank. 256 257=head1 AUTHOR 258 259Brian Paulsen <Brian@ThePaulsens.com>, with minor modifications by 260Lincoln Stein <lstein@cshl.org> for incorporation into the CGI.pm 261distribution. 262 263Copyright 1999, Brian Paulsen. All rights reserved. 264 265This library is free software; you can redistribute it and/or modify 266it under the same terms as Perl itself. 267 268Bug reports and comments to Brian@ThePaulsens.com. You can also write 269to lstein@cshl.org, but this code looks pretty hairy to me and I'm not 270sure I understand it! 271 272=head1 SEE ALSO 273 274L<CGI> 275 276=cut 277