XML/XUpdate/XSLT.pm

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