lib/CGI/Pretty.pm

   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         my $r = Apache->request;
 152         if ($CGI::MOD_PERL == 1) {
 153             $r->register_cleanup(\&CGI::Pretty::_reset_globals);
 154         }
 155         else {
 156             $r->pool->cleanup_register(\&CGI::Pretty::_reset_globals);
 157         }
 158     }
 159     $class->_reset_globals if $CGI::PERLEX;
 160
 161     return bless $this, $class;
 162 }
 163
 164 sub initialize_globals {
 165     # This is the string used for indentation of tags
 166     $CGI::Pretty::INDENT = "\t";
 167
 168     # This is the string used for seperation between tags
 169     $CGI::Pretty::LINEBREAK = $/;
 170
 171     # These tags are not prettify'd.
 172     @CGI::Pretty::AS_IS = qw( a pre code script textarea td );
 173
 174     1;
 175 }
 176 sub _reset_globals { initialize_globals(); }
 177
 178 1;
 179
 180 =head1 NAME
 181
 182 CGI::Pretty - module to produce nicely formatted HTML code
 183
 184 =head1 SYNOPSIS
 185
 186     use CGI::Pretty qw( :html3 );
 187
 188     # Print a table with a single data element
 189     print table( TR( td( "foo" ) ) );
 190
 191 =head1 DESCRIPTION
 192
 193 CGI::Pretty is a module that derives from CGI.  It's sole function is to
 194 allow users of CGI to output nicely formatted HTML code.
 195
 196 When using the CGI module, the following code:
 197     print table( TR( td( "foo" ) ) );
 198
 199 produces the following output:
 200     <TABLE><TR><TD>foo</TD></TR></TABLE>
 201
 202 If a user were to create a table consisting of many rows and many columns,
 203 the resultant HTML code would be quite difficult to read since it has no
 204 carriage returns or indentation.
 205
 206 CGI::Pretty fixes this problem.  What it does is add a carriage
 207 return and indentation to the HTML code so that one can easily read
 208 it.
 209
 210     print table( TR( td( "foo" ) ) );
 211
 212 now produces the following output:
 213     <TABLE>
 214        <TR>
 215           <TD>
 216              foo
 217           </TD>
 218        </TR>
 219     </TABLE>
 220
 221
 222 =head2 Tags that won't be formatted
 223
 224 The <A> and <PRE> tags are not formatted.  If these tags were formatted, the
 225 user would see the extra indentation on the web browser causing the page to
 226 look different than what would be expected.  If you wish to add more tags to
 227 the list of tags that are not to be touched, push them onto the C<@AS_IS> array:
 228
 229     push @CGI::Pretty::AS_IS,qw(CODE XMP);
 230
 231 =head2 Customizing the Indenting
 232
 233 If you wish to have your own personal style of indenting, you can change the
 234 C<$INDENT> variable:
 235
 236     $CGI::Pretty::INDENT = "\t\t";
 237
 238 would cause the indents to be two tabs.
 239
 240 Similarly, if you wish to have more space between lines, you may change the
 241 C<$LINEBREAK> variable:
 242
 243     $CGI::Pretty::LINEBREAK = "\n\n";
 244
 245 would create two carriage returns between lines.
 246
 247 If you decide you want to use the regular CGI indenting, you can easily do
 248 the following:
 249
 250     $CGI::Pretty::INDENT = $CGI::Pretty::LINEBREAK = "";
 251
 252 =head1 BUGS
 253
 254 This section intentionally left blank.
 255
 256 =head1 AUTHOR
 257
 258 Brian Paulsen <Brian@ThePaulsens.com>, with minor modifications by
 259 Lincoln Stein <lstein@cshl.org> for incorporation into the CGI.pm
 260 distribution.
 261
 262 Copyright 1999, Brian Paulsen.  All rights reserved.
 263
 264 This library is free software; you can redistribute it and/or modify
 265 it under the same terms as Perl itself.
 266
 267 Bug reports and comments to Brian@ThePaulsens.com.  You can also write
 268 to lstein@cshl.org, but this code looks pretty hairy to me and I'm not
 269 sure I understand it!
 270
 271 =head1 SEE ALSO
 272
 273 L<CGI>
 274
 275 =cut