XML/XUpdate/XSLT.pm

##############################################################################
#
# Perl module: XML::XUpdate::XSLT
#
# By Andreas Motl, andreas.motl@ilo.de
#
#    $Id: XSLT.pm,v 1.7 2003/05/13 09:32:22 joko Exp $
#
#    $Log: XSLT.pm,v $
#    Revision 1.7  2003/05/13 09:32:22  joko
#    minor update to pod
#
#    Revision 1.6  2003/05/07 03:11:28  joko
#    updated pod: new section "References", added item to "Todo" section
#
#    Revision 1.5  2003/05/06 14:24:06  joko
#    doesn't use Carp any more
#    updated pod
#    attempt to rewrite xml to make it more human readable using helper modules from CPAN (node indentation, etc.)
#
#    Revision 1.4  2003/05/01 23:40:32  joko
#    minor update: commented debugging part
#
#    Revision 1.3  2003/05/01 20:11:49  joko
#    * added pod from xupdate.pl
#    - extracted xml to external files
#
#    Revision 1.1  2003/04/30 02:36:32  joko
#    initial commit
#
#
###############################################################################

=pod


=head1 NAME

  XML::XUpdate::XSLT - A perl module for updating xml documents using XUpdate via XSLT.


=head3 Overview

  This is not the same xupdate currently available from CPAN at
  http://search.cpan.org/author/PAJAS/XML-XUpdate-LibXML-0.4.0/xupdate .
  
  Its intention - however - is identical:
  xupdate - Process XUpdate commands against an XML document.


=head4 Their implementations differ:

    1. xupdate (by Petr Pajas) uses ...
    XML::XUpdate::LibXML - Simple implementation of XUpdate format 
    
    ... which is based on XML::LibXML which in turn is:
    [...]
    This module is an interface to the gnome libxml2 DOM parser (no SAX parser support yet), 
    and the DOM tree. It also provides an XML::XPath-like findnodes() interface, providing 
    access to the XPath API in libxml2. 
    [...]

    2. This xupdate attempts to implement the XUpdate specs using XSLT only.
    

=head4 Yet another xupdate - facts in short:

  S: It would be nice to have a pure perl thingy which does (almost) the same stuff....
  
  Q: Can we achieve compliance with its (XML::XUpdate::LibXML) API? (or just a subset ....)
  
  Q: Can we achieve the processing using CPAN's XML::XSLT?
  S: Proposal: XML::XUpdate::XSLT!?
  
  Q: Can we mimic/use the interface of the - already established - 'xupdate' program???
  
  Q: Should we follow the CRUD path first?
      (CRUD is the acronym for the datastore action primitives: Create, Retrieve, Update, Delete)
  S?: Proposal: XML::XUpdate::XSLT::API uses XML::XUpdate::XSLT::CRUD


=head3 References

    - XUpdate:
      Requirements: http://www.xmldb.org/xupdate/xupdate-req.html
      Working Draft: http://www.xmldb.org/xupdate/xupdate-wd.html
    - XML API:
    - XML::XUpdate::LibXML: http://search.cpan.org/author/PAJAS/XML-XUpdate-LibXML-0.4.0/lib/XML/XUpdate/LibXML.pm
    - XSL / XSLT:
      http://www.w3.org/TR/xslt
      http://www.xsl-rp.de/
      http://xml.klute-thiemann.de/w3c-de/REC-xslt-20020318/
      http://xmlxslt.sourceforge.net/
    - misc pointers:
      "Re: Modify XML documents": http://aspn.activestate.com/ASPN/Mail/Message/perl-xml/1265431
      XSL Extensions: http://xmlsoft.org/XSLT/extensions.html
      EXSLT: http://www.exslt.org/set/functions/difference/index.html
      "how to insert element at required position in document tree?": http://p2p.wrox.com/archive/xslt/2001-06/98.asp
      XML APIs for Databases: http://www.javaworld.com/javaworld/jw-01-2000/jw-01-dbxml.html


=head3 Todo

  o What about proper encoding? (ISO-8859-1 or UTF-8)
  o Is it possible to create the required "xsl_template.xml" at runtime via XSL itself?
  o Cache contents of external files (*.xml). Performance!
  o Can exception / error-code handling be improved somehow?
      Esp.: It would be interesting, if the XUpdate payload actually could be applied, or not...
  o Conditional processing: <xupdate:if>, etc.
  

=cut


######################################################################
package XML::XUpdate::XSLT;
######################################################################

use strict;
use warnings;

use Data::Dumper;
use File::Basename;
use XML::XSLT 0.41;
use XML::XUpdate::Rewrite;

# Namespace constants

use constant NS_XUPDATE         => 'http://www.xmldb.org/xupdate';

use vars qw ( $VERSION );

$VERSION = '0.01';


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

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

  $self->__init_default_stylesheets();

  return $self;

}

sub get_stylesheet {
  my $self = shift;
  my $name = shift;
  return $self->{XML}->{xsl}->{$name};
}

sub set_stylesheet {
  my $self = shift;
  my $name = shift;
  my $xml = shift;
  my $options = shift;
  if ($options->{encap}) {
    my $template = $self->__slurp_file("xsl_template.xml");
    # FIXME! What about the quirky? Is there a better one?
    $template =~ s!<xsl:quirky_placeholder />!$xml!;
    $xml = $template;
  }
  $self->{XML}->{xsl}->{$name} = $xml;
}

sub open_document {
  my $self = shift;
  my $xml = shift;
  # FIXME: check for filename, filehandle and URL (etc.)
  $self->{XML}->{document} = $xml;
}

sub open_xupdate {
  my $self = shift;
  my $xml = shift;
  # FIXME: check for filename, filehandle and URL (etc.)
  $self->{XML}->{xupdate} = $xml;
}

sub process {
  my $self = shift;
  $self->_calculate();
  $self->_apply();
}

# First, translate the xupdate payload to xsl.
# FIXME: do DOM only! (don't use "->toString")
sub _calculate {
  my $self = shift;
  $self->{XSLT_ENGINE_PREP} = XML::XSLT->new(
    Source => $self->get_stylesheet("xupdate2xsl"), 
    debug => $self->{DEBUG},
    warnings => $self->{WARNINGS}
  );
  $self->{XSLT_ENGINE_PREP}->open_xml( $self->{XML}->{xupdate} );
  $self->{XSLT_ENGINE_PREP}->process();
  $self->set_stylesheet( "_worker", $self->{XSLT_ENGINE_PREP}->toString(), { encap => 1 } );
}

# After that, use this worker xsl to actually apply the changes to the original document.
# FIXME: do DOM only!
sub _apply {
  my $self = shift;
  
  # debug - print the calculated xsl on STDERR
  print STDERR $self->get_stylesheet("_worker"), "\n" if $self->{DEBUG};
  
  #return;
  $self->{XSLT_ENGINE_LIVE} = XML::XSLT->new(
    Source => $self->get_stylesheet("_worker"), 
    debug => $self->{DEBUG},
    warnings => $self->{WARNINGS}
  );
  $self->{XSLT_ENGINE_LIVE}->open_xml( $self->{XML}->{document} );
  $self->{XSLT_ENGINE_LIVE}->process();
  $self->{XML}->{result} = $self->{XSLT_ENGINE_LIVE}->toString();
}  
  
sub toString {
  my $self = shift;
  
  # use rest of argument list as hash of option values
  my $options = {@_};
  
  # short circuit - just return what we have - don't modify anything
  return $self->{XML}->{result} unless $options and $options->{rewrite};
  
  # Rewrite the xml document with certain engine to desired style.
  # 'engine' defaults to "XMLParser" if not specified.
  my $rewrite = XML::XUpdate::Rewrite->new( style => $options->{mode}, engine => $options->{using} );
  $rewrite->set_document( $self->{XML}->{result} );
  # TODO: Implement a configurable fallback here to return the un-rewritten payload if desired.
  $rewrite->process() or die(__PACKAGE__ . ": Error while rewriting XML document.");
  return $rewrite->get_document();
}


######################################################################
# 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?
sub __parse_args {
  my $self = shift;
  my %args;

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

  return \%args;
}


sub __init_default_stylesheets {
  my $self = shift;
  if (my $payload = $self->__slurp_file("xupdate2xsl.xml")) {
    $self->{XML}->{xsl}->{xupdate2xsl} = $payload;
  }
}

sub __slurp_file {
  my $self = shift;
  my $filename = shift;
  
  # does file exist?
  if (! -e $filename) {
    $filename = dirname(__FILE__) . "/$filename";
    if (! -e $filename) {
      die("File $filename does not exist.");
    }
  }
  
  open(FH, "<" . $filename);
  my @lines = <FH>;
  my $content = join("", @lines);
  close(FH);
  return $content;
}

1;
__END__
1	joko	1.1	##############################################################################
2			#
3			# Perl module: XML::XUpdate::XSLT
4			#
5			# By Andreas Motl, andreas.motl@ilo.de
6			#
7	joko	1.8	# $Id: XSLT.pm,v 1.7 2003/05/13 09:32:22 joko Exp $
8	joko	1.1	#
9			# $Log: XSLT.pm,v $
10	joko	1.8	# Revision 1.7 2003/05/13 09:32:22 joko
11			# minor update to pod
12			#
13	joko	1.7	# Revision 1.6 2003/05/07 03:11:28 joko
14			# updated pod: new section "References", added item to "Todo" section
15			#
16	joko	1.6	# Revision 1.5 2003/05/06 14:24:06 joko
17			# doesn't use Carp any more
18			# updated pod
19			# attempt to rewrite xml to make it more human readable using helper modules from CPAN (node indentation, etc.)
20			#
21	joko	1.5	# Revision 1.4 2003/05/01 23:40:32 joko
22			# minor update: commented debugging part
23			#
24	joko	1.4	# Revision 1.3 2003/05/01 20:11:49 joko
25			# * added pod from xupdate.pl
26			# - extracted xml to external files
27			#
28	joko	1.2	# Revision 1.1 2003/04/30 02:36:32 joko
29			# initial commit
30			#
31	joko	1.1	#
32			###############################################################################
33
34	joko	1.3	=pod
35
36
37	joko	1.1	=head1 NAME
38
39	joko	1.5	XML::XUpdate::XSLT - A perl module for updating xml documents using XUpdate via XSLT.
40	joko	1.1
41	joko	1.3
42			=head3 Overview
43
44			This is not the same xupdate currently available from CPAN at
45			http://search.cpan.org/author/PAJAS/XML-XUpdate-LibXML-0.4.0/xupdate .
46
47			Its intention - however - is identical:
48			xupdate - Process XUpdate commands against an XML document.
49
50
51	joko	1.6	=head4 Their implementations differ:
52	joko	1.3
53			1. xupdate (by Petr Pajas) uses ...
54			XML::XUpdate::LibXML - Simple implementation of XUpdate format
55
56			... which is based on XML::LibXML which in turn is:
57			[...]
58			This module is an interface to the gnome libxml2 DOM parser (no SAX parser support yet),
59			and the DOM tree. It also provides an XML::XPath-like findnodes() interface, providing
60			access to the XPath API in libxml2.
61			[...]
62
63			2. This xupdate attempts to implement the XUpdate specs using XSLT only.
64
65
66	joko	1.6	=head4 Yet another xupdate - facts in short:
67	joko	1.3
68			S: It would be nice to have a pure perl thingy which does (almost) the same stuff....
69
70			Q: Can we achieve compliance with its (XML::XUpdate::LibXML) API? (or just a subset ....)
71
72			Q: Can we achieve the processing using CPAN's XML::XSLT?
73			S: Proposal: XML::XUpdate::XSLT!?
74
75			Q: Can we mimic/use the interface of the - already established - 'xupdate' program???
76
77	joko	1.5	Q: Should we follow the CRUD path first?
78			(CRUD is the acronym for the datastore action primitives: Create, Retrieve, Update, Delete)
79	joko	1.3	S?: Proposal: XML::XUpdate::XSLT::API uses XML::XUpdate::XSLT::CRUD
80
81
82	joko	1.6	=head3 References
83
84			- XUpdate:
85			Requirements: http://www.xmldb.org/xupdate/xupdate-req.html
86			Working Draft: http://www.xmldb.org/xupdate/xupdate-wd.html
87			- XML API:
88			- XML::XUpdate::LibXML: http://search.cpan.org/author/PAJAS/XML-XUpdate-LibXML-0.4.0/lib/XML/XUpdate/LibXML.pm
89			- XSL / XSLT:
90			http://www.w3.org/TR/xslt
91			http://www.xsl-rp.de/
92			http://xml.klute-thiemann.de/w3c-de/REC-xslt-20020318/
93			http://xmlxslt.sourceforge.net/
94			- misc pointers:
95			"Re: Modify XML documents": http://aspn.activestate.com/ASPN/Mail/Message/perl-xml/1265431
96			XSL Extensions: http://xmlsoft.org/XSLT/extensions.html
97			EXSLT: http://www.exslt.org/set/functions/difference/index.html
98			"how to insert element at required position in document tree?": http://p2p.wrox.com/archive/xslt/2001-06/98.asp
99			XML APIs for Databases: http://www.javaworld.com/javaworld/jw-01-2000/jw-01-dbxml.html
100
101
102			=head3 Todo
103	joko	1.3
104			o What about proper encoding? (ISO-8859-1 or UTF-8)
105			o Is it possible to create the required "xsl_template.xml" at runtime via XSL itself?
106			o Cache contents of external files (*.xml). Performance!
107	joko	1.5	o Can exception / error-code handling be improved somehow?
108			Esp.: It would be interesting, if the XUpdate payload actually could be applied, or not...
109	joko	1.7	o Conditional processing: <xupdate:if>, etc.
110	joko	1.3
111
112	joko	1.1	=cut
113
114
115			######################################################################
116			package XML::XUpdate::XSLT;
117			######################################################################
118
119			use strict;
120			use warnings;
121
122	joko	1.5	use Data::Dumper;
123			use File::Basename;
124	joko	1.1	use XML::XSLT 0.41;
125	joko	1.5	use XML::XUpdate::Rewrite;
126	joko	1.1
127			# Namespace constants
128
129			use constant NS_XUPDATE => 'http://www.xmldb.org/xupdate';
130
131			use vars qw ( $VERSION );
132
133	joko	1.3	$VERSION = '0.01';
134	joko	1.1
135
136			######################################################################
137			# PUBLIC DEFINITIONS
138
139			sub new {
140			my $class = shift;
141			my $self = bless {}, $class;
142			my $args = $self->__parse_args(@_);
143
144	joko	1.2	$self->{DEBUG} = $args->{debug};
145			$self->{WARNINGS} = $args->{warnings};
146
147	joko	1.3	$self->__init_default_stylesheets();
148	joko	1.1
149	joko	1.2	return $self;
150	joko	1.1
151	joko	1.2	}
152	joko	1.1
153	joko	1.2	sub get_stylesheet {
154			my $self = shift;
155			my $name = shift;
156			return $self->{XML}->{xsl}->{$name};
157	joko	1.1	}
158
159	joko	1.2	sub set_stylesheet {
160	joko	1.1	my $self = shift;
161			my $name = shift;
162	joko	1.2	my $xml = shift;
163			my $options = shift;
164			if ($options->{encap}) {
165	joko	1.3	my $template = $self->__slurp_file("xsl_template.xml");
166			# FIXME! What about the quirky? Is there a better one?
167			$template =~ s!<xsl:quirky_placeholder />!$xml!;
168			$xml = $template;
169	joko	1.2	}
170			$self->{XML}->{xsl}->{$name} = $xml;
171	joko	1.1	}
172
173			sub open_document {
174			my $self = shift;
175			my $xml = shift;
176			# FIXME: check for filename, filehandle and URL (etc.)
177			$self->{XML}->{document} = $xml;
178			}
179
180			sub open_xupdate {
181			my $self = shift;
182			my $xml = shift;
183	joko	1.6	# FIXME: check for filename, filehandle and URL (etc.)
184	joko	1.1	$self->{XML}->{xupdate} = $xml;
185			}
186
187			sub process {
188			my $self = shift;
189	joko	1.2	$self->_calculate();
190			$self->_apply();
191	joko	1.1	}
192
193	joko	1.2	# First, translate the xupdate payload to xsl.
194	joko	1.5	# FIXME: do DOM only! (don't use "->toString")
195	joko	1.2	sub _calculate {
196			my $self = shift;
197			$self->{XSLT_ENGINE_PREP} = XML::XSLT->new(
198			Source => $self->get_stylesheet("xupdate2xsl"),
199			debug => $self->{DEBUG},
200			warnings => $self->{WARNINGS}
201			);
202			$self->{XSLT_ENGINE_PREP}->open_xml( $self->{XML}->{xupdate} );
203			$self->{XSLT_ENGINE_PREP}->process();
204			$self->set_stylesheet( "_worker", $self->{XSLT_ENGINE_PREP}->toString(), { encap => 1 } );
205			}
206
207			# After that, use this worker xsl to actually apply the changes to the original document.
208			# FIXME: do DOM only!
209			sub _apply {
210			my $self = shift;
211	joko	1.4
212			# debug - print the calculated xsl on STDERR
213	joko	1.8	print STDERR $self->get_stylesheet("_worker"), "\n" if $self->{DEBUG};
214	joko	1.4
215	joko	1.2	#return;
216			$self->{XSLT_ENGINE_LIVE} = XML::XSLT->new(
217			Source => $self->get_stylesheet("_worker"),
218			debug => $self->{DEBUG},
219			warnings => $self->{WARNINGS}
220			);
221			$self->{XSLT_ENGINE_LIVE}->open_xml( $self->{XML}->{document} );
222			$self->{XSLT_ENGINE_LIVE}->process();
223			$self->{XML}->{result} = $self->{XSLT_ENGINE_LIVE}->toString();
224			}
225
226	joko	1.1	sub toString {
227			my $self = shift;
228	joko	1.5
229			# use rest of argument list as hash of option values
230			my $options = {@_};
231
232			# short circuit - just return what we have - don't modify anything
233			return $self->{XML}->{result} unless $options and $options->{rewrite};
234
235			# Rewrite the xml document with certain engine to desired style.
236			# 'engine' defaults to "XMLParser" if not specified.
237			my $rewrite = XML::XUpdate::Rewrite->new( style => $options->{mode}, engine => $options->{using} );
238			$rewrite->set_document( $self->{XML}->{result} );
239			# TODO: Implement a configurable fallback here to return the un-rewritten payload if desired.
240			$rewrite->process() or die(__PACKAGE__ . ": Error while rewriting XML document.");
241			return $rewrite->get_document();
242	joko	1.1	}
243	joko	1.5
244	joko	1.1
245			######################################################################
246			# AUXILIARY METHODS
247
248	joko	1.5	# Argument list parsing.
249			# ... from XML::XUpdate::LibXML (w/o backwards compatibility hook).
250			# Could this make up a Class::AutoFill::__read_arglist which transparently
251			# makes object attributes from constructor arguments in a configurable way?
252	joko	1.1	sub __parse_args {
253			my $self = shift;
254			my %args;
255
256	joko	1.5	if ( @_ % 2 ) {
257	joko	1.1	$args{dummy} = shift;
258			%args = (%args, @_);
259			} else {
260			%args = @_;
261			}
262
263			return \%args;
264			}
265
266
267	joko	1.3	sub __init_default_stylesheets {
268			my $self = shift;
269			if (my $payload = $self->__slurp_file("xupdate2xsl.xml")) {
270			$self->{XML}->{xsl}->{xupdate2xsl} = $payload;
271			}
272			}
273
274			sub __slurp_file {
275	joko	1.1	my $self = shift;
276	joko	1.3	my $filename = shift;
277	joko	1.1
278	joko	1.3	# does file exist?
279			if (! -e $filename) {
280			$filename = dirname(__FILE__) . "/$filename";
281			if (! -e $filename) {
282	joko	1.5	die("File $filename does not exist.");
283	joko	1.3	}
284			}
285	joko	1.1
286	joko	1.3	open(FH, "<" . $filename);
287			my @lines = <FH>;
288			my $content = join("", @lines);
289			close(FH);
290			return $content;
291	joko	1.1	}
292
293			1;
294			__END__
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26