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