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