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