Commit | Line | Data |
---|---|---|
920dae64 AT |
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 |