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 | |
188ba755 |
13 | $CGI::Pretty::VERSION = '1.07_00'; |
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; |
188ba755 |
22 | return if !$$input; |
23 | return if !$CGI::Pretty::LINEBREAK || !$CGI::Pretty::INDENT; |
24 | |
25 | # print STDERR "'", $$input, "'\n"; |
ffd2dff2 |
26 | |
27 | foreach my $i ( @CGI::Pretty::AS_IS ) { |
188ba755 |
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; |
ffd2dff2 |
36 | |
188ba755 |
37 | $b ||= ""; |
38 | $$input = "$a$b$c"; |
ffd2dff2 |
39 | return; |
40 | } |
41 | } |
188ba755 |
42 | $$input =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g; |
ffd2dff2 |
43 | } |
44 | |
45 | sub comment { |
46 | my($self,@p) = CGI::self_or_CGI(@_); |
47 | |
48 | my $s = "@p"; |
ba056755 |
49 | $s =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g if $CGI::Pretty::LINEBREAK; |
ffd2dff2 |
50 | |
51 | return $self->SUPER::comment( "$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT$s$CGI::Pretty::LINEBREAK" ) . $CGI::Pretty::LINEBREAK; |
52 | } |
3538e1d5 |
53 | |
54 | sub _make_tag_func { |
55 | my ($self,$tagname) = @_; |
3538e1d5 |
56 | |
ffd2dff2 |
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 |
3538e1d5 |
68 | |
188ba755 |
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" } ) { |
ffd2dff2 |
117 | \@result = map { "\$tag\$_\$untag\$CGI::Pretty::LINEBREAK" } |
188ba755 |
118 | \@args; |
3538e1d5 |
119 | } |
120 | else { |
121 | \@result = map { |
122 | chomp; |
188ba755 |
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 |
ac734d8b |
128 | } \@args; |
3538e1d5 |
129 | } |
188ba755 |
130 | local \$" = "" if \$CGI::Pretty::LINEBREAK || \$CGI::Pretty::INDENT; |
3538e1d5 |
131 | return "\@result"; |
188ba755 |
132 | }#; |
133 | } |
134 | |
135 | return $func; |
3538e1d5 |
136 | } |
137 | |
ffd2dff2 |
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 | |
3538e1d5 |
146 | sub new { |
147 | my $class = shift; |
148 | my $this = $class->SUPER::new( @_ ); |
149 | |
ffd2dff2 |
150 | Apache->request->register_cleanup(\&CGI::Pretty::_reset_globals) if ($CGI::MOD_PERL); |
151 | $class->_reset_globals if $CGI::PERLEX; |
152 | |
3538e1d5 |
153 | return bless $this, $class; |
154 | } |
155 | |
ffd2dff2 |
156 | sub initialize_globals { |
157 | # This is the string used for indentation of tags |
158 | $CGI::Pretty::INDENT = "\t"; |
159 | |
160 | # This is the string used for seperation between tags |
188ba755 |
161 | $CGI::Pretty::LINEBREAK = $/; |
ffd2dff2 |
162 | |
163 | # These tags are not prettify'd. |
188ba755 |
164 | @CGI::Pretty::AS_IS = qw( a pre code script textarea td ); |
ffd2dff2 |
165 | |
166 | 1; |
167 | } |
168 | sub _reset_globals { initialize_globals(); } |
169 | |
3538e1d5 |
170 | 1; |
171 | |
172 | =head1 NAME |
173 | |
174 | CGI::Pretty - module to produce nicely formatted HTML code |
175 | |
176 | =head1 SYNOPSIS |
177 | |
178 | use CGI::Pretty qw( :html3 ); |
179 | |
180 | # Print a table with a single data element |
181 | print table( TR( td( "foo" ) ) ); |
182 | |
183 | =head1 DESCRIPTION |
184 | |
185 | CGI::Pretty is a module that derives from CGI. It's sole function is to |
186 | allow users of CGI to output nicely formatted HTML code. |
187 | |
188 | When using the CGI module, the following code: |
189 | print table( TR( td( "foo" ) ) ); |
190 | |
191 | produces the following output: |
192 | <TABLE><TR><TD>foo</TD></TR></TABLE> |
193 | |
194 | If a user were to create a table consisting of many rows and many columns, |
195 | the resultant HTML code would be quite difficult to read since it has no |
196 | carriage returns or indentation. |
197 | |
198 | CGI::Pretty fixes this problem. What it does is add a carriage |
199 | return and indentation to the HTML code so that one can easily read |
200 | it. |
201 | |
202 | print table( TR( td( "foo" ) ) ); |
203 | |
204 | now produces the following output: |
205 | <TABLE> |
206 | <TR> |
207 | <TD> |
208 | foo |
209 | </TD> |
210 | </TR> |
211 | </TABLE> |
212 | |
213 | |
214 | =head2 Tags that won't be formatted |
215 | |
216 | The <A> and <PRE> tags are not formatted. If these tags were formatted, the |
217 | user would see the extra indentation on the web browser causing the page to |
218 | look different than what would be expected. If you wish to add more tags to |
219 | the list of tags that are not to be touched, push them onto the C<@AS_IS> array: |
220 | |
221 | push @CGI::Pretty::AS_IS,qw(CODE XMP); |
222 | |
ffd2dff2 |
223 | =head2 Customizing the Indenting |
224 | |
225 | If you wish to have your own personal style of indenting, you can change the |
226 | C<$INDENT> variable: |
227 | |
228 | $CGI::Pretty::INDENT = "\t\t"; |
229 | |
230 | would cause the indents to be two tabs. |
231 | |
232 | Similarly, if you wish to have more space between lines, you may change the |
233 | C<$LINEBREAK> variable: |
234 | |
235 | $CGI::Pretty::LINEBREAK = "\n\n"; |
236 | |
237 | would create two carriage returns between lines. |
238 | |
239 | If you decide you want to use the regular CGI indenting, you can easily do |
240 | the following: |
241 | |
242 | $CGI::Pretty::INDENT = $CGI::Pretty::LINEBREAK = ""; |
243 | |
3538e1d5 |
244 | =head1 BUGS |
245 | |
246 | This section intentionally left blank. |
247 | |
248 | =head1 AUTHOR |
249 | |
ffd2dff2 |
250 | Brian Paulsen <Brian@ThePaulsens.com>, with minor modifications by |
3538e1d5 |
251 | Lincoln Stein <lstein@cshl.org> for incorporation into the CGI.pm |
252 | distribution. |
253 | |
ffd2dff2 |
254 | Copyright 1999, Brian Paulsen. All rights reserved. |
3538e1d5 |
255 | |
256 | This library is free software; you can redistribute it and/or modify |
257 | it under the same terms as Perl itself. |
258 | |
ffd2dff2 |
259 | Bug reports and comments to Brian@ThePaulsens.com. You can also write |
3538e1d5 |
260 | to lstein@cshl.org, but this code looks pretty hairy to me and I'm not |
261 | sure I understand it! |
262 | |
263 | =head1 SEE ALSO |
264 | |
265 | L<CGI> |
266 | |
267 | =cut |