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