File Coverage

CGI/Pretty.pm
Criterion Covered Total %
statement 31 50 62.0
branch 13 24 54.2
condition 7 9 77.8
subroutine 5 10 50.0
pod 0 5 0.0
total 56 98 57.1


line stmt bran cond sub pod time code
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 1     1   16 use strict;
  1         16  
  1         16  
11 1     1   21 use CGI ();
  1         10  
  1         14  
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 61     61   640     my $input = shift;
22 61 50       542     return if !$$input;
23 61 100 66     858     return if !$CGI::Pretty::LINEBREAK || !$CGI::Pretty::INDENT;
24              
25             # print STDERR "'", $$input, "'\n";
26              
27 55         517     foreach my $i ( @CGI::Pretty::AS_IS ) {
28 321 100       5224 if ( $$input =~ m{</$i>}si ) {
29 22         468 my ( $a, $b, $c ) = $$input =~ m{(.*)(<$i[\s/>].*?</$i>)(.*)}si;
30 22 100       219 next if !$b;
31 18   100     166 $a ||= "";
32 18   100     159 $c ||= "";
33              
34 18 100       373 _prettyPrint( \$a ) if $a;
35 18 100       286 _prettyPrint( \$c ) if $c;
36            
37 18   50     168 $b ||= "";
38 18         184 $$input = "$a$b$c";
39 18         183 return;
40             }
41                 }
42 37         572     $$input =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g;
43             }
44              
45             sub comment {
46 0     0 0 0     my($self,@p) = CGI::self_or_CGI(@_);
47              
48 0         0     my $s = "@p";
49 0 0       0     $s =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g if $CGI::Pretty::LINEBREAK;
50                 
51 0         0     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 9     9   85     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 9         91     my $func = qq"
70             sub $tagname {";
71              
72 9         80     $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 9 50       95     if ($tagname=~/start_(\w+)/i) {
    50          
84 0         0 $func .= qq!
85             return "<\L$1\E\$attr>\$CGI::Pretty::LINEBREAK";} !;
86                 } elsif ($tagname=~/end_(\w+)/i) {
87 0         0 $func .= qq!
88             return "<\L/$1\E>\$CGI::Pretty::LINEBREAK"; } !;
89                 } else {
90 9         270 $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 9         191     return $func;
136             }
137              
138             sub start_html {
139 0     0 0 0     return CGI::start_html( @_ ) . $CGI::Pretty::LINEBREAK;
140             }
141              
142             sub end_html {
143 0     0 0 0     return CGI::end_html( @_ ) . $CGI::Pretty::LINEBREAK;
144             }
145              
146             sub new {
147 0     0 0 0     my $class = shift;
148 0         0     my $this = $class->SUPER::new( @_ );
149              
150 0 0       0     if ($CGI::MOD_PERL) {
151 0 0       0         if ($CGI::MOD_PERL == 1) {
152 0         0             my $r = Apache->request;
153 0         0             $r->register_cleanup(\&CGI::Pretty::_reset_globals);
154                     }
155                     else {
156 0         0             my $r = Apache2::RequestUtil->request;
157 0         0             $r->pool->cleanup_register(\&CGI::Pretty::_reset_globals);
158                     }
159                 }
160 0 0       0     $class->_reset_globals if $CGI::PERLEX;
161              
162 0         0     return bless $this, $class;
163             }
164              
165             sub initialize_globals {
166             # This is the string used for indentation of tags
167 1     1 0 10     $CGI::Pretty::INDENT = "\t";
168                 
169             # This is the string used for seperation between tags
170 1         10     $CGI::Pretty::LINEBREAK = $/;
171              
172             # These tags are not prettify'd.
173 1         13     @CGI::Pretty::AS_IS = qw( a pre code script textarea td );
174              
175 1         9     1;
176             }
177 0     0     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
277