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