#!/usr/bin/perl # # Copyright (C) 1998, 1999 Ken MacLeod # Portions Copyright (C) 2004 Craig B. Agricola # # XML::Grove::AsPrettyXML is almost entirely copied from XML::Grove::AsCanonXML # by Ken MacLeod. The few modifications that I have made didn't seem to # warrant a new package, so I've just wrapped it up in the application that # I needed it for. # # XML::Grove::AsPrettyXML is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # PrettyPrintXML.pl is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # $Id: PrettyPrintXML.pl,v 1.1 2004/04/15 21:30:15 agricolc Exp $ # use strict; use XML::Grove::Builder; use XML::Parser::PerlSAX; use Data::Grove::Visitor; package XML::Grove::AsPrettyXML; sub new { my $class = shift; my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; return bless $self, $class; } sub as_pretty_xml { my $self = shift; my $object = shift; my $fh = shift; if (defined $fh) { return (); } else { return join('', $object->accept($self, $fh)); } } sub visit_document { my $self = shift; my $document = shift; return $document->children_accept($self, @_); } $XML::Grove::AsPrettyXML::indent=''; sub visit_element { my $self = shift; my $element = shift; my $fh = shift; my @return; push @return, $self->_print($fh, $XML::Grove::AsPrettyXML::indent . '<' . $element->{Name}); my $key; my $attrs = $element->{Attributes}; foreach $key (sort keys %$attrs) { push @return, $self->_print($fh, " $key=\"" . $self->_escape($attrs->{$key}) . '"'); } push @return, $self->_print($fh, '>'); my ($is_leaf) = 0; if (!grep(ref($_) ne "XML::Grove::Characters", @{$element->{Contents}})) { $is_leaf = 1; } else { push @return, $self->_print($fh, "\n"); $XML::Grove::AsPrettyXML::indent .= ' '; } push @return, $element->children_accept($self, $fh, @_); if (!$is_leaf) { chop($XML::Grove::AsPrettyXML::indent); push @return, $self->_print($fh, $XML::Grove::AsPrettyXML::indent); } push @return, $self->_print($fh, '{Name} . '>' . "\n"); return @return; } sub visit_entity { # entities don't occur in text return (); } sub visit_pi { my $self = shift; my $pi = shift; my $fh = shift; return $self->_print($fh, $XML::Grove::AsPrettyXML::indent . '{Target} . ' ' . $pi->{Data} . '?>' . "\n"); } sub visit_comment { my $self = shift; my $comment = shift; my $fh = shift; if ($self->{Comments}) { return $self->_print($fh, $XML::Grove::AsPrettyXML::indent . '' . "\n"); } else { return (); } } sub visit_characters { my $self = shift; my $characters = shift; my $fh = shift; return ($self->_print($fh, $characters->{Data})); } sub _print { my $self = shift; my $fh = shift; my $string = shift; if (defined $fh) { $fh->print($string); return (); } else { return ($string); } } package XML::Grove; sub as_pretty_xml { my $xml_object = shift; return XML::Grove::AsPrettyXML->new(@_)->as_pretty_xml($xml_object); } package main; if (@ARGV==0) { push(@ARGV, "-"); } my $gb=new XML::Grove::Builder(); my $p=new XML::Parser::PerlSAX(Handler=>$gb); my $d=$p->parse(Source=>{SystemId=>$ARGV[0]}); print $d->as_pretty_xml(Comments=>1);