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 <[email protected]>, with minor modifications by
|
---|
260 | Lincoln Stein <[email protected]> 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 [email protected]. You can also write
|
---|
269 | to [email protected], 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
|
---|