| 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 <[email protected]>, with minor modifications by
|
|---|
| 260 | Lincoln Stein <[email protected]> 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 [email protected]. You can also write
|
|---|
| 269 | to [email protected], 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
|
|---|
