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 );
 134     #Alternatively:
 135     #$output = $xslt_engine->transform({ xml => $xml, file => $file, [parameters => $parameters] });
 136     #$output = $xslt_engine->transform({ xml => $xml, code => $code, [parameters => $parameters] });
 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     Returns the transformed string.
 147     Check the error number in err to know if something went wrong.
 148     In that case do_not_return_source did determine the return value.
 149
 150 =cut
 151
 152 sub transform {
 153     my $self = shift;
 154
 155     #check parameters
 156     #  old style: $xml, $filename
 157     #  new style: $hashref
 158     my ( $xml, $filename, $xsltcode );
 159     my $parameters = {};
 160     if( ref $_[0] eq 'HASH' ) {
 161         $xml = $_[0]->{xml};
 162         $xsltcode = $_[0]->{code};
 163         $filename = $_[0]->{file} if !$xsltcode; #xsltcode gets priority
 164         $parameters = $_[0]->{parameters} if ref $_[0]->{parameters} eq 'HASH';
 165     } else {
 166         ( $xml, $filename ) = @_;
 167     }
 168
 169     #Initialized yet?
 170     if ( !$self->{xslt_hash} ) {
 171         $self->_init;
 172     }
 173     else {
 174         $self->_set_error;    #clear last error
 175     }
 176     my $retval = $self->{do_not_return_source} ? undef : $xml;
 177
 178     #check if no string passed
 179     if ( !defined $xml ) {
 180         $self->_set_error(7);
 181         return;               #always undef
 182     }
 183
 184     #load stylesheet
 185     my $key = $self->_load( $filename, $xsltcode );
 186     my $stsh = $key? $self->{xslt_hash}->{$key}: undef;
 187     return $retval if $self->{err};
 188
 189     #parse input and transform
 190     my $parser = XML::LibXML->new();
 191     my $source = eval { $parser->parse_string($xml) };
 192     if ($@) {
 193         $self->_set_error( 5, $@ );
 194         return $retval;
 195     }
 196     my $str = eval {
 197         #$parameters is an optional hashref that contains
 198         #key-value pairs to be sent to the XSLT.
 199         #Numbers may be bare but strings must be double quoted
 200         #(e.g. "'string'" or '"string"'). See XML::LibXSLT for
 201         #more details.
 202
 203         #NOTE: Parameters are not cached. They are provided for
 204         #each different transform.
 205         my $result = $stsh->transform($source, %$parameters);
 206         $stsh->output_as_chars($result);
 207     };
 208     if ($@) {
 209         $self->_set_error( 6, $@ );
 210         return $retval;
 211     }
 212     $self->{last_xsltfile} = $key;
 213     return $str;
 214 }
 215
 216 =head2 refresh
 217
 218     $xslt_engine->refresh;
 219     $xslt_engine->refresh( $xsltfilename );
 220
 221     Pass a file for an individual refresh or no file to refresh all.
 222     Refresh returns the number of items affected.
 223     What we actually do, is just clear the internal cache for reloading next
 224     time when transform is called.
 225     The return value is mainly theoretical. Since this is supposed to work
 226     always(...), there is no actual need to test it.
 227     Note that refresh does also clear the error information.
 228
 229 =cut
 230
 231 sub refresh {
 232     my ( $self, $file ) = @_;
 233     $self->_set_error;
 234     return if !$self->{xslt_hash};
 235     my $rv;
 236     if ($file) {
 237         $rv = delete $self->{xslt_hash}->{$file} ? 1 : 0;
 238     }
 239     else {
 240         $rv = scalar keys %{ $self->{xslt_hash} };
 241         $self->{xslt_hash} = {};
 242     }
 243     return $rv;
 244 }
 245
 246 # **************  INTERNAL ROUTINES ********************************************
 247
 248 # _init
 249 # Internal routine for initialization.
 250
 251 sub _init {
 252     my $self = shift;
 253
 254     $self->_set_error;
 255     $self->{xslt_hash}            = {};
 256     $self->{print_warns}          = 1 unless exists $self->{print_warns};
 257     $self->{do_not_return_source} = 0
 258       unless exists $self->{do_not_return_source};
 259
 260     #by default we return source on a failing transformation
 261     #but it could be passed at construction time already
 262     return;
 263 }
 264
 265 # _load
 266 # Internal routine for loading a new stylesheet.
 267
 268 sub _load {
 269     my ( $self, $filename, $code ) = @_;
 270     my ( $digest, $codelen, $salt, $rv );
 271     $salt = 'AZ'; #just a constant actually
 272
 273     #If no file or code passed, use the last file again
 274     if ( !$filename && !$code ) {
 275         my $last = $self->{last_xsltfile};
 276         if ( !$last || !exists $self->{xslt_hash}->{$last} ) {
 277             $self->_set_error(1);
 278             return;
 279         }
 280         return $last;
 281     }
 282
 283     #check if it is loaded already
 284     if( $code ) {
 285         $codelen = length( $code );
 286         $digest = eval { crypt($code, $salt) };
 287         if( $digest && exists $self->{xslt_hash}->{$digest.$codelen} ) {
 288             return $digest.$codelen;
 289         }
 290     } elsif( $filename && exists $self->{xslt_hash}->{$filename} ) {
 291           return $filename;
 292     }
 293
 294     #Check file existence (skipping URLs)
 295     if( $filename && $filename !~ /^https?:\/\// && !-e $filename ) {
 296         $self->_set_error(2);
 297         return;
 298     }
 299
 300     #load sheet
 301     my $parser = XML::LibXML->new;
 302     my $style_doc = eval {
 303         $parser->load_xml( $self->_load_xml_args($filename, $code) )
 304     };
 305     if ($@) {
 306         $self->_set_error( 3, $@ );
 307         return;
 308     }
 309
 310     #parse sheet
 311     my $xslt = XML::LibXSLT->new;
 312     $rv = $code? $digest.$codelen: $filename;
 313     $self->{xslt_hash}->{$rv} = eval { $xslt->parse_stylesheet($style_doc) };
 314     if ($@) {
 315         $self->_set_error( 4, $@ );
 316         delete $self->{xslt_hash}->{$rv};
 317         return;
 318     }
 319     return $rv;
 320 }
 321
 322 sub _load_xml_args {
 323     my $self = shift;
 324     return $_[1]? { 'string' => $_[1]//'' }: { 'location' => $_[0]//'' };
 325 }
 326
 327 # _set_error
 328 # Internal routine for handling error information.
 329
 330 sub _set_error {
 331     my ( $self, $errno, $addmsg ) = @_;
 332
 333     if ( !$errno ) {    #clear the error
 334         $self->{err}    = undef;
 335         $self->{errstr} = undef;
 336         return;
 337     }
 338
 339     $self->{err} = $errno;
 340     if ( $errno == 1 ) {
 341         $self->{errstr} = "No XSLT file passed.";
 342     }
 343     elsif ( $errno == 2 ) {
 344         $self->{errstr} = "XSLT file not found.";
 345     }
 346     elsif ( $errno == 3 ) {
 347         $self->{errstr} = "Error while loading stylesheet xml:";
 348     }
 349     elsif ( $errno == 4 ) {
 350         $self->{errstr} = "Error while parsing stylesheet:";
 351     }
 352     elsif ( $errno == 5 ) {
 353         $self->{errstr} = "Error while parsing input:";
 354     }
 355     elsif ( $errno == 6 ) {
 356         $self->{errstr} = "Error while transforming input:";
 357     }
 358     elsif ( $errno == 7 ) {
 359         $self->{errstr} = "No string to transform.";
 360     }
 361
 362     if ($addmsg) {
 363         $self->{errstr} .= " $addmsg";
 364     }
 365
 366     warn $self->{errstr} if $self->{print_warns};
 367     return;
 368 }
 369
 370 =head1 AUTHOR
 371
 372     Marcel de Rooy, Rijksmuseum Netherlands
 373
 374 =cut
 375
 376 1;