| 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 |
|
|---|
|
|---|