Koha/XSLT_Handler.pm

   1 package Koha::XSLT_Handler;
   2
   3 # Copyright 2014 Rijksmuseum
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 3 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 =head1 NAME
  21
  22 Koha::XSLT_Handler - Facilitate use of XSLT transformations
  23
  24 =head1 SYNOPSIS
  25
  26     use Koha::XSLT_Handler;
  27     my $xslt_engine = Koha::XSLT_Handler->new;
  28     my $output = $xslt_engine->transform($xml, $xsltfilename);
  29     $output = $xslt_engine->transform({ xml => $xml, file => $file });
  30     $output = $xslt_engine->transform({ xml => $xml, code => $code });
  31     my $err= $xslt_engine->err; # error number
  32     my $errstr= $xslt_engine->errstr; # error message
  33     $xslt_engine->refresh($xsltfilename);
  34
  35 =head1 DESCRIPTION
  36
  37     A XSLT handler object on top of LibXML and LibXSLT, allowing you to
  38     run XSLT stylesheets repeatedly without loading them again.
  39     Errors occurring during loading, parsing or transforming are reported
  40     via the err and errstr attributes.
  41     Reloading XSLT files can be done with the refresh method.
  42
  43 =head1 METHODS
  44
  45 =head2 new
  46
  47     Create handler object (via Class::Accessor)
  48
  49 =head2 transform
  50
  51     Run transformation for specific string and stylesheet
  52
  53 =head2 refresh
  54
  55     Allow to reload stylesheets when transforming again
  56
  57 =head1 PROPERTIES
  58
  59 =head2 err
  60
  61     Error number (see list of ERROR CODES)
  62
  63 =head2 errstr
  64
  65     Error message
  66
  67 =head2 do_not_return_source
  68
  69     If true, transform returns undef on failure. By default, it returns the
  70     original string passed. Errors are reported as described.
  71
  72 =head2 print_warns
  73
  74     If set, print error messages to STDERR. True by default.
  75
  76 =head1 ERROR CODES
  77
  78 =head2 Error 1
  79
  80     No XSLT file passed
  81
  82 =head2 Error 2
  83
  84     XSLT file not found
  85
  86 =head2 Error 3
  87
  88     Error while loading stylesheet xml: [furter information]
  89
  90 =head2 Error 4
  91
  92     Error while parsing stylesheet: [furter information]
  93
  94 =head2 Error 5
  95
  96     Error while parsing input: [furter information]
  97
  98 =head2 Error 6
  99
 100     Error while transforming input: [furter information]
 101
 102 =head2 Error 7
 103
 104     No string to transform
 105
 106 =head1 INTERNALS
 107
 108     For documentation purposes. You are not encouraged to access them.
 109
 110 =head2 last_xsltfile
 111
 112     Contains the last successfully executed XSLT filename
 113
 114 =head2 xslt_hash
 115
 116     Hash reference to loaded stylesheets
 117
 118 =head1 ADDITIONAL COMMENTS
 119
 120 =cut
 121
 122 use Modern::Perl;
 123 use XML::LibXML;
 124 use XML::LibXSLT;
 125
 126 use base qw(Class::Accessor);
 127
 128 __PACKAGE__->mk_ro_accessors(qw( err errstr ));
 129 __PACKAGE__->mk_accessors(qw( do_not_return_source print_warns ));
 130
 131 =head2 transform
 132
 133     my $output= $xslt_engine->transform( $xml, $xsltfilename, [$format] );
 134     #Alternatively:
 135     #$output = $xslt_engine->transform({ xml => $xml, file => $file, [parameters => $parameters], [format => ['chars'|'bytes'|'xmldoc']] });
 136     #$output = $xslt_engine->transform({ xml => $xml, code => $code, [parameters => $parameters], [format => ['chars'|'bytes'|'xmldoc']] });
 137     if( $xslt_engine->err ) {
 138         #decide what to do on failure..
 139     }
 140     my $output2= $xslt_engine->transform( $xml2 );
 141
 142     Pass a xml string and a fully qualified path of a XSLT file.
 143     Instead of a filename, you may also pass a URL.
 144     You may also pass the contents of a xsl file as a string like $code above.
 145     If you do not pass a filename, the last file used is assumed.
 146     Normally returns the transformed string; if you pass format => 'xmldoc' in
 147     the hash format, it returns a xml document object.
 148     Check the error number in err to know if something went wrong.
 149     In that case do_not_return_source did determine the return value.
 150
 151 =cut
 152
 153 sub transform {
 154     my $self = shift;
 155
 156     #check parameters
 157     #  old style: $xml, $filename, $format
 158     #  new style: $hashref
 159     my ( $xml, $filename, $xsltcode, $format );
 160     my $parameters = {};
 161     if( ref $_[0] eq 'HASH' ) {
 162         $xml = $_[0]->{xml};
 163         $xsltcode = $_[0]->{code};
 164         $filename = $_[0]->{file} if !$xsltcode; #xsltcode gets priority
 165         $parameters = $_[0]->{parameters} if ref $_[0]->{parameters} eq 'HASH';
 166         $format = $_[0]->{format} || 'chars';
 167     } else {
 168         ( $xml, $filename, $format ) = @_;
 169         $format ||= 'chars';
 170     }
 171
 172     #Initialized yet?
 173     if ( !$self->{xslt_hash} ) {
 174         $self->_init;
 175     }
 176     else {
 177         $self->_set_error;    #clear last error
 178     }
 179     my $retval = $self->{do_not_return_source} ? undef : $xml;
 180
 181     #check if no string passed
 182     if ( !defined $xml ) {
 183         $self->_set_error(7);
 184         return;               #always undef
 185     }
 186
 187     #load stylesheet
 188     my $key = $self->_load( $filename, $xsltcode );
 189     my $stsh = $key? $self->{xslt_hash}->{$key}: undef;
 190     return $retval if $self->{err};
 191
 192     #parse input and transform
 193     my $parser = XML::LibXML->new();
 194     my $source = eval { $parser->parse_string($xml) };
 195     if ($@) {
 196         $self->_set_error( 5, $@ );
 197         return $retval;
 198     }
 199     my $result = eval {
 200         #$parameters is an optional hashref that contains
 201         #key-value pairs to be sent to the XSLT.
 202         #Numbers may be bare but strings must be double quoted
 203         #(e.g. "'string'" or '"string"'). See XML::LibXSLT for
 204         #more details.
 205
 206         #NOTE: Parameters are not cached. They are provided for
 207         #each different transform.
 208         my $transformed = $stsh->transform($source, %$parameters);
 209         $format eq 'bytes'
 210             ? $stsh->output_as_bytes( $transformed )
 211             : $format eq 'xmldoc'
 212             ? $transformed
 213             : $stsh->output_as_chars( $transformed ); # default: chars
 214     };
 215     if ($@) {
 216         $self->_set_error( 6, $@ );
 217         return $retval;
 218     }
 219     $self->{last_xsltfile} = $key;
 220     return $result;
 221 }
 222
 223 =head2 refresh
 224
 225     $xslt_engine->refresh;
 226     $xslt_engine->refresh( $xsltfilename );
 227
 228     Pass a file for an individual refresh or no file to refresh all.
 229     Refresh returns the number of items affected.
 230     What we actually do, is just clear the internal cache for reloading next
 231     time when transform is called.
 232     The return value is mainly theoretical. Since this is supposed to work
 233     always(...), there is no actual need to test it.
 234     Note that refresh does also clear the error information.
 235
 236 =cut
 237
 238 sub refresh {
 239     my ( $self, $file ) = @_;
 240     $self->_set_error;
 241     return if !$self->{xslt_hash};
 242     my $rv;
 243     if ($file) {
 244         $rv = delete $self->{xslt_hash}->{$file} ? 1 : 0;
 245     }
 246     else {
 247         $rv = scalar keys %{ $self->{xslt_hash} };
 248         $self->{xslt_hash} = {};
 249     }
 250     return $rv;
 251 }
 252
 253 # **************  INTERNAL ROUTINES ********************************************
 254
 255 # _init
 256 # Internal routine for initialization.
 257
 258 sub _init {
 259     my $self = shift;
 260
 261     $self->_set_error;
 262     $self->{xslt_hash}            = {};
 263     $self->{print_warns}          = 1 unless exists $self->{print_warns};
 264     $self->{do_not_return_source} = 0
 265       unless exists $self->{do_not_return_source};
 266
 267     #by default we return source on a failing transformation
 268     #but it could be passed at construction time already
 269     return;
 270 }
 271
 272 # _load
 273 # Internal routine for loading a new stylesheet.
 274
 275 sub _load {
 276     my ( $self, $filename, $code ) = @_;
 277     my ( $digest, $codelen, $salt, $rv );
 278     $salt = 'AZ'; #just a constant actually
 279
 280     #If no file or code passed, use the last file again
 281     if ( !$filename && !$code ) {
 282         my $last = $self->{last_xsltfile};
 283         if ( !$last || !exists $self->{xslt_hash}->{$last} ) {
 284             $self->_set_error(1);
 285             return;
 286         }
 287         return $last;
 288     }
 289
 290     #check if it is loaded already
 291     if( $code ) {
 292         $codelen = length( $code );
 293         $digest = eval { crypt($code, $salt) };
 294         if( $digest && exists $self->{xslt_hash}->{$digest.$codelen} ) {
 295             return $digest.$codelen;
 296         }
 297     } elsif( $filename && exists $self->{xslt_hash}->{$filename} ) {
 298           return $filename;
 299     }
 300
 301     #Check file existence (skipping URLs)
 302     if( $filename && $filename !~ /^https?:\/\// && !-e $filename ) {
 303         $self->_set_error(2);
 304         return;
 305     }
 306
 307     #load sheet
 308     my $parser = XML::LibXML->new;
 309     my $style_doc = eval {
 310         $parser->load_xml( $self->_load_xml_args($filename, $code) )
 311     };
 312     if ($@) {
 313         $self->_set_error( 3, $@ );
 314         return;
 315     }
 316
 317     #parse sheet
 318     my $xslt = XML::LibXSLT->new;
 319     $rv = $code? $digest.$codelen: $filename;
 320     $self->{xslt_hash}->{$rv} = eval { $xslt->parse_stylesheet($style_doc) };
 321     if ($@) {
 322         $self->_set_error( 4, $@ );
 323         delete $self->{xslt_hash}->{$rv};
 324         return;
 325     }
 326     return $rv;
 327 }
 328
 329 sub _load_xml_args {
 330     my $self = shift;
 331     return $_[1]? { 'string' => $_[1]//'' }: { 'location' => $_[0]//'' };
 332 }
 333
 334 # _set_error
 335 # Internal routine for handling error information.
 336
 337 sub _set_error {
 338     my ( $self, $errno, $addmsg ) = @_;
 339
 340     if ( !$errno ) {    #clear the error
 341         $self->{err}    = undef;
 342         $self->{errstr} = undef;
 343         return;
 344     }
 345
 346     $self->{err} = $errno;
 347     if ( $errno == 1 ) {
 348         $self->{errstr} = "No XSLT file passed.";
 349     }
 350     elsif ( $errno == 2 ) {
 351         $self->{errstr} = "XSLT file not found.";
 352     }
 353     elsif ( $errno == 3 ) {
 354         $self->{errstr} = "Error while loading stylesheet xml:";
 355     }
 356     elsif ( $errno == 4 ) {
 357         $self->{errstr} = "Error while parsing stylesheet:";
 358     }
 359     elsif ( $errno == 5 ) {
 360         $self->{errstr} = "Error while parsing input:";
 361     }
 362     elsif ( $errno == 6 ) {
 363         $self->{errstr} = "Error while transforming input:";
 364     }
 365     elsif ( $errno == 7 ) {
 366         $self->{errstr} = "No string to transform.";
 367     }
 368
 369     if ($addmsg) {
 370         $self->{errstr} .= " $addmsg";
 371     }
 372
 373     warn $self->{errstr} if $self->{print_warns};
 374     return;
 375 }
 376
 377 =head1 AUTHOR
 378
 379     Marcel de Rooy, Rijksmuseum Netherlands
 380
 381 =cut
 382
 383 1;