Only 21 tests, skipping or not.
[p5sagit/p5-mst-13.2.git] / lib / CGI / Pretty.pm
CommitLineData
3538e1d5 1package 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
ffd2dff2 10use strict;
3538e1d5 11use CGI ();
12
76fbd8c4 13$CGI::Pretty::VERSION = '1.05_00';
3538e1d5 14$CGI::DefaultClass = __PACKAGE__;
ffd2dff2 15$CGI::Pretty::AutoloadClass = 'CGI';
16@CGI::Pretty::ISA = qw( CGI );
3538e1d5 17
ffd2dff2 18initialize_globals();
19
20sub _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 }
ba056755 33 $$input =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g if $CGI::Pretty::LINEBREAK;
ffd2dff2 34}
35
36sub comment {
37 my($self,@p) = CGI::self_or_CGI(@_);
38
39 my $s = "@p";
ba056755 40 $s =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g if $CGI::Pretty::LINEBREAK;
ffd2dff2 41
42 return $self->SUPER::comment( "$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT$s$CGI::Pretty::LINEBREAK" ) . $CGI::Pretty::LINEBREAK;
43}
3538e1d5 44
45sub _make_tag_func {
46 my ($self,$tagname) = @_;
47 return $self->SUPER::_make_tag_func($tagname) if $tagname=~/^(start|end)_/;
48
ffd2dff2 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
3538e1d5 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
3d1a2ec4 65 shift if \$_[0] &&
66 (ref(\$_[0]) &&
67 (substr(ref(\$_[0]),0,3) eq 'CGI' ||
68 UNIVERSAL::isa(\$_[0],'CGI')));
ba056755 69
3538e1d5 70 my(\$attr) = '';
71 if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') {
3d1a2ec4 72 my(\@attr) = make_attributes(shift);
3538e1d5 73 \$attr = " \@attr" if \@attr;
74 }
75
6b4ac661 76 my(\$tag,\$untag) = ("\L<$tagname\E\$attr>","\L</$tagname>\E");
3538e1d5 77 return \$tag unless \@_;
78
79 my \@result;
ffd2dff2 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" }
3538e1d5 84 (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
85 }
86 else {
87 \@result = map {
88 chomp;
89 if ( \$_ !~ /<\\// ) {
ba056755 90 s/\$CGI::Pretty::LINEBREAK/\$CGI::Pretty::LINEBREAK\$CGI::Pretty::INDENT/g if \$CGI::Pretty::LINEBREAK;
3538e1d5 91 }
92 else {
ffd2dff2 93 my \$tmp = \$_;
94 CGI::Pretty::_prettyPrint( \\\$tmp );
95 \$_ = \$tmp;
3538e1d5 96 }
ffd2dff2 97 "\$tag\$CGI::Pretty::LINEBREAK\$CGI::Pretty::INDENT\$_\$CGI::Pretty::LINEBREAK\$untag\$CGI::Pretty::LINEBREAK" }
3538e1d5 98 (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
99 }
ffd2dff2 100 local \$" = "";
3538e1d5 101 return "\@result";
102 }
103 };
104}
105
ffd2dff2 106sub start_html {
107 return CGI::start_html( @_ ) . $CGI::Pretty::LINEBREAK;
108}
109
110sub end_html {
111 return CGI::end_html( @_ ) . $CGI::Pretty::LINEBREAK;
112}
113
3538e1d5 114sub new {
115 my $class = shift;
116 my $this = $class->SUPER::new( @_ );
117
ffd2dff2 118 Apache->request->register_cleanup(\&CGI::Pretty::_reset_globals) if ($CGI::MOD_PERL);
119 $class->_reset_globals if $CGI::PERLEX;
120
3538e1d5 121 return bless $this, $class;
122}
123
ffd2dff2 124sub initialize_globals {
125 # This is the string used for indentation of tags
126 $CGI::Pretty::INDENT = "\t";
127
128 # This is the string used for seperation between tags
129 $CGI::Pretty::LINEBREAK = "\n";
130
131 # These tags are not prettify'd.
6b4ac661 132 @CGI::Pretty::AS_IS = qw( a pre code script textarea );
ffd2dff2 133
134 1;
135}
136sub _reset_globals { initialize_globals(); }
137
3538e1d5 1381;
139
140=head1 NAME
141
142CGI::Pretty - module to produce nicely formatted HTML code
143
144=head1 SYNOPSIS
145
146 use CGI::Pretty qw( :html3 );
147
148 # Print a table with a single data element
149 print table( TR( td( "foo" ) ) );
150
151=head1 DESCRIPTION
152
153CGI::Pretty is a module that derives from CGI. It's sole function is to
154allow users of CGI to output nicely formatted HTML code.
155
156When using the CGI module, the following code:
157 print table( TR( td( "foo" ) ) );
158
159produces the following output:
160 <TABLE><TR><TD>foo</TD></TR></TABLE>
161
162If a user were to create a table consisting of many rows and many columns,
163the resultant HTML code would be quite difficult to read since it has no
164carriage returns or indentation.
165
166CGI::Pretty fixes this problem. What it does is add a carriage
167return and indentation to the HTML code so that one can easily read
168it.
169
170 print table( TR( td( "foo" ) ) );
171
172now produces the following output:
173 <TABLE>
174 <TR>
175 <TD>
176 foo
177 </TD>
178 </TR>
179 </TABLE>
180
181
182=head2 Tags that won't be formatted
183
184The <A> and <PRE> tags are not formatted. If these tags were formatted, the
185user would see the extra indentation on the web browser causing the page to
186look different than what would be expected. If you wish to add more tags to
187the list of tags that are not to be touched, push them onto the C<@AS_IS> array:
188
189 push @CGI::Pretty::AS_IS,qw(CODE XMP);
190
ffd2dff2 191=head2 Customizing the Indenting
192
193If you wish to have your own personal style of indenting, you can change the
194C<$INDENT> variable:
195
196 $CGI::Pretty::INDENT = "\t\t";
197
198would cause the indents to be two tabs.
199
200Similarly, if you wish to have more space between lines, you may change the
201C<$LINEBREAK> variable:
202
203 $CGI::Pretty::LINEBREAK = "\n\n";
204
205would create two carriage returns between lines.
206
207If you decide you want to use the regular CGI indenting, you can easily do
208the following:
209
210 $CGI::Pretty::INDENT = $CGI::Pretty::LINEBREAK = "";
211
3538e1d5 212=head1 BUGS
213
214This section intentionally left blank.
215
216=head1 AUTHOR
217
ffd2dff2 218Brian Paulsen <Brian@ThePaulsens.com>, with minor modifications by
3538e1d5 219Lincoln Stein <lstein@cshl.org> for incorporation into the CGI.pm
220distribution.
221
ffd2dff2 222Copyright 1999, Brian Paulsen. All rights reserved.
3538e1d5 223
224This library is free software; you can redistribute it and/or modify
225it under the same terms as Perl itself.
226
ffd2dff2 227Bug reports and comments to Brian@ThePaulsens.com. You can also write
3538e1d5 228to lstein@cshl.org, but this code looks pretty hairy to me and I'm not
229sure I understand it!
230
231=head1 SEE ALSO
232
233L<CGI>
234
235=cut