| 1 | package 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 | |
| 10 | use strict; |
| 11 | use CGI (); |
| 12 | |
| 13 | $CGI::Pretty::VERSION = '1.08'; |
| 14 | $CGI::DefaultClass = __PACKAGE__; |
| 15 | $CGI::Pretty::AutoloadClass = 'CGI'; |
| 16 | @CGI::Pretty::ISA = qw( CGI ); |
| 17 | |
| 18 | initialize_globals(); |
| 19 | |
| 20 | sub _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 | |
| 45 | sub 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 | |
| 54 | sub _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 | |
| 138 | sub start_html { |
| 139 | return CGI::start_html( @_ ) . $CGI::Pretty::LINEBREAK; |
| 140 | } |
| 141 | |
| 142 | sub end_html { |
| 143 | return CGI::end_html( @_ ) . $CGI::Pretty::LINEBREAK; |
| 144 | } |
| 145 | |
| 146 | sub 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 | |
| 165 | sub 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 | } |
| 177 | sub _reset_globals { initialize_globals(); } |
| 178 | |
| 179 | 1; |
| 180 | |
| 181 | =head1 NAME |
| 182 | |
| 183 | CGI::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 | |
| 194 | CGI::Pretty is a module that derives from CGI. It's sole function is to |
| 195 | allow users of CGI to output nicely formatted HTML code. |
| 196 | |
| 197 | When using the CGI module, the following code: |
| 198 | print table( TR( td( "foo" ) ) ); |
| 199 | |
| 200 | produces the following output: |
| 201 | <TABLE><TR><TD>foo</TD></TR></TABLE> |
| 202 | |
| 203 | If a user were to create a table consisting of many rows and many columns, |
| 204 | the resultant HTML code would be quite difficult to read since it has no |
| 205 | carriage returns or indentation. |
| 206 | |
| 207 | CGI::Pretty fixes this problem. What it does is add a carriage |
| 208 | return and indentation to the HTML code so that one can easily read |
| 209 | it. |
| 210 | |
| 211 | print table( TR( td( "foo" ) ) ); |
| 212 | |
| 213 | now 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 | |
| 225 | The <A> and <PRE> tags are not formatted. If these tags were formatted, the |
| 226 | user would see the extra indentation on the web browser causing the page to |
| 227 | look different than what would be expected. If you wish to add more tags to |
| 228 | the 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 | |
| 234 | If you wish to have your own personal style of indenting, you can change the |
| 235 | C<$INDENT> variable: |
| 236 | |
| 237 | $CGI::Pretty::INDENT = "\t\t"; |
| 238 | |
| 239 | would cause the indents to be two tabs. |
| 240 | |
| 241 | Similarly, if you wish to have more space between lines, you may change the |
| 242 | C<$LINEBREAK> variable: |
| 243 | |
| 244 | $CGI::Pretty::LINEBREAK = "\n\n"; |
| 245 | |
| 246 | would create two carriage returns between lines. |
| 247 | |
| 248 | If you decide you want to use the regular CGI indenting, you can easily do |
| 249 | the following: |
| 250 | |
| 251 | $CGI::Pretty::INDENT = $CGI::Pretty::LINEBREAK = ""; |
| 252 | |
| 253 | =head1 BUGS |
| 254 | |
| 255 | This section intentionally left blank. |
| 256 | |
| 257 | =head1 AUTHOR |
| 258 | |
| 259 | Brian Paulsen <Brian@ThePaulsens.com>, with minor modifications by |
| 260 | Lincoln Stein <lstein@cshl.org> for incorporation into the CGI.pm |
| 261 | distribution. |
| 262 | |
| 263 | Copyright 1999, Brian Paulsen. All rights reserved. |
| 264 | |
| 265 | This library is free software; you can redistribute it and/or modify |
| 266 | it under the same terms as Perl itself. |
| 267 | |
| 268 | Bug reports and comments to Brian@ThePaulsens.com. You can also write |
| 269 | to lstein@cshl.org, but this code looks pretty hairy to me and I'm not |
| 270 | sure I understand it! |
| 271 | |
| 272 | =head1 SEE ALSO |
| 273 | |
| 274 | L<CGI> |
| 275 | |
| 276 | =cut |