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     my $err= $xslt_engine->err; # error number
  30     my $errstr= $xslt_engine->errstr; # error message
  31     $xslt_engine->refresh($xsltfilename);
  32
  33 =head1 DESCRIPTION
  34
  35     A XSLT handler object on top of LibXML and LibXSLT, allowing you to
  36     run XSLT stylesheets repeatedly without loading them again.
  37     Errors occurring during loading, parsing or transforming are reported
  38     via the err and errstr attributes.
  39     Reloading XSLT files can be done with the refresh method.
  40
  41 =head1 METHODS
  42
  43 =head2 new
  44
  45     Create handler object (via Class::Accessor)
  46
  47 =head2 transform
  48
  49     Run transformation for specific string and stylesheet
  50
  51 =head2 refresh
  52
  53     Allow to reload stylesheets when transforming again
  54
  55 =head1 PROPERTIES
  56
  57 =head2 err
  58
  59     Error number (see list of ERROR CODES)
  60
  61 =head2 errstr
  62
  63     Error message
  64
  65 =head2 do_not_return_source
  66
  67     If true, transform returns undef on failure. By default, it returns the
  68     original string passed. Errors are reported as described.
  69
  70 =head2 print_warns
  71
  72     If set, print error messages to STDERR. True by default.
  73
  74 =head1 ERROR CODES
  75
  76 =head2 Error 1
  77
  78     No XSLT file passed
  79
  80 =head2 Error 2
  81
  82     XSLT file not found
  83
  84 =head2 Error 3
  85
  86     Error while loading stylesheet xml: [furter information]
  87
  88 =head2 Error 4
  89
  90     Error while parsing stylesheet: [furter information]
  91
  92 =head2 Error 5
  93
  94     Error while parsing input: [furter information]
  95
  96 =head2 Error 6
  97
  98     Error while transforming input: [furter information]
  99
 100 =head2 Error 7
 101
 102     No string to transform
 103
 104 =head1 INTERNALS
 105
 106     For documentation purposes. You are not encouraged to access them.
 107
 108 =head2 last_xsltfile
 109
 110     Contains the last successfully executed XSLT filename
 111
 112 =head2 xslt_hash
 113
 114     Hash reference to loaded stylesheets
 115
 116 =head1 ADDITIONAL COMMENTS
 117
 118 =cut
 119
 120 use Modern::Perl;
 121 use XML::LibXML;
 122 use XML::LibXSLT;
 123
 124 use base qw(Class::Accessor);
 125
 126 __PACKAGE__->mk_ro_accessors(qw( err errstr ));
 127 __PACKAGE__->mk_accessors(qw( do_not_return_source print_warns ));
 128
 129 =head2 transform
 130
 131     my $output= $xslt_engine->transform( $xml, $xsltfilename );
 132     if( $xslt_engine->err ) {
 133         #decide what to do on failure..
 134     }
 135     my $output2= $xslt_engine->transform( $xml2 );
 136
 137     Pass a xml string and a fully qualified path of a XSLT file.
 138     Instead of a filename, you may also pass a URL.
 139     If you do not pass a filename, the last file used is assumed.
 140     Returns the transformed string.
 141     Check the error number in err to know if something went wrong.
 142     In that case do_not_return_source did determine the return value.
 143
 144 =cut
 145
 146 sub transform {
 147     my ( $self, $orgxml, $file ) = @_;
 148
 149     #Initialized yet?
 150     if ( !$self->{xslt_hash} ) {
 151         $self->_init;
 152     }
 153     else {
 154         $self->_set_error;    #clear error
 155     }
 156     my $retval = $self->{do_not_return_source} ? undef : $orgxml;
 157
 158     #check if no string passed
 159     if ( !defined $orgxml ) {
 160         $self->_set_error(7);
 161         return;               #always undef
 162     }
 163
 164     #If no file passed, use the last file again
 165     if ( !$file ) {
 166         if ( !$self->{last_xsltfile} ) {
 167             $self->_set_error(1);
 168             return $retval;
 169         }
 170         $file = $self->{last_xsltfile};
 171     }
 172
 173     #load stylesheet
 174     my $stsh = $self->{xslt_hash}->{$file} // $self->_load($file);
 175     return $retval if $self->{err};
 176
 177     #parse input and transform
 178     my $parser = XML::LibXML->new();
 179     my $source = eval { $parser->parse_string($orgxml) };
 180     if ($@) {
 181         $self->_set_error( 5, $@ );
 182         return $retval;
 183     }
 184     my $str = eval {
 185         my $result = $stsh->transform($source);
 186         $stsh->output_as_chars($result);
 187     };
 188     if ($@) {
 189         $self->_set_error( 6, $@ );
 190         return $retval;
 191     }
 192     $self->{last_xsltfile} = $file;
 193     return $str;
 194 }
 195
 196 =head2 refresh
 197
 198     $xslt_engine->refresh;
 199     $xslt_engine->refresh( $xsltfilename );
 200
 201     Pass a file for an individual refresh or no file to refresh all.
 202     Refresh returns the number of items affected.
 203     What we actually do, is just clear the internal cache for reloading next
 204     time when transform is called.
 205     The return value is mainly theoretical. Since this is supposed to work
 206     always(...), there is no actual need to test it.
 207     Note that refresh does also clear the error information.
 208
 209 =cut
 210
 211 sub refresh {
 212     my ( $self, $file ) = @_;
 213     $self->_set_error;
 214     return if !$self->{xslt_hash};
 215     my $rv;
 216     if ($file) {
 217         $rv = delete $self->{xslt_hash}->{$file} ? 1 : 0;
 218     }
 219     else {
 220         $rv = scalar keys %{ $self->{xslt_hash} };
 221         $self->{xslt_hash} = {};
 222     }
 223     return $rv;
 224 }
 225
 226 # **************  INTERNAL ROUTINES ********************************************
 227
 228 # _init
 229 # Internal routine for initialization.
 230
 231 sub _init {
 232     my $self = shift;
 233
 234     $self->_set_error;
 235     $self->{xslt_hash}            = {};
 236     $self->{print_warns}          = 1 unless exists $self->{print_warns};
 237     $self->{do_not_return_source} = 0
 238       unless exists $self->{do_not_return_source};
 239
 240     #by default we return source on a failing transformation
 241     #but it could be passed at construction time already
 242     return;
 243 }
 244
 245 # _load
 246 # Internal routine for loading a new stylesheet.
 247
 248 sub _load {
 249     my ( $self, $file ) = @_;
 250
 251     if ( !$file || ( $file !~ /^https?:\/\// && !-e $file ) ) {
 252         $self->_set_error(2);
 253         return;
 254     }
 255
 256     #load sheet
 257     my $parser = XML::LibXML->new;
 258     my $style_doc = eval { $parser->load_xml( location => $file ) };
 259     if ($@) {
 260         $self->_set_error( 3, $@ );
 261         return;
 262     }
 263
 264     #parse sheet
 265     my $xslt = XML::LibXSLT->new;
 266     $self->{xslt_hash}->{$file} = eval { $xslt->parse_stylesheet($style_doc) };
 267     if ($@) {
 268         $self->_set_error( 4, $@ );
 269         delete $self->{xslt_hash}->{$file};
 270         return;
 271     }
 272     return $self->{xslt_hash}->{$file};
 273 }
 274
 275 # _set_error
 276 # Internal routine for handling error information.
 277
 278 sub _set_error {
 279     my ( $self, $errno, $addmsg ) = @_;
 280
 281     if ( !$errno ) {    #clear the error
 282         $self->{err}    = undef;
 283         $self->{errstr} = undef;
 284         return;
 285     }
 286
 287     $self->{err} = $errno;
 288     if ( $errno == 1 ) {
 289         $self->{errstr} = "No XSLT file passed.";
 290     }
 291     elsif ( $errno == 2 ) {
 292         $self->{errstr} = "XSLT file not found.";
 293     }
 294     elsif ( $errno == 3 ) {
 295         $self->{errstr} = "Error while loading stylesheet xml:";
 296     }
 297     elsif ( $errno == 4 ) {
 298         $self->{errstr} = "Error while parsing stylesheet:";
 299     }
 300     elsif ( $errno == 5 ) {
 301         $self->{errstr} = "Error while parsing input:";
 302     }
 303     elsif ( $errno == 6 ) {
 304         $self->{errstr} = "Error while transforming input:";
 305     }
 306     elsif ( $errno == 7 ) {
 307         $self->{errstr} = "No string to transform.";
 308     }
 309
 310     if ($addmsg) {
 311         $self->{errstr} .= " $addmsg";
 312     }
 313
 314     warn $self->{errstr} if $self->{print_warns};
 315     return;
 316 }
 317
 318 =head1 AUTHOR
 319
 320     Marcel de Rooy, Rijksmuseum Netherlands
 321
 322 =cut
 323
 324 1;