use Koha::XSLT_Handler;
my $xslt_engine = Koha::XSLT_Handler->new;
my $output = $xslt_engine->transform($xml, $xsltfilename);
+ $output = $xslt_engine->transform({ xml => $xml, file => $file });
+ $output = $xslt_engine->transform({ xml => $xml, code => $code });
my $err= $xslt_engine->err; # error number
my $errstr= $xslt_engine->errstr; # error message
$xslt_engine->refresh($xsltfilename);
If true, transform returns undef on failure. By default, it returns the
original string passed. Errors are reported as described.
+=head2 print_warns
+
+ If set, print error messages to STDERR. True by default.
+
=head1 ERROR CODES
=head2 Error 1
use base qw(Class::Accessor);
__PACKAGE__->mk_ro_accessors(qw( err errstr ));
-__PACKAGE__->mk_accessors(qw( do_not_return_source ));
+__PACKAGE__->mk_accessors(qw( do_not_return_source print_warns ));
=head2 transform
my $output= $xslt_engine->transform( $xml, $xsltfilename );
+ #Alternatively:
+ #$output = $xslt_engine->transform({ xml => $xml, file => $file, [parameters => $parameters] });
+ #$output = $xslt_engine->transform({ xml => $xml, code => $code, [parameters => $parameters] });
if( $xslt_engine->err ) {
#decide what to do on failure..
}
Pass a xml string and a fully qualified path of a XSLT file.
Instead of a filename, you may also pass a URL.
+ You may also pass the contents of a xsl file as a string like $code above.
If you do not pass a filename, the last file used is assumed.
Returns the transformed string.
Check the error number in err to know if something went wrong.
=cut
sub transform {
- my ( $self, $orgxml, $file ) = @_;
+ my $self = shift;
+
+ #check parameters
+ # old style: $xml, $filename
+ # new style: $hashref
+ my ( $xml, $filename, $xsltcode );
+ my $parameters = {};
+ if( ref $_[0] eq 'HASH' ) {
+ $xml = $_[0]->{xml};
+ $xsltcode = $_[0]->{code};
+ $filename = $_[0]->{file} if !$xsltcode; #xsltcode gets priority
+ $parameters = $_[0]->{parameters} if ref $_[0]->{parameters} eq 'HASH';
+ } else {
+ ( $xml, $filename ) = @_;
+ }
#Initialized yet?
- if( !$self->{xslt_hash} ) {
+ if ( !$self->{xslt_hash} ) {
$self->_init;
}
else {
- $self->_set_error; #clear error
+ $self->_set_error; #clear last error
}
- my $retval= $self->{do_not_return_source}? undef: $orgxml;
+ my $retval = $self->{do_not_return_source} ? undef : $xml;
#check if no string passed
- if( !defined $orgxml ) {
+ if ( !defined $xml ) {
$self->_set_error(7);
- return; #always undef
- }
-
- #If no file passed, use the last file again
- if( !$file ) {
- if( !$self->{last_xsltfile} ) {
- $self->_set_error(1);
- return $retval;
- }
- $file= $self->{last_xsltfile};
+ return; #always undef
}
#load stylesheet
- my $stsh= $self->{xslt_hash}->{$file} // $self->_load($file);
+ my $key = $self->_load( $filename, $xsltcode );
+ my $stsh = $key? $self->{xslt_hash}->{$key}: undef;
return $retval if $self->{err};
#parse input and transform
my $parser = XML::LibXML->new();
- my $source= eval { $parser->parse_string($orgxml) };
- if( $@ ) {
- $self->_set_error(5, $@);
+ my $source = eval { $parser->parse_string($xml) };
+ if ($@) {
+ $self->_set_error( 5, $@ );
return $retval;
}
- my $str= eval {
- my $result= $stsh->transform($source);
+ my $str = eval {
+ #$parameters is an optional hashref that contains
+ #key-value pairs to be sent to the XSLT.
+ #Numbers may be bare but strings must be double quoted
+ #(e.g. "'string'" or '"string"'). See XML::LibXSLT for
+ #more details.
+
+ #NOTE: Parameters are not cached. They are provided for
+ #each different transform.
+ my $result = $stsh->transform($source, %$parameters);
$stsh->output_as_chars($result);
};
- if( $@ ) {
- $self->_set_error(6, $@);
+ if ($@) {
+ $self->_set_error( 6, $@ );
return $retval;
}
- $self->{last_xsltfile}= $file;
+ $self->{last_xsltfile} = $key;
return $str;
}
=cut
sub refresh {
- my ( $self, $file )= @_;
+ my ( $self, $file ) = @_;
$self->_set_error;
return if !$self->{xslt_hash};
my $rv;
- if( $file ) {
- $rv= delete $self->{xslt_hash}->{$file}? 1: 0;
+ if ($file) {
+ $rv = delete $self->{xslt_hash}->{$file} ? 1 : 0;
}
else {
- $rv= scalar keys %{ $self->{xslt_hash} };
- $self->{xslt_hash}= {};
+ $rv = scalar keys %{ $self->{xslt_hash} };
+ $self->{xslt_hash} = {};
}
return $rv;
}
# Internal routine for initialization.
sub _init {
- my $self= shift;
+ my $self = shift;
$self->_set_error;
- $self->{xslt_hash}={};
- $self->{do_not_return_source}=0 unless exists $self->{do_not_return_source};
- #by default we return source on a failing transformation
- #but it could be passed at construction time already
+ $self->{xslt_hash} = {};
+ $self->{print_warns} = 1 unless exists $self->{print_warns};
+ $self->{do_not_return_source} = 0
+ unless exists $self->{do_not_return_source};
+
+ #by default we return source on a failing transformation
+ #but it could be passed at construction time already
return;
}
# Internal routine for loading a new stylesheet.
sub _load {
- my ($self, $file)= @_;
+ my ( $self, $filename, $code ) = @_;
+ my ( $digest, $codelen, $salt, $rv );
+ $salt = 'AZ'; #just a constant actually
+
+ #If no file or code passed, use the last file again
+ if ( !$filename && !$code ) {
+ my $last = $self->{last_xsltfile};
+ if ( !$last || !exists $self->{xslt_hash}->{$last} ) {
+ $self->_set_error(1);
+ return;
+ }
+ return $last;
+ }
- if( !$file || ( $file!~ /^https?:\/\// && !-e $file ) ) {
+ #check if it is loaded already
+ if( $code ) {
+ $codelen = length( $code );
+ $digest = eval { crypt($code, $salt) };
+ if( $digest && exists $self->{xslt_hash}->{$digest.$codelen} ) {
+ return $digest.$codelen;
+ }
+ } elsif( $filename && exists $self->{xslt_hash}->{$filename} ) {
+ return $filename;
+ }
+
+ #Check file existence (skipping URLs)
+ if( $filename && $filename !~ /^https?:\/\// && !-e $filename ) {
$self->_set_error(2);
return;
}
#load sheet
my $parser = XML::LibXML->new;
- my $style_doc = eval { $parser->load_xml( location => $file ) };
- if( $@ ) {
- $self->_set_error(3, $@);
+ my $style_doc = eval {
+ $parser->load_xml( $self->_load_xml_args($filename, $code) )
+ };
+ if ($@) {
+ $self->_set_error( 3, $@ );
return;
}
#parse sheet
my $xslt = XML::LibXSLT->new;
- $self->{xslt_hash}->{$file} = eval { $xslt->parse_stylesheet($style_doc) };
- if( $@ ) {
- $self->_set_error(4, $@);
- delete $self->{xslt_hash}->{$file};
+ $rv = $code? $digest.$codelen: $filename;
+ $self->{xslt_hash}->{$rv} = eval { $xslt->parse_stylesheet($style_doc) };
+ if ($@) {
+ $self->_set_error( 4, $@ );
+ delete $self->{xslt_hash}->{$rv};
return;
}
- return $self->{xslt_hash}->{$file};
+ return $rv;
+}
+
+sub _load_xml_args {
+ my $self = shift;
+ return $_[1]? { 'string' => $_[1]//'' }: { 'location' => $_[0]//'' };
}
# _set_error
# Internal routine for handling error information.
sub _set_error {
- my ($self, $errno, $addmsg)= @_;
+ my ( $self, $errno, $addmsg ) = @_;
- if(!$errno) { #clear the error
- $self->{err}= undef;
- $self->{errstr}= undef;
+ if ( !$errno ) { #clear the error
+ $self->{err} = undef;
+ $self->{errstr} = undef;
return;
}
- $self->{err}= $errno;
- if($errno==1) {
- $self->{errstr}= "No XSLT file passed.";
+ $self->{err} = $errno;
+ if ( $errno == 1 ) {
+ $self->{errstr} = "No XSLT file passed.";
}
- elsif($errno==2) {
- $self->{errstr}= "XSLT file not found.";
+ elsif ( $errno == 2 ) {
+ $self->{errstr} = "XSLT file not found.";
}
- elsif($errno==3) {
- $self->{errstr}= "Error while loading stylesheet xml:";
+ elsif ( $errno == 3 ) {
+ $self->{errstr} = "Error while loading stylesheet xml:";
}
- elsif($errno==4) {
- $self->{errstr}= "Error while parsing stylesheet:";
+ elsif ( $errno == 4 ) {
+ $self->{errstr} = "Error while parsing stylesheet:";
}
- elsif($errno==5) {
- $self->{errstr}= "Error while parsing input:";
+ elsif ( $errno == 5 ) {
+ $self->{errstr} = "Error while parsing input:";
}
- elsif($errno==6) {
- $self->{errstr}= "Error while transforming input:";
+ elsif ( $errno == 6 ) {
+ $self->{errstr} = "Error while transforming input:";
}
- elsif($errno==7) {
- $self->{errstr}= "No string to transform.";
+ elsif ( $errno == 7 ) {
+ $self->{errstr} = "No string to transform.";
}
- if( $addmsg ) {
- $self->{errstr}.= " $addmsg";
+ if ($addmsg) {
+ $self->{errstr} .= " $addmsg";
}
+
+ warn $self->{errstr} if $self->{print_warns};
return;
}
projects / srvgit / blobdiff