Statistics
| Branch: | Tag: | Revision:

root / tools / perl / lib / CGI / Pretty.pm @ fa47cac2

History | View | Annotate | Download (9 kB)

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 = '3.46';
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] unless \$" eq "";
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" } \@args;
118
            }
119
	    else {
120
		\@result = map { 
121
		    chomp; 
122
		    my \$tmp = \$_;
123
		    CGI::Pretty::_prettyPrint( \\\$tmp );
124
                    \$tag . \$CGI::Pretty::LINEBREAK .
125
                    \$CGI::Pretty::INDENT . \$tmp . \$CGI::Pretty::LINEBREAK . 
126
                    \$untag . \$CGI::Pretty::LINEBREAK
127
                } \@args;
128
	    }
129
            if (\$CGI::Pretty::LINEBREAK || \$CGI::Pretty::INDENT) {
130
                return join ("", \@result);
131
            } else {
132
                return "\@result";
133
            }
134
	}#;
135
    }    
136

    
137
    return $func;
138
}
139

    
140
sub start_html {
141
    return CGI::start_html( @_ ) . $CGI::Pretty::LINEBREAK;
142
}
143

    
144
sub end_html {
145
    return CGI::end_html( @_ ) . $CGI::Pretty::LINEBREAK;
146
}
147

    
148
sub new {
149
    my $class = shift;
150
    my $this = $class->SUPER::new( @_ );
151

    
152
    if ($CGI::MOD_PERL) {
153
        if ($CGI::MOD_PERL == 1) {
154
            my $r = Apache->request;
155
            $r->register_cleanup(\&CGI::Pretty::_reset_globals);
156
        }
157
        else {
158
            my $r = Apache2::RequestUtil->request;
159
            $r->pool->cleanup_register(\&CGI::Pretty::_reset_globals);
160
        }
161
    }
162
    $class->_reset_globals if $CGI::PERLEX;
163

    
164
    return bless $this, $class;
165
}
166

    
167
sub initialize_globals {
168
    # This is the string used for indentation of tags
169
    $CGI::Pretty::INDENT = "\t";
170
    
171
    # This is the string used for seperation between tags
172
    $CGI::Pretty::LINEBREAK = $/;
173

    
174
    # These tags are not prettify'd.
175
    # When this list is updated, also update the docs.
176
    @CGI::Pretty::AS_IS = qw( a pre code script textarea td );
177

    
178
    1;
179
}
180
sub _reset_globals { initialize_globals(); }
181

    
182
# ugly, but quick fix
183
sub import {
184
    my $self = shift;
185
    no strict 'refs';
186
    ${ "$self\::AutoloadClass" } = 'CGI';
187

    
188
    # This causes modules to clash.
189
    undef %CGI::EXPORT;
190
    undef %CGI::EXPORT;
191

    
192
    $self->_setup_symbols(@_);
193
    my ($callpack, $callfile, $callline) = caller;
194

    
195
    # To allow overriding, search through the packages
196
    # Till we find one in which the correct subroutine is defined.
197
    my @packages = ($self,@{"$self\:\:ISA"});
198
    foreach my $sym (keys %CGI::EXPORT) {
199
	my $pck;
200
	my $def = ${"$self\:\:AutoloadClass"} || $CGI::DefaultClass;
201
	foreach $pck (@packages) {
202
	    if (defined(&{"$pck\:\:$sym"})) {
203
		$def = $pck;
204
		last;
205
	    }
206
	}
207
	*{"${callpack}::$sym"} = \&{"$def\:\:$sym"};
208
    }
209
}
210

    
211
1;
212

    
213
=head1 NAME
214

    
215
CGI::Pretty - module to produce nicely formatted HTML code
216

    
217
=head1 SYNOPSIS
218

    
219
    use CGI::Pretty qw( :html3 );
220

    
221
    # Print a table with a single data element
222
    print table( TR( td( "foo" ) ) );
223

    
224
=head1 DESCRIPTION
225

    
226
CGI::Pretty is a module that derives from CGI.  It's sole function is to
227
allow users of CGI to output nicely formatted HTML code.
228

    
229
When using the CGI module, the following code:
230
    print table( TR( td( "foo" ) ) );
231

    
232
produces the following output:
233
    <TABLE><TR><TD>foo</TD></TR></TABLE>
234

    
235
If a user were to create a table consisting of many rows and many columns,
236
the resultant HTML code would be quite difficult to read since it has no
237
carriage returns or indentation.
238

    
239
CGI::Pretty fixes this problem.  What it does is add a carriage
240
return and indentation to the HTML code so that one can easily read
241
it.
242

    
243
    print table( TR( td( "foo" ) ) );
244

    
245
now produces the following output:
246
    <TABLE>
247
       <TR>
248
          <TD>foo</TD>
249
       </TR>
250
    </TABLE>
251

    
252
=head2 Recommendation for when to use CGI::Pretty
253

    
254
CGI::Pretty is far slower than using CGI.pm directly. A benchmark showed that
255
it could be about 10 times slower. Adding newslines and spaces may alter the
256
rendered appearance of HTML. Also, the extra newlines and spaces also make the
257
file size larger, making the files take longer to download.
258

    
259
With all those considerations, it is recommended that CGI::Pretty be used
260
primarily for debugging.
261

    
262
=head2 Tags that won't be formatted
263

    
264
The following tags are not formatted: <a>, <pre>, <code>, <script>, <textarea>, and <td>.
265
If these tags were formatted, the
266
user would see the extra indentation on the web browser causing the page to
267
look different than what would be expected.  If you wish to add more tags to
268
the list of tags that are not to be touched, push them onto the C<@AS_IS> array:
269

    
270
    push @CGI::Pretty::AS_IS,qw(XMP);
271

    
272
=head2 Customizing the Indenting
273

    
274
If you wish to have your own personal style of indenting, you can change the
275
C<$INDENT> variable:
276

    
277
    $CGI::Pretty::INDENT = "\t\t";
278

    
279
would cause the indents to be two tabs.
280

    
281
Similarly, if you wish to have more space between lines, you may change the
282
C<$LINEBREAK> variable:
283

    
284
    $CGI::Pretty::LINEBREAK = "\n\n";
285

    
286
would create two carriage returns between lines.
287

    
288
If you decide you want to use the regular CGI indenting, you can easily do 
289
the following:
290

    
291
    $CGI::Pretty::INDENT = $CGI::Pretty::LINEBREAK = "";
292

    
293
=head1 AUTHOR
294

    
295
Brian Paulsen <Brian@ThePaulsens.com>, with minor modifications by
296
Lincoln Stein <lstein@cshl.org> for incorporation into the CGI.pm
297
distribution.
298

    
299
Copyright 1999, Brian Paulsen.  All rights reserved.
300

    
301
This library is free software; you can redistribute it and/or modify
302
it under the same terms as Perl itself.
303

    
304
Bug reports and comments to Brian@ThePaulsens.com.  You can also write
305
to lstein@cshl.org, but this code looks pretty hairy to me and I'm not
306
sure I understand it!
307

    
308
=head1 SEE ALSO
309

    
310
L<CGI>
311

    
312
=cut