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