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 CGI ();
  11
  12 $VERSION = '1.0';
  13 $CGI::DefaultClass = __PACKAGE__;
  14 $AutoloadClass = 'CGI';
  15 @ISA = 'CGI';
  16
  17 #    These tags should not be prettify'd.  If we did prettify them, the
  18 #    browser would output text that would have extraneous spaces
  19 @AS_IS = qw( A PRE );
  20 my $NON_PRETTIFY_ENDTAGS =  join "", map { "</$_>" } @AS_IS;
  21
  22 sub _make_tag_func {
  23     my ($self,$tagname) = @_;
  24     return $self->SUPER::_make_tag_func($tagname) if $tagname=~/^(start|end)_/;
  25
  26     return qq{
  27         sub $tagname {
  28             # handle various cases in which we're called
  29             # most of this bizarre stuff is to avoid -w errors
  30             shift if \$_[0] &&
  31 #               (!ref(\$_[0]) && \$_[0] eq \$CGI::DefaultClass) ||
  32                     (ref(\$_[0]) &&
  33                      (substr(ref(\$_[0]),0,3) eq 'CGI' ||
  34                     UNIVERSAL::isa(\$_[0],'CGI')));
  35
  36             my(\$attr) = '';
  37             if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') {
  38                 my(\@attr) = make_attributes('',shift);
  39                 \$attr = " \@attr" if \@attr;
  40             }
  41
  42             my(\$tag,\$untag) = ("\U<$tagname\E\$attr>","\U</$tagname>\E");
  43             return \$tag unless \@_;
  44
  45             my \@result;
  46             if ( "$NON_PRETTIFY_ENDTAGS" =~ /\$untag/ ) {
  47                 \@result = map { "\$tag\$_\$untag\\n" }
  48                  (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
  49             }
  50             else {
  51                 \@result = map {
  52                     chomp;
  53                     if ( \$_ !~ /<\\// ) {
  54                         s/\\n/\\n   /g;
  55                     }
  56                     else {
  57                         my \$text = "";
  58                         my ( \$pretag, \$thistag, \$posttag );
  59                         while ( /<\\/.*>/si ) {
  60                             if ( (\$pretag, \$thistag, \$posttag ) =
  61                                 /(.*?)<(.*?)>(.*)/si ) {
  62                                 \$pretag =~ s/\\n/\\n   /g;
  63                                 \$text .= "\$pretag<\$thistag>";
  64
  65                                 ( \$thistag ) = split ' ', \$thistag;
  66                                 my \$endtag = "</" . uc(\$thistag) . ">";
  67                                 if ( "$NON_PRETTIFY_ENDTAGS" =~ /\$endtag/ ) {
  68                                     if ( ( \$pretag, \$posttag ) =
  69                                         \$posttag =~ /(.*?)\$endtag(.*)/si ) {
  70                                         \$text .= "\$pretag\$endtag";
  71                                     }
  72                                 }
  73
  74                                 \$_ = \$posttag;
  75                             }
  76                         }
  77                         \$_ = \$text;
  78                         if ( defined \$posttag ) {
  79                             \$posttag =~ s/\\n/\\n   /g;
  80                             \$_ .= \$posttag;
  81                         }
  82                     }
  83                     "\$tag\\n   \$_\\n\$untag\\n" }
  84                 (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
  85             }
  86             return "\@result";
  87         }
  88     };
  89 }
  90
  91 sub new {
  92     my $class = shift;
  93     my $this = $class->SUPER::new( @_ );
  94
  95     return bless $this, $class;
  96 }
  97
  98 1;
  99
 100 =head1 NAME
 101
 102 CGI::Pretty - module to produce nicely formatted HTML code
 103
 104 =head1 SYNOPSIS
 105
 106     use CGI::Pretty qw( :html3 );
 107
 108     # Print a table with a single data element
 109     print table( TR( td( "foo" ) ) );
 110
 111 =head1 DESCRIPTION
 112
 113 CGI::Pretty is a module that derives from CGI.  It's sole function is to
 114 allow users of CGI to output nicely formatted HTML code.
 115
 116 When using the CGI module, the following code:
 117     print table( TR( td( "foo" ) ) );
 118
 119 produces the following output:
 120     <TABLE><TR><TD>foo</TD></TR></TABLE>
 121
 122 If a user were to create a table consisting of many rows and many columns,
 123 the resultant HTML code would be quite difficult to read since it has no
 124 carriage returns or indentation.
 125
 126 CGI::Pretty fixes this problem.  What it does is add a carriage
 127 return and indentation to the HTML code so that one can easily read
 128 it.
 129
 130     print table( TR( td( "foo" ) ) );
 131
 132 now produces the following output:
 133     <TABLE>
 134        <TR>
 135           <TD>
 136              foo
 137           </TD>
 138        </TR>
 139     </TABLE>
 140
 141
 142 =head2 Tags that won't be formatted
 143
 144 The <A> and <PRE> tags are not formatted.  If these tags were formatted, the
 145 user would see the extra indentation on the web browser causing the page to
 146 look different than what would be expected.  If you wish to add more tags to
 147 the list of tags that are not to be touched, push them onto the C<@AS_IS> array:
 148
 149     push @CGI::Pretty::AS_IS,qw(CODE XMP);
 150
 151 =head1 BUGS
 152
 153 This section intentionally left blank.
 154
 155 =head1 AUTHOR
 156
 157 Brian Paulsen <bpaulsen@lehman.com>, with minor modifications by
 158 Lincoln Stein <lstein@cshl.org> for incorporation into the CGI.pm
 159 distribution.
 160
 161 Copyright 1998, Brian Paulsen.  All rights reserved.
 162
 163 This library is free software; you can redistribute it and/or modify
 164 it under the same terms as Perl itself.
 165
 166 Bug reports and comments to bpaulsen@lehman.com.  You can also write
 167 to lstein@cshl.org, but this code looks pretty hairy to me and I'm not
 168 sure I understand it!
 169
 170 =head1 SEE ALSO
 171
 172 L<CGI>
 173
 174 =cut
 175