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