- 

package Koha::XSLT_Handler;

# Copyright 2014 Rijksmuseum

#

# This file is part of Koha.

#

# Koha is free software; you can redistribute it and/or modify it under the

# terms of the GNU General Public License as published by the Free Software

# Foundation; either version 3 of the License, or (at your option) any later

# version.

#

# Koha is distributed in the hope that it will be useful, but WITHOUT ANY

# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR

# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.

#

# You should have received a copy of the GNU General Public License along

# with Koha; if not, write to the Free Software Foundation, Inc.,

# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

=head1 NAME

Koha::XSLT_Handler - Facilitate use of XSLT transformations

=head1 SYNOPSIS

    use Koha::XSLT_Handler;

    my $xslt_engine = Koha::XSLT_Handler->new;

    my $output = $xslt_engine->transform($xml, $xsltfilename);

    my $err= $xslt_engine->err; # error number

    my $errstr= $xslt_engine->errstr; # error message

    $xslt_engine->refresh($xsltfilename);

=head1 DESCRIPTION

    A XSLT handler object on top of LibXML and LibXSLT, allowing you to

    run XSLT stylesheets repeatedly without loading them again.

    Errors occurring during loading, parsing or transforming are reported

    via the err and errstr attributes.

    Reloading XSLT files can be done with the refresh method.

=head1 METHODS

=head2 new

    Create handler object (via Class::Accessor)

=head2 transform

    Run transformation for specific string and stylesheet

=head2 refresh

    Allow to reload stylesheets when transforming again

=head1 PROPERTIES

=head2 err

    Error number (see list of ERROR CODES)

=head2 errstr

    Error message

=head2 do_not_return_source

    If true, transform returns undef on failure. By default, it returns the

    original string passed. Errors are reported as described.

=head1 ERROR CODES

=head2 Error 1

    No XSLT file passed

=head2 Error 2

    XSLT file not found

=head2 Error 3

    Error while loading stylesheet xml: [furter information]

=head2 Error 4

    Error while parsing stylesheet: [furter information]

=head2 Error 5

    Error while parsing input: [furter information]

=head2 Error 6

    Error while transforming input: [furter information]

=head2 Error 7

    No string to transform

=head1 INTERNALS

    For documentation purposes. You are not encouraged to access them.

=head2 last_xsltfile

    Contains the last successfully executed XSLT filename

=head2 xslt_hash

    Hash reference to loaded stylesheets

=head1 ADDITIONAL COMMENTS

=cut

use Modern::Perl;

use XML::LibXML;

use XML::LibXSLT;

use base qw(Class::Accessor);

__PACKAGE__->mk_ro_accessors(qw( err errstr ));

__PACKAGE__->mk_accessors(qw( do_not_return_source ));

=head2 transform

    my $output= $xslt_engine->transform( $xml, $xsltfilename );

    if( $xslt_engine->err ) {

        #decide what to do on failure..

    }

    my $output2= $xslt_engine->transform( $xml2 );

    Pass a xml string and a fully qualified path of a XSLT file.

    If you do not pass a filename, the last file used is assumed.

    Returns the transformed string.

    Check the error number in err to know if something went wrong.

    In that case do_not_return_source did determine the return value.

=cut

sub transform {

    my ( $self, $orgxml, $file ) = @_;

    #Initialized yet?

    if( !$self->{xslt_hash} ) {

        $self->_init;

    }

    else {

        $self->_set_error; #clear error

    }

    my $retval= $self->{do_not_return_source}? undef: $orgxml;

    #check if no string passed

    if( !defined $orgxml ) {

        $self->_set_error(7);

        return; #always undef

    }

    #If no file passed, use the last file again

    if( !$file ) {

        if( !$self->{last_xsltfile} ) {

            $self->_set_error(1);

            return $retval;

        }

        $file= $self->{last_xsltfile};

    }

    #load stylesheet

    my $stsh= $self->{xslt_hash}->{$file} // $self->_load($file);

    return $retval if $self->{err};

    #parse input and transform

    my $parser = XML::LibXML->new();

    my $source= eval { $parser->parse_string($orgxml) };

    if( $@ ) {

        $self->_set_error(5, $@);

        return $retval;

    }

    my $str= eval {

        my $result= $stsh->transform($source);

        $stsh->output_as_chars($result);

    };

    if( $@ ) {

        $self->_set_error(6, $@);

        return $retval;

    }

    $self->{last_xsltfile}= $file;

    return $str;

}

=head2 refresh

    $xslt_engine->refresh;

    $xslt_engine->refresh( $xsltfilename );

    Pass a file for an individual refresh or no file to refresh all.

    Refresh returns the number of items affected.

    What we actually do, is just clear the internal cache for reloading next

    time when transform is called.

    The return value is mainly theoretical. Since this is supposed to work

    always(...), there is no actual need to test it.

    Note that refresh does also clear the error information.

=cut

sub refresh {

    my ( $self, $file )= @_;

    $self->_set_error;

    return if !$self->{xslt_hash};

    my $rv;

    if( $file ) {

        $rv= delete $self->{xslt_hash}->{$file}? 1: 0;

    }

    else {

        $rv= scalar keys %{ $self->{xslt_hash} };

        $self->{xslt_hash}= {};

    }

    return $rv;

}

# **************  INTERNAL ROUTINES ********************************************

# _init

# Internal routine for initialization.

sub _init {

    my $self= shift;

    $self->_set_error;

    $self->{xslt_hash}={};

    $self->{do_not_return_source}=0 unless exists $self->{do_not_return_source};

        #by default we return source on a failing transformation

        #but it could be passed at construction time already

    return;

}

# _load

# Internal routine for loading a new stylesheet.

sub _load {

    my ($self, $file)= @_;

    if( !$file || !-e $file ) {

        $self->_set_error(2);

        return;

    }

    #load sheet

    my $parser = XML::LibXML->new;

    my $style_doc = eval { $parser->load_xml( location => $file ) };

    if( $@ ) {

        $self->_set_error(3, $@);

        return;

    }

    #parse sheet

    my $xslt = XML::LibXSLT->new;

    $self->{xslt_hash}->{$file} = eval { $xslt->parse_stylesheet($style_doc) };

    if( $@ ) {

        $self->_set_error(4, $@);

        delete $self->{xslt_hash}->{$file};

        return;

    }

    return $self->{xslt_hash}->{$file};

}

# _set_error

# Internal routine for handling error information.

sub _set_error {

    my ($self, $errno, $addmsg)= @_;

    if(!$errno) { #clear the error

        $self->{err}= undef;

        $self->{errstr}= undef;

        return;

    }

    $self->{err}= $errno;

    if($errno==1) {

        $self->{errstr}= "No XSLT file passed.";

    }

    elsif($errno==2) {

        $self->{errstr}= "XSLT file not found.";

    }

    elsif($errno==3) {

        $self->{errstr}= "Error while loading stylesheet xml:";

    }

    elsif($errno==4) {

        $self->{errstr}= "Error while parsing stylesheet:";

    }

    elsif($errno==5) {

        $self->{errstr}= "Error while parsing input:";

    }

    elsif($errno==6) {

        $self->{errstr}= "Error while transforming input:";

    }

    elsif($errno==7) {

        $self->{errstr}= "No string to transform.";

    }

    if( $addmsg ) {

        $self->{errstr}.= " $addmsg";

    }

    return;

}

=head1 AUTHOR

    Marcel de Rooy, Rijksmuseum Netherlands

=cut

1;