XML/XUpdate/XSLT.pm

##############################################################################
#
# Perl module: XML::XUpdate::XSLT
#
# By Andreas Motl, andreas.motl@ilo.de
#
#    $Id: XSLT.pm,v 1.3 2003/05/01 20:11:49 joko Exp $
#
#    $Log: XSLT.pm,v $
#    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 means: 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!
  

=cut


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

use strict;
use warnings;

use XML::XSLT 0.41;
use Carp;
use File::Basename;
use Data::Dumper;

# 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!
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;
  return $self->{XML}->{result};
}


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

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