XML/XUpdate/XSLT.pm

##############################################################################
#
# Perl module: XML::XUpdate::XSLT
#
# 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 $
#    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.


=head3 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.
    

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


=head4 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...
  

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