| 1 |
############################################################################## |
| 2 |
# |
| 3 |
# Perl module: XML::XUpdate::Rewrite |
| 4 |
# |
| 5 |
# By Andreas Motl, andreas.motl@ilo.de |
| 6 |
# |
| 7 |
# $Id: XSLT.pm,v 1.4 2003/05/01 23:40:32 joko Exp $ |
| 8 |
# |
| 9 |
# $Log: XSLT.pm,v $ |
| 10 |
# |
| 11 |
############################################################################### |
| 12 |
|
| 13 |
|
| 14 |
=pod |
| 15 |
|
| 16 |
=head1 NAME |
| 17 |
|
| 18 |
XML::XUpdate::Rewrite - A perl module for rewriting xml documents. |
| 19 |
|
| 20 |
=head1 VERSION |
| 21 |
|
| 22 |
$Revision: 2.2 $ |
| 23 |
$Date: 2001/07/18 20:21:39 $ |
| 24 |
|
| 25 |
=head1 DESCRIPTION |
| 26 |
|
| 27 |
=head2 ABOUT |
| 28 |
|
| 29 |
Pass through data of xml document untouched, |
| 30 |
just modify its layout and/or descriptive information. |
| 31 |
|
| 32 |
Layout manipulation: |
| 33 |
- Node indentation level control and similar to optimize for human or machine readable payloads. |
| 34 |
|
| 35 |
Descriptive information: |
| 36 |
- Control if and how to produce the starting (e.g.) <?xml version="1.0" encoding="UTF-8"?> line. |
| 37 |
- Toggle root node encapsulation on/off, specify root node. |
| 38 |
|
| 39 |
Note for CPAN maintainers: |
| 40 |
This would in fact make a general purpose module(???), it´s just in this namespace because |
| 41 |
it was developed together with XML::XUpdate::XSLT. |
| 42 |
Better name: XML::Rewrite? Or completely different - XML::Passthru. Or - associated to |
| 43 |
its main usage - XML::ParseWriter. The "descriptive information encapsulation" could make |
| 44 |
up a XML::Encap. |
| 45 |
Both things in mind, let´s find a more abstract name combining its intention but |
| 46 |
"one level away" from its core functionality!? e.g. XML::Smooth? XML::Polish? |
| 47 |
|
| 48 |
=head2 IMPLEMENTATION |
| 49 |
|
| 50 |
It was started using XML::Parser::PerlSAX and its companions XML::Handler::XMLWriter |
| 51 |
and XML::Handler::CanonXMLWriter. This did *not* exactly solve the problem on the |
| 52 |
first attempt, but was more simple to achieve through information provided by their |
| 53 |
core pods. |
| 54 |
The XML::Parser vs. XML::Writer way seems to be more straightforward and better |
| 55 |
to customize by a richer set of parameters closer reflecting the intention of this module. |
| 56 |
(convenient highlevel wrapper just doing a subset of what´s possible at all) |
| 57 |
|
| 58 |
|
| 59 |
|
| 60 |
=head1 TODO |
| 61 |
|
| 62 |
o Handle / convert between other important representations of XML documents (e.g. from/to XML::DOM) |
| 63 |
This [c|w]ould make a XML::Convert or Convert::XML??? Does already exist one on CPAN? |
| 64 |
o Provide some hooks to (e.g.) enable possibility to convert values from Latin to UTF-8 or such stuff. |
| 65 |
|
| 66 |
|
| 67 |
=cut |
| 68 |
|
| 69 |
|
| 70 |
###################################################################### |
| 71 |
package XML::XUpdate::Rewrite; |
| 72 |
###################################################################### |
| 73 |
|
| 74 |
use strict; |
| 75 |
use warnings; |
| 76 |
|
| 77 |
use vars qw ( $VERSION ); |
| 78 |
|
| 79 |
use Data::Dumper; |
| 80 |
# To load perl modules on demand at runtime. |
| 81 |
# Perl will not croak at compile time for missing modules. |
| 82 |
use Class::Loader; |
| 83 |
#use base qw( Class::Loader ); |
| 84 |
|
| 85 |
$VERSION = '0.01'; |
| 86 |
|
| 87 |
|
| 88 |
###################################################################### |
| 89 |
# PUBLIC DEFINITIONS |
| 90 |
|
| 91 |
sub new { |
| 92 |
my $class = shift; |
| 93 |
my $self = bless {}, $class; |
| 94 |
$self->{options} = $self->__arglist2hash(@_); |
| 95 |
|
| 96 |
$self->{DEBUG} = $self->{options}->{debug}; |
| 97 |
$self->{WARNINGS} = $self->{options}->{warnings}; |
| 98 |
|
| 99 |
return $self; |
| 100 |
} |
| 101 |
|
| 102 |
sub set_document { |
| 103 |
my $self = shift; |
| 104 |
my $xml = shift; |
| 105 |
$self->{XML}->{document} = $xml; |
| 106 |
} |
| 107 |
|
| 108 |
sub get_document { |
| 109 |
my $self = shift; |
| 110 |
return $self->{XML}->{document}; |
| 111 |
} |
| 112 |
|
| 113 |
sub process { |
| 114 |
my $self = shift; |
| 115 |
|
| 116 |
# are we here? |
| 117 |
#print "YAI!", "\n"; |
| 118 |
|
| 119 |
# set default options (in case just "rewrite" is turned on) |
| 120 |
# a) canonical mode using XML::Parser::PerlSAX |
| 121 |
$self->{options}->{engine} ||= "PerlSAX"; |
| 122 |
$self->{options}->{style} ||= "canonical"; |
| 123 |
# b) human readable xml using XML::Parser vs. XML::Writer |
| 124 |
$self->{options}->{engine} ||= "XMLParser"; |
| 125 |
$self->{options}->{style} ||= "readable"; |
| 126 |
|
| 127 |
my $raw = $self->get_document(); |
| 128 |
|
| 129 |
# Rewrite xml payload to change output style of raw document (human readable or canonical). |
| 130 |
# TODO: use XML::Writer as third option! |
| 131 |
# from its pod: [...] and elements can optionally be indented based as their nesting level. |
| 132 |
# FIXME: Do on-demand loading of helper modules here. |
| 133 |
|
| 134 |
# V1 - The PerlSAX way. |
| 135 |
if ($self->{options}->{engine} eq "PerlSAX") { |
| 136 |
|
| 137 |
# First, create writer instance ... |
| 138 |
my $writer; |
| 139 |
if ($self->{options}->{style} eq "readable") { |
| 140 |
# V1 - static |
| 141 |
#use XML::Handler::XMLWriter; |
| 142 |
#$writer = XML::Handler::XMLWriter->new( AsString => 1, Newlines => 0 ); |
| 143 |
# V2 - dynamic |
| 144 |
#$writer = Class::Loader::_load( undef, |
| 145 |
# Module => 'XML::Handler::XMLWriter', |
| 146 |
# Args => [ AsString => 1, Newlines => 0 ], |
| 147 |
#); |
| 148 |
# V3 - auxiliary method |
| 149 |
$writer = $self->__load( "XML::Handler::XMLWriter", [ AsString => 1, Newlines => 0 ] ); |
| 150 |
} elsif ($self->{options}->{style} eq "canonical") { |
| 151 |
# FIXME: Make this work again! |
| 152 |
#use XML::Handler::CanonXMLWriter; |
| 153 |
#$writer = XML::Handler::CanonXMLWriter->new( PrintComments => 1 ); |
| 154 |
} |
| 155 |
|
| 156 |
# pre-flight checks (do we actually have a writer instance?) |
| 157 |
die( __PACKAGE__ . ": No writer instance!" ) if (not $writer or not ref $writer); |
| 158 |
|
| 159 |
# ... and then create the parser instance. |
| 160 |
my $parser = $self->__load( "XML::Parser::PerlSAX" ); |
| 161 |
|
| 162 |
# more pre-flight checks |
| 163 |
die( __PACKAGE__ . ": No parser instance!") if (not $parser or not ref $parser); |
| 164 |
|
| 165 |
# Finally, run them together, overwrite our payload ... |
| 166 |
$self->set_document( $parser->parse( Source => { String => $raw }, Handler => $writer ) ); |
| 167 |
|
| 168 |
# ... and signal good. |
| 169 |
return 1; |
| 170 |
} |
| 171 |
|
| 172 |
# V2 - using the classic XML::Parser together with its companion, XML::Writer |
| 173 |
if ($self->{options}->{engine} eq "XMLParser") { |
| 174 |
|
| 175 |
use IO; |
| 176 |
my $output = IO::File->new(">output.xml"); |
| 177 |
|
| 178 |
# These return instances which are not required. => overhead! |
| 179 |
$self->__load("XML::Writer"); |
| 180 |
$self->__load("XML::Parser::StreamWriter"); |
| 181 |
|
| 182 |
# First, create the writer instance ... |
| 183 |
#my $writer = XML::Writer->new( OUTPUT => $output, NEWLINES => 0, DATA_MODE => 1, DATA_INDENT => 2 ); |
| 184 |
my $writer = XML::Writer->new( OUTPUT => *STDERR, NEWLINES => 0, DATA_MODE => 0, DATA_INDENT => 2 ); |
| 185 |
# ... and pass it through expat to the stream handler. |
| 186 |
my $parser = XML::Parser->new( Style => "Stream", Pkg => "XML::Parser::StreamWriter", Writer => $writer ); |
| 187 |
|
| 188 |
# Run that stuff... |
| 189 |
$parser->parse( $raw ); |
| 190 |
|
| 191 |
# Like above ... |
| 192 |
#$self->set_document( $parser->parse( $raw ) ); |
| 193 |
#return 1; |
| 194 |
|
| 195 |
} |
| 196 |
|
| 197 |
return 0; |
| 198 |
|
| 199 |
} |
| 200 |
|
| 201 |
###################################################################### |
| 202 |
# AUXILIARY METHODS |
| 203 |
|
| 204 |
# Argument list parsing. |
| 205 |
# ... from XML::XUpdate::LibXML (w/o backwards compatibility hook). |
| 206 |
# Could this make up a Class::AutoFill::__read_arglist which transparently |
| 207 |
# makes object attributes from constructor arguments in a configurable way? |
| 208 |
# also similar inside XML::XUpdate::XSLT!!! |
| 209 |
# solution: do some mixin here!!! --> Class::Container!? |
| 210 |
sub __arglist2hash { |
| 211 |
my $self = shift; |
| 212 |
my %args; |
| 213 |
|
| 214 |
if ( @_ % 2 ) { |
| 215 |
$args{dummy} = shift; |
| 216 |
%args = (%args, @_); |
| 217 |
} else { |
| 218 |
%args = @_; |
| 219 |
} |
| 220 |
|
| 221 |
return \%args; |
| 222 |
} |
| 223 |
|
| 224 |
sub __load { |
| 225 |
my $self = shift; |
| 226 |
my $name = shift; |
| 227 |
my $args = shift; |
| 228 |
return Class::Loader::_load( undef, Module => $name, Args => $args ); |
| 229 |
} |
| 230 |
|
| 231 |
1; |
| 232 |
__END__ |
Parent Directory
| 
Revision Log
