XML/XUpdate/Rewrite.pm

##############################################################################
#
# Perl module: XML::XUpdate::Rewrite
#
# By Andreas Motl, andreas.motl@ilo.de
#
#    $Id: XSLT.pm,v 1.4 2003/05/01 23:40:32 joko Exp $
#
#    $Log: XSLT.pm,v $
#
###############################################################################


=pod

=head1 NAME

  XML::XUpdate::Rewrite - A perl module for rewriting xml documents.

=head1 VERSION

    $Revision: 2.2 $
    $Date: 2001/07/18 20:21:39 $
  
=head1 DESCRIPTION

=head2 ABOUT

  Pass through data of xml document untouched, 
  just modify its layout and/or descriptive information.
  
  Layout manipulation:
    - Node indentation level control and similar to optimize for human or machine readable payloads.
  
  Descriptive information:
    - Control if and how to produce the starting (e.g.) <?xml version="1.0" encoding="UTF-8"?> line.
    - Toggle root node encapsulation on/off, specify root node.
  
  Note for CPAN maintainers:
  This would in fact make a general purpose module(???), it´s just in this namespace because 
  it was developed together with XML::XUpdate::XSLT.
  Better name: XML::Rewrite? Or completely different - XML::Passthru. Or - associated to
  its main usage - XML::ParseWriter. The "descriptive information encapsulation" could make
  up a XML::Encap. 
  Both things in mind, let´s find a more abstract name combining its intention but
  "one level away" from its core functionality!? e.g. XML::Smooth? XML::Polish?

=head2 IMPLEMENTATION

  It was started using XML::Parser::PerlSAX and its companions XML::Handler::XMLWriter
  and XML::Handler::CanonXMLWriter. This did *not* exactly solve the problem on the 
  first attempt, but was more simple to achieve through information provided by their
  core pods.
  The XML::Parser vs. XML::Writer way seems to be more straightforward and better 
  to customize by a richer set of parameters closer reflecting the intention of this module.
  (convenient highlevel wrapper just doing a subset of what´s possible at all)
  
  
=head1 TODO

  o Handle / convert between other important representations of XML documents (e.g. from/to XML::DOM)
     This [c|w]ould make a XML::Convert or Convert::XML??? Does already exist one on CPAN?
  o Provide some hooks to (e.g.) enable possibility to convert values from Latin to UTF-8 or such stuff.

  
=cut


######################################################################
package XML::XUpdate::Rewrite;
######################################################################

use strict;
use warnings;

use vars qw ( $VERSION );

use Data::Dumper;
# To load perl modules on demand at runtime.
# Perl will not croak at compile time for missing modules.
use Class::Loader;
#use base qw( Class::Loader );

$VERSION = '0.01';


######################################################################
# PUBLIC DEFINITIONS

sub new {
  my $class = shift;
  my $self = bless {}, $class;
  $self->{options} = $self->__arglist2hash(@_);
  
  $self->{DEBUG} = $self->{options}->{debug};
  $self->{WARNINGS} = $self->{options}->{warnings};

  return $self;
}

sub set_document {
  my $self = shift;
  my $xml = shift;
  $self->{XML}->{document} = $xml;
}

sub get_document {
  my $self = shift;
  return $self->{XML}->{document};
}

sub process {
  my $self = shift;

  # are we here?
  #print "YAI!", "\n";

  # set default options (in case just "rewrite" is turned on)
  # a) canonical mode using XML::Parser::PerlSAX
  $self->{options}->{engine} ||= "PerlSAX";
  $self->{options}->{style} ||= "canonical";
  # b) human readable xml using XML::Parser vs. XML::Writer
  $self->{options}->{engine} ||= "XMLParser";
  $self->{options}->{style} ||= "readable";
  
  my $raw = $self->get_document();

  # Rewrite xml payload to change output style of raw document (human readable or canonical).
  # TODO: use XML::Writer as third option!
  # from its pod: [...] and elements can optionally be indented based as their nesting level.
  # FIXME: Do on-demand loading of helper modules here.
  
  # V1 - The PerlSAX way.
  if ($self->{options}->{engine} eq "PerlSAX") {
    
    # First, create writer instance ...
    my $writer;
    if ($self->{options}->{style} eq "readable") {
      # V1 - static
      #use XML::Handler::XMLWriter;
      #$writer = XML::Handler::XMLWriter->new( AsString => 1, Newlines => 0 );
      # V2 - dynamic
      #$writer = Class::Loader::_load( undef,
      #  Module => 'XML::Handler::XMLWriter', 
      #  Args => [ AsString => 1, Newlines => 0 ],
      #);
      # V3 - auxiliary method
      $writer = $self->__load( "XML::Handler::XMLWriter", [ AsString => 1, Newlines => 0 ] );
    } elsif ($self->{options}->{style} eq "canonical") {
      # FIXME: Make this work again!
      #use XML::Handler::CanonXMLWriter;
      #$writer = XML::Handler::CanonXMLWriter->new( PrintComments => 1 );
    }
    
    # pre-flight checks (do we actually have a writer instance?)
    die( __PACKAGE__ . ": No writer instance!" ) if (not $writer or not ref $writer);
    
    # ... and then create the parser instance.
    my $parser = $self->__load( "XML::Parser::PerlSAX" );
    
    # more pre-flight checks
    die( __PACKAGE__ . ": No parser instance!") if (not $parser or not ref $parser);
    
    # Finally, run them together, overwrite our payload ...
    $self->set_document( $parser->parse( Source => { String => $raw }, Handler => $writer ) );
    
    # ... and signal good.
    return 1;
  }
  
  # V2 - using the classic XML::Parser together with its companion, XML::Writer
  if ($self->{options}->{engine} eq "XMLParser") {

    use IO;
    my $output = IO::File->new(">output.xml");

    # These return instances which are not required. => overhead!
    $self->__load("XML::Writer");
    $self->__load("XML::Parser::StreamWriter");   

# First, create the writer instance ...
    #my $writer = XML::Writer->new( OUTPUT => $output, NEWLINES => 0, DATA_MODE => 1, DATA_INDENT => 2 );
    my $writer = XML::Writer->new( OUTPUT => *STDERR, NEWLINES => 0, DATA_MODE => 0, DATA_INDENT => 2 );
    # ... and pass it through expat to the stream handler.
    my $parser = XML::Parser->new( Style => "Stream", Pkg => "XML::Parser::StreamWriter", Writer => $writer );

    # Run that stuff...
    $parser->parse( $raw );

    # Like above ...
    #$self->set_document( $parser->parse( $raw ) );
    #return 1;

  }

  return 0;

}

######################################################################
# AUXILIARY METHODS

# Argument list parsing.
# ... from XML::XUpdate::LibXML (w/o backwards compatibility hook).
# Could this make up a Class::AutoFill::__read_arglist which transparently 
# makes object attributes from constructor arguments in a configurable way?
# also similar inside XML::XUpdate::XSLT!!!
# solution: do some mixin here!!! --> Class::Container!?
sub __arglist2hash {
  my $self = shift;
  my %args;

  if ( @_ % 2 ) {
    $args{dummy} = shift;
    %args = (%args, @_);
  } else {
    %args = @_;
  }

  return \%args;
}

sub __load {
  my $self = shift;
  my $name = shift;
  my $args = shift;
  return Class::Loader::_load( undef, Module => $name, Args => $args );
}

1;
__END__
1	joko	1.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__
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26