[Summary view] [Print] [Text view]

   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