|
Lines 1-6
Link Here
|
| 1 |
package Koha::XSLT::Base; |
1 |
package Koha::XSLT::Base; |
| 2 |
|
2 |
|
| 3 |
# Copyright 2014 Rijksmuseum |
3 |
# Copyright 2014, 2019 Rijksmuseum, Prosentient Systems |
| 4 |
# |
4 |
# |
| 5 |
# This file is part of Koha. |
5 |
# This file is part of Koha. |
| 6 |
# |
6 |
# |
|
Lines 19-30
package Koha::XSLT::Base;
Link Here
|
| 19 |
|
19 |
|
| 20 |
=head1 NAME |
20 |
=head1 NAME |
| 21 |
|
21 |
|
| 22 |
Koha::XSLT_Handler - Facilitate use of XSLT transformations |
22 |
Koha::XSLT::Base - Facilitate use of XSLT transformations |
| 23 |
|
23 |
|
| 24 |
=head1 SYNOPSIS |
24 |
=head1 SYNOPSIS |
| 25 |
|
25 |
|
| 26 |
use Koha::XSLT_Handler; |
26 |
use Koha::XSLT::Base; |
| 27 |
my $xslt_engine = Koha::XSLT_Handler->new; |
27 |
my $xslt_engine = Koha::XSLT::Base->new; |
| 28 |
my $output = $xslt_engine->transform($xml, $xsltfilename); |
28 |
my $output = $xslt_engine->transform($xml, $xsltfilename); |
| 29 |
$output = $xslt_engine->transform({ xml => $xml, file => $file }); |
29 |
$output = $xslt_engine->transform({ xml => $xml, file => $file }); |
| 30 |
$output = $xslt_engine->transform({ xml => $xml, code => $code }); |
30 |
$output = $xslt_engine->transform({ xml => $xml, code => $code }); |
|
Lines 43-49
Koha::XSLT_Handler - Facilitate use of XSLT transformations
Link Here
|
| 43 |
|
43 |
|
| 44 |
=head2 new |
44 |
=head2 new |
| 45 |
|
45 |
|
| 46 |
Create handler object (via Class::Accessor) |
46 |
Create handler object |
| 47 |
|
47 |
|
| 48 |
=head2 transform |
48 |
=head2 transform |
| 49 |
|
49 |
|
|
Lines 118-123
Koha::XSLT_Handler - Facilitate use of XSLT transformations
Link Here
|
| 118 |
use Modern::Perl; |
118 |
use Modern::Perl; |
| 119 |
use XML::LibXML; |
119 |
use XML::LibXML; |
| 120 |
use XML::LibXSLT; |
120 |
use XML::LibXSLT; |
|
|
121 |
use Koha::XSLT::Security; |
| 121 |
|
122 |
|
| 122 |
use base qw(Class::Accessor); |
123 |
use base qw(Class::Accessor); |
| 123 |
|
124 |
|
|
Lines 132-137
use constant XSLTH_ERR_5 => 'XSLTH_ERR_PARSING_DATA';
Link Here
|
| 132 |
use constant XSLTH_ERR_6 => 'XSLTH_ERR_TRANSFORMING'; |
133 |
use constant XSLTH_ERR_6 => 'XSLTH_ERR_TRANSFORMING'; |
| 133 |
use constant XSLTH_ERR_7 => 'XSLTH_NO_STRING_PASSED'; |
134 |
use constant XSLTH_ERR_7 => 'XSLTH_NO_STRING_PASSED'; |
| 134 |
|
135 |
|
|
|
136 |
=head2 new |
| 137 |
|
| 138 |
my $xslt_engine = Koha::XSLT::Base->new; |
| 139 |
|
| 140 |
=cut |
| 141 |
|
| 142 |
sub new { |
| 143 |
my ($class, $params) = @_; |
| 144 |
my $self = $class->SUPER::new($params); |
| 145 |
$self->{_security} = Koha::XSLT::Security->new; |
| 146 |
$self->{_security}->register_callbacks; |
| 147 |
return $self; |
| 148 |
} |
| 149 |
|
| 135 |
=head2 transform |
150 |
=head2 transform |
| 136 |
|
151 |
|
| 137 |
my $output= $xslt_engine->transform( $xml, $xsltfilename, [$format] ); |
152 |
my $output= $xslt_engine->transform( $xml, $xsltfilename, [$format] ); |
|
Lines 195-200
sub transform {
Link Here
|
| 195 |
|
210 |
|
| 196 |
#parse input and transform |
211 |
#parse input and transform |
| 197 |
my $parser = XML::LibXML->new(); |
212 |
my $parser = XML::LibXML->new(); |
|
|
213 |
$self->{_security}->set_parser_options($parser); |
| 198 |
my $source = eval { $parser->parse_string($xml) }; |
214 |
my $source = eval { $parser->parse_string($xml) }; |
| 199 |
if ($@) { |
215 |
if ($@) { |
| 200 |
$self->_set_error( XSLTH_ERR_5, $@ ); |
216 |
$self->_set_error( XSLTH_ERR_5, $@ ); |
|
Lines 312-317
sub _load {
Link Here
|
| 312 |
|
328 |
|
| 313 |
#load sheet |
329 |
#load sheet |
| 314 |
my $parser = XML::LibXML->new; |
330 |
my $parser = XML::LibXML->new; |
|
|
331 |
$self->{_security}->set_parser_options($parser); |
| 315 |
my $style_doc = eval { |
332 |
my $style_doc = eval { |
| 316 |
$parser->load_xml( $self->_load_xml_args($filename, $code) ) |
333 |
$parser->load_xml( $self->_load_xml_args($filename, $code) ) |
| 317 |
}; |
334 |
}; |
|
Lines 320-359
sub _load {
Link Here
|
| 320 |
return; |
337 |
return; |
| 321 |
} |
338 |
} |
| 322 |
|
339 |
|
| 323 |
my $security = XML::LibXSLT::Security->new(); |
|
|
| 324 |
$security->register_callback( read_file => sub { |
| 325 |
warn "read_file called in XML::LibXSLT"; |
| 326 |
#i.e. when using the exsl:document() element or document() function (to read a XML file) |
| 327 |
my ($tctxt,$value) = @_; |
| 328 |
return 0; |
| 329 |
}); |
| 330 |
$security->register_callback( write_file => sub { |
| 331 |
warn "write_file called in XML::LibXSLT"; |
| 332 |
#i.e. when using the exsl:document element (or document() function?) (to write an output file of many possible types) |
| 333 |
#e.g. |
| 334 |
#<exsl:document href="file:///tmp/breached.txt"> |
| 335 |
# <xsl:text>breached!</xsl:text> |
| 336 |
#</exsl:document> |
| 337 |
my ($tctxt,$value) = @_; |
| 338 |
return 0; |
| 339 |
}); |
| 340 |
$security->register_callback( read_net => sub { |
| 341 |
warn "read_net called in XML::LibXSLT"; |
| 342 |
#i.e. when using the document() function (to read XML from the network) |
| 343 |
#e.g. <xsl:copy-of select="document('http://localhost')" /> |
| 344 |
my ($tctxt,$value) = @_; |
| 345 |
return 0; |
| 346 |
}); |
| 347 |
$security->register_callback( write_net => sub { |
| 348 |
warn "write_net called in XML::LibXSLT"; |
| 349 |
#NOTE: it's unknown how one would invoke this, but covering our bases anyway |
| 350 |
my ($tctxt,$value) = @_; |
| 351 |
return 0; |
| 352 |
}); |
| 353 |
|
| 354 |
#parse sheet |
340 |
#parse sheet |
| 355 |
my $xslt = XML::LibXSLT->new; |
341 |
my $xslt = XML::LibXSLT->new; |
| 356 |
$xslt->security_callbacks( $security ); |
342 |
$self->{_security}->set_callbacks($xslt); |
| 357 |
|
343 |
|
| 358 |
$rv = $code? $digest.$codelen: $filename; |
344 |
$rv = $code? $digest.$codelen: $filename; |
| 359 |
$self->{xslt_hash}->{$rv} = eval { $xslt->parse_stylesheet($style_doc) }; |
345 |
$self->{xslt_hash}->{$rv} = eval { $xslt->parse_stylesheet($style_doc) }; |
|
Lines 377-388
sub _set_error {
Link Here
|
| 377 |
my ( $self, $errcode, $warn ) = @_; |
363 |
my ( $self, $errcode, $warn ) = @_; |
| 378 |
|
364 |
|
| 379 |
$self->{err} = $errcode; #set or clear error |
365 |
$self->{err} = $errcode; #set or clear error |
| 380 |
warn 'XSLT_Handler: '. $warn if $warn && $self->{print_warns}; |
366 |
warn 'XSLT::Base: '. $warn if $warn && $self->{print_warns}; |
| 381 |
} |
367 |
} |
| 382 |
|
368 |
|
| 383 |
=head1 AUTHOR |
369 |
=head1 AUTHOR |
| 384 |
|
370 |
|
| 385 |
Marcel de Rooy, Rijksmuseum Netherlands |
371 |
Marcel de Rooy, Rijksmuseum Netherlands |
|
|
372 |
David Cook, Prosentient Systems |
| 386 |
|
373 |
|
| 387 |
=cut |
374 |
=cut |
| 388 |
|
375 |
|
| 389 |
- |
|
|