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 | |
10 | use CGI (); |
11 | |
12 | $VERSION = '1.0'; |
13 | $CGI::DefaultClass = __PACKAGE__; |
14 | $AutoloadClass = 'CGI'; |
15 | @ISA = 'CGI'; |
16 | |
17 | # These tags should not be prettify'd. If we did prettify them, the |
18 | # browser would output text that would have extraneous spaces |
19 | @AS_IS = qw( A PRE ); |
20 | my $NON_PRETTIFY_ENDTAGS = join "", map { "</$_>" } @AS_IS; |
21 | |
22 | sub _make_tag_func { |
23 | my ($self,$tagname) = @_; |
24 | return $self->SUPER::_make_tag_func($tagname) if $tagname=~/^(start|end)_/; |
25 | |
26 | return qq{ |
27 | sub $tagname { |
28 | # handle various cases in which we're called |
29 | # most of this bizarre stuff is to avoid -w errors |
30 | shift if \$_[0] && |
31 | # (!ref(\$_[0]) && \$_[0] eq \$CGI::DefaultClass) || |
32 | (ref(\$_[0]) && |
33 | (substr(ref(\$_[0]),0,3) eq 'CGI' || |
34 | UNIVERSAL::isa(\$_[0],'CGI'))); |
35 | |
36 | my(\$attr) = ''; |
37 | if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') { |
38 | my(\@attr) = make_attributes('',shift); |
39 | \$attr = " \@attr" if \@attr; |
40 | } |
41 | |
42 | my(\$tag,\$untag) = ("\U<$tagname\E\$attr>","\U</$tagname>\E"); |
43 | return \$tag unless \@_; |
44 | |
45 | my \@result; |
46 | if ( "$NON_PRETTIFY_ENDTAGS" =~ /\$untag/ ) { |
47 | \@result = map { "\$tag\$_\$untag\\n" } |
48 | (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_"; |
49 | } |
50 | else { |
51 | \@result = map { |
52 | chomp; |
53 | if ( \$_ !~ /<\\// ) { |
54 | s/\\n/\\n /g; |
55 | } |
56 | else { |
57 | my \$text = ""; |
58 | my ( \$pretag, \$thistag, \$posttag ); |
59 | while ( /<\\/.*>/si ) { |
60 | if ( (\$pretag, \$thistag, \$posttag ) = |
61 | /(.*?)<(.*?)>(.*)/si ) { |
62 | \$pretag =~ s/\\n/\\n /g; |
63 | \$text .= "\$pretag<\$thistag>"; |
64 | |
65 | ( \$thistag ) = split ' ', \$thistag; |
66 | my \$endtag = "</" . uc(\$thistag) . ">"; |
67 | if ( "$NON_PRETTIFY_ENDTAGS" =~ /\$endtag/ ) { |
68 | if ( ( \$pretag, \$posttag ) = |
69 | \$posttag =~ /(.*?)\$endtag(.*)/si ) { |
70 | \$text .= "\$pretag\$endtag"; |
71 | } |
72 | } |
73 | |
74 | \$_ = \$posttag; |
75 | } |
76 | } |
77 | \$_ = \$text; |
78 | if ( defined \$posttag ) { |
79 | \$posttag =~ s/\\n/\\n /g; |
80 | \$_ .= \$posttag; |
81 | } |
82 | } |
83 | "\$tag\\n \$_\\n\$untag\\n" } |
84 | (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_"; |
85 | } |
86 | return "\@result"; |
87 | } |
88 | }; |
89 | } |
90 | |
91 | sub new { |
92 | my $class = shift; |
93 | my $this = $class->SUPER::new( @_ ); |
94 | |
95 | return bless $this, $class; |
96 | } |
97 | |
98 | 1; |
99 | |
100 | =head1 NAME |
101 | |
102 | CGI::Pretty - module to produce nicely formatted HTML code |
103 | |
104 | =head1 SYNOPSIS |
105 | |
106 | use CGI::Pretty qw( :html3 ); |
107 | |
108 | # Print a table with a single data element |
109 | print table( TR( td( "foo" ) ) ); |
110 | |
111 | =head1 DESCRIPTION |
112 | |
113 | CGI::Pretty is a module that derives from CGI. It's sole function is to |
114 | allow users of CGI to output nicely formatted HTML code. |
115 | |
116 | When using the CGI module, the following code: |
117 | print table( TR( td( "foo" ) ) ); |
118 | |
119 | produces the following output: |
120 | <TABLE><TR><TD>foo</TD></TR></TABLE> |
121 | |
122 | If a user were to create a table consisting of many rows and many columns, |
123 | the resultant HTML code would be quite difficult to read since it has no |
124 | carriage returns or indentation. |
125 | |
126 | CGI::Pretty fixes this problem. What it does is add a carriage |
127 | return and indentation to the HTML code so that one can easily read |
128 | it. |
129 | |
130 | print table( TR( td( "foo" ) ) ); |
131 | |
132 | now produces the following output: |
133 | <TABLE> |
134 | <TR> |
135 | <TD> |
136 | foo |
137 | </TD> |
138 | </TR> |
139 | </TABLE> |
140 | |
141 | |
142 | =head2 Tags that won't be formatted |
143 | |
144 | The <A> and <PRE> tags are not formatted. If these tags were formatted, the |
145 | user would see the extra indentation on the web browser causing the page to |
146 | look different than what would be expected. If you wish to add more tags to |
147 | the list of tags that are not to be touched, push them onto the C<@AS_IS> array: |
148 | |
149 | push @CGI::Pretty::AS_IS,qw(CODE XMP); |
150 | |
151 | =head1 BUGS |
152 | |
153 | This section intentionally left blank. |
154 | |
155 | =head1 AUTHOR |
156 | |
157 | Brian Paulsen <bpaulsen@lehman.com>, with minor modifications by |
158 | Lincoln Stein <lstein@cshl.org> for incorporation into the CGI.pm |
159 | distribution. |
160 | |
161 | Copyright 1998, Brian Paulsen. All rights reserved. |
162 | |
163 | This library is free software; you can redistribute it and/or modify |
164 | it under the same terms as Perl itself. |
165 | |
166 | Bug reports and comments to bpaulsen@lehman.com. You can also write |
167 | to lstein@cshl.org, but this code looks pretty hairy to me and I'm not |
168 | sure I understand it! |
169 | |
170 | =head1 SEE ALSO |
171 | |
172 | L<CGI> |
173 | |
174 | =cut |
175 | |