Bug 12758: Introduce Koha::XSLT::HTTPS

[koha-ffzg.git] / C4 / XSLT.pm

diff --git a/C4/XSLT.pm b/C4/XSLT.pm
index b757f8f..21d270e 100644 (file)
--- a/C4/XSLT.pm
+++ b/C4/XSLT.pm
@@ -24,31 +24,26 @@ package C4::XSLT;
 use Modern::Perl;
 
 use C4::Context;
 use Modern::Perl;
 
 use C4::Context;

-use C4::Items;
-use C4::Koha;
-use C4::Biblio;
-use C4::Circulation;
-use C4::Reserves;
+use C4::Koha qw( xml_escape );
+use C4::Biblio qw( GetAuthorisedValueDesc GetFrameworkCode GetMarcStructure );

 use Koha::AuthorisedValues;
 use Koha::AuthorisedValues;

-use Koha::XSLT_Handler;
+use Koha::ItemTypes;
+use Koha::RecordProcessor;
+use Koha::XSLT::Base;

 use Koha::Libraries;
 use Koha::Libraries;

-
-use Encode;
-
-use vars qw(@ISA @EXPORT);
+use Koha::Recalls;

 
 my $engine; #XSLT Handler object
 
 my $engine; #XSLT Handler object

-my %authval_per_framework;
-    # Cache for tagfield-tagsubfield to decode per framework.
-    # Should be preferably be placed in Koha-core...

 
 

+our (@ISA, @EXPORT_OK);

 BEGIN {
     require Exporter;
     @ISA = qw(Exporter);
 BEGIN {
     require Exporter;
     @ISA = qw(Exporter);

-    @EXPORT = qw(
-        &XSLTParse4Display
+    @EXPORT_OK = qw(
+        buildKohaItemsNamespace
+        XSLTParse4Display

     );
     );

-    $engine=Koha::XSLT_Handler->new( { do_not_return_source => 1 } );
+    $engine=Koha::XSLT::Base->new( { do_not_return_source => 1 } );

 }
 
 =head1 NAME
 }
 
 =head1 NAME


@@ -57,76 +52,6 @@ C4::XSLT - Functions for displaying XSLT-generated content
 
 =head1 FUNCTIONS
 
 
 =head1 FUNCTIONS
 

-=head2 transformMARCXML4XSLT
-
-Replaces codes with authorized values in a MARC::Record object
-Is only used in this module currently.
-
-=cut
-
-sub transformMARCXML4XSLT {
-    my ($biblionumber, $record) = @_;
-    my $frameworkcode = GetFrameworkCode($biblionumber) || '';
-    my $tagslib = &GetMarcStructure(1, $frameworkcode, { unsafe => 1 });
-    my @fields;
-    # FIXME: wish there was a better way to handle exceptions
-    eval {
-        @fields = $record->fields();
-    };
-    if ($@) { warn "PROBLEM WITH RECORD"; next; }
-    my $marcflavour = C4::Context->preference('marcflavour');
-    my $av = getAuthorisedValues4MARCSubfields($frameworkcode);
-    foreach my $tag ( keys %$av ) {
-        foreach my $field ( $record->field( $tag ) ) {
-            if ( $av->{ $tag } ) {
-                my @new_subfields = ();
-                for my $subfield ( $field->subfields() ) {
-                    my ( $letter, $value ) = @$subfield;
-                    # Replace the field value with the authorised value *except* for MARC21/NORMARC field 942$n (suppression in opac)
-                    if ( !( $tag eq '942' && $subfield eq 'n' ) || $marcflavour eq 'UNIMARC' ) {
-                        $value = GetAuthorisedValueDesc( $tag, $letter, $value, '', $tagslib )
-                            if $av->{ $tag }->{ $letter };
-                    }
-                    push( @new_subfields, $letter, $value );
-                } 
-                $field ->replace_with( MARC::Field->new(
-                    $tag,
-                    $field->indicator(1),
-                    $field->indicator(2),
-                    @new_subfields
-                ) );
-            }
-        }
-    }
-    return $record;
-}
-
-=head2 getAuthorisedValues4MARCSubfields
-
-Returns a ref of hash of ref of hash for tag -> letter controlled by authorised values
-Is only used in this module currently.
-
-=cut
-
-sub getAuthorisedValues4MARCSubfields {
-    my ($frameworkcode) = @_;
-    unless ( $authval_per_framework{ $frameworkcode } ) {
-        my $dbh = C4::Context->dbh;
-        my $sth = $dbh->prepare("SELECT DISTINCT tagfield, tagsubfield
-                                 FROM marc_subfield_structure
-                                 WHERE authorised_value IS NOT NULL
-                                   AND authorised_value!=''
-                                   AND frameworkcode=?");
-        $sth->execute( $frameworkcode );
-        my $av = { };
-        while ( my ( $tag, $letter ) = $sth->fetchrow() ) {
-            $av->{ $tag }->{ $letter } = 1;
-        }
-        $authval_per_framework{ $frameworkcode } = $av;
-    }
-    return $authval_per_framework{ $frameworkcode };
-}
-

 =head2 XSLTParse4Display
 
 Returns xml for biblionumber and requested XSLT transformation.
 =head2 XSLTParse4Display
 
 Returns xml for biblionumber and requested XSLT transformation.


@@ -163,14 +88,17 @@ sub get_xslt_sysprefs {
     my $sysxml = "<sysprefs>\n";
     foreach my $syspref ( qw/ hidelostitems OPACURLOpenInNewWindow
                               DisplayOPACiconsXSLT URLLinkText viewISBD
     my $sysxml = "<sysprefs>\n";
     foreach my $syspref ( qw/ hidelostitems OPACURLOpenInNewWindow
                               DisplayOPACiconsXSLT URLLinkText viewISBD

-                              OPACBaseURL TraceCompleteSubfields UseICU
+                              OPACBaseURL TraceCompleteSubfields UseICUStyleQuotes

                               UseAuthoritiesForTracings TraceSubjectSubdivisions
                               Display856uAsImage OPACDisplay856uAsImage 
                               UseControlNumber IntranetBiblioDefaultView BiblioDefaultView
                               OPACItemLocation DisplayIconsXSLT
                               AlternateHoldingsField AlternateHoldingsSeparator
                               TrackClicks opacthemes IdRef OpacSuppression
                               UseAuthoritiesForTracings TraceSubjectSubdivisions
                               Display856uAsImage OPACDisplay856uAsImage 
                               UseControlNumber IntranetBiblioDefaultView BiblioDefaultView
                               OPACItemLocation DisplayIconsXSLT
                               AlternateHoldingsField AlternateHoldingsSeparator
                               TrackClicks opacthemes IdRef OpacSuppression

-                              OPACResultsLibrary / )
+                              OPACResultsLibrary OPACShowOpenURL
+                              OpenURLResolverURL OpenURLImageLocation
+                              OPACResultsMaxItems OPACResultsMaxItemsUnavailable OPACResultsUnavailableGroupingBy
+                              OpenURLText OPACShowMusicalInscripts OPACPlayMusicalInscripts / )

     {
         my $sp = C4::Context->preference( $syspref );
         next unless defined($sp);
     {
         my $sp = C4::Context->preference( $syspref );
         next unless defined($sp);


@@ -186,17 +114,17 @@ sub get_xslt_sysprefs {
     return $sysxml;
 }
 
     return $sysxml;
 }
 

-sub XSLTParse4Display {
-    my ( $biblionumber, $orig_record, $xslsyspref, $fixamps, $hidden_items, $sysxml, $xslfilename, $lang ) = @_;
+sub get_xsl_filename {
+    my ( $xslsyspref ) = @_;
+
+    my $lang   = C4::Languages::getlanguage();

 
 

-    $sysxml ||= C4::Context->preference($xslsyspref);
-    $xslfilename ||= C4::Context->preference($xslsyspref);
-    $lang ||= C4::Languages::getlanguage();
+    my $xslfilename = C4::Context->preference($xslsyspref) || "default";

 
     if ( $xslfilename =~ /^\s*"?default"?\s*$/i ) {
 
     if ( $xslfilename =~ /^\s*"?default"?\s*$/i ) {

-        my $htdocs;
-        my $theme;
-        my $xslfile;
+
+        my ( $htdocs, $theme, $xslfile );
+

         if ($xslsyspref eq "XSLTDetailsDisplay") {
             $htdocs  = C4::Context->config('intrahtdocs');
             $theme   = C4::Context->preference("template");
         if ($xslsyspref eq "XSLTDetailsDisplay") {
             $htdocs  = C4::Context->config('intrahtdocs');
             $theme   = C4::Context->preference("template");


@@ -237,13 +165,75 @@ sub XSLTParse4Display {
         $xslfilename =~ s/\{langcode\}/$lang/;
     }
 
         $xslfilename =~ s/\{langcode\}/$lang/;
     }
 

+    return $xslfilename;
+}
+
+sub XSLTParse4Display {
+    my ( $params ) = @_;
+
+    my $biblionumber = $params->{biblionumber};
+    my $record       = $params->{record};
+    my $xslsyspref   = $params->{xsl_syspref};
+    my $fixamps      = $params->{fix_amps};
+    my $hidden_items = $params->{hidden_items} || [];
+    my $variables    = $params->{xslt_variables};
+    my $items_rs     = $params->{items_rs};
+    my $interface    = C4::Context->interface;
+
+    die "Mandatory \$params->{xsl_syspref} was not provided, called with biblionumber $params->{biblionumber}"
+        if not defined $params->{xsl_syspref};
+
+    my $xslfilename = get_xsl_filename( $xslsyspref);
+
+    my $frameworkcode = GetFrameworkCode($biblionumber) || '';
+    my $record_processor = Koha::RecordProcessor->new(
+        {
+            filters => [ 'ExpandCodedFields' ],
+            options => {
+                interface     => $interface,
+                frameworkcode => $frameworkcode
+            }
+        }
+    );
+    $record_processor->process($record);
+

     # grab the XML, run it through our stylesheet, push it out to the browser
     # grab the XML, run it through our stylesheet, push it out to the browser

-    my $record = transformMARCXML4XSLT($biblionumber, $orig_record);
-    my $itemsxml  = buildKohaItemsNamespace($biblionumber, $hidden_items);
+    my $itemsxml;
+    if ( $xslsyspref eq "OPACXSLTDetailsDisplay" || $xslsyspref eq "XSLTDetailsDisplay" || $xslsyspref eq "XSLTResultsDisplay" ) {
+        $itemsxml = ""; #We don't use XSLT for items display on these pages
+    } else {
+        $itemsxml = buildKohaItemsNamespace($biblionumber, $hidden_items, $items_rs);
+    }

     my $xmlrecord = $record->as_xml(C4::Context->preference('marcflavour'));
 
     my $xmlrecord = $record->as_xml(C4::Context->preference('marcflavour'));
 

-    $xmlrecord =~ s/\<\/record\>/$itemsxml$sysxml\<\/record\>/;
-    if ($fixamps) { # We need to correct the HTML entities that Zebra outputs
+    $variables ||= {};
+    my $biblio;
+    if ( $interface eq 'opac' && C4::Context->preference('OPACShowOpenURL')) {
+        my @biblio_itemtypes;
+        $biblio //= Koha::Biblios->find($biblionumber);
+        if (C4::Context->preference('item-level_itypes')) {
+            @biblio_itemtypes = $biblio->items->get_column("itype");
+        } else {
+            push @biblio_itemtypes, $biblio->itemtype;
+        }
+        my @itypes = split( /\s/, C4::Context->preference('OPACOpenURLItemTypes') );
+        my %original = ();
+        map { $original{$_} = 1 } @biblio_itemtypes;
+        if ( grep { $original{$_} } @itypes ) {
+            $variables->{OpenURLResolverURL} = $biblio->get_openurl;
+        }
+    }
+
+    my $varxml = "<variables>\n";
+    while (my ($key, $value) = each %$variables) {
+        $value //= q{};
+        $varxml .= "<variable name=\"$key\">$value</variable>\n";
+    }
+    $varxml .= "</variables>\n";
+
+    my $sysxml = get_xslt_sysprefs();
+    $xmlrecord =~ s/\<\/record\>/$itemsxml$sysxml$varxml\<\/record\>/;
+    if ($fixamps) { # We need to correct the ampersand entities that Zebra outputs

         $xmlrecord =~ s/\&amp;amp;/\&amp;/g;
         $xmlrecord =~ s/\&amp\;lt\;/\&lt\;/g;
         $xmlrecord =~ s/\&amp\;gt\;/\&gt\;/g;
         $xmlrecord =~ s/\&amp;amp;/\&amp;/g;
         $xmlrecord =~ s/\&amp\;lt\;/\&lt\;/g;
         $xmlrecord =~ s/\&amp\;gt\;/\&gt\;/g;


@@ -259,80 +249,123 @@ sub XSLTParse4Display {
 
 =head2 buildKohaItemsNamespace
 
 
 =head2 buildKohaItemsNamespace
 

-Returns XML for items.
+    my $items_xml = buildKohaItemsNamespace( $biblionumber, [ $hidden_items, $items ] );
+
+Returns XML for items. It accepts two optional parameters:
+- I<$hidden_items>: An arrayref of itemnumber values, for items that should be hidden
+- I<$items>: A Koha::Items resultset, for the items to be returned
+
+If both parameters are passed, I<$items> is used as the basis resultset, and I<$hidden_items>
+are filtered out of it.
+

 Is only used in this module currently.
 
 =cut
 
 sub buildKohaItemsNamespace {
 Is only used in this module currently.
 
 =cut
 
 sub buildKohaItemsNamespace {

-    my ($biblionumber, $hidden_items) = @_;
+    my ($biblionumber, $hidden_items, $items_rs) = @_;
+
+    $hidden_items ||= [];
+
+    my $query = {};
+    $query = { 'me.itemnumber' => { not_in => $hidden_items } }
+      if $hidden_items;

 
 

-    my @items = C4::Items::GetItemsInfo($biblionumber);
-    if ($hidden_items && @$hidden_items) {
-        my %hi = map {$_ => 1} @$hidden_items;
-        @items = grep { !$hi{$_->{itemnumber}} } @items;
+    unless ( $items_rs && ref($items_rs) eq 'Koha::Items' ) {
+        $query->{'me.biblionumber'} = $biblionumber;
+        $items_rs = Koha::Items->new;

     }
 
     }
 

+    my $items = $items_rs->search( $query, { prefetch => [ 'branchtransfers', 'reserves' ] } );
+

     my $shelflocations =
     my $shelflocations =

-      { map { $_->{authorised_value} => $_->{opac_description} } Koha::AuthorisedValues->get_descriptions_by_koha_field( { frameworkcode => GetFrameworkCode($biblionumber), kohafield => 'items.location' } ) };
+      { map { $_->{authorised_value} => $_->{opac_description} } Koha::AuthorisedValues->get_descriptions_by_koha_field( { frameworkcode => "", kohafield => 'items.location' } ) };

     my $ccodes =
     my $ccodes =

-      { map { $_->{authorised_value} => $_->{opac_description} } Koha::AuthorisedValues->get_descriptions_by_koha_field( { frameworkcode => GetFrameworkCode($biblionumber), kohafield => 'items.ccode' } ) };
+      { map { $_->{authorised_value} => $_->{opac_description} } Koha::AuthorisedValues->get_descriptions_by_koha_field( { frameworkcode => "", kohafield => 'items.ccode' } ) };

 
 

-    my %branches = map { $_->branchcode => $_->branchname } Koha::Libraries->search({}, { order_by => 'branchname' });
+    my %branches = map { $_->branchcode => $_->branchname } Koha::Libraries->search({}, { order_by => 'branchname' })->as_list;

 
 

-    my $itemtypes = GetItemTypes();
-    my $location = "";
-    my $ccode = "";
+    my $itemtypes = { map { $_->{itemtype} => $_ } @{ Koha::ItemTypes->search->unblessed } };

     my $xml = '';
     my $xml = '';

-    for my $item (@items) {
-        my $status;
+    my %descs = map { $_->{authorised_value} => $_ } Koha::AuthorisedValues->get_descriptions_by_koha_field( { kohafield => 'items.notforloan' } );
+    my $ref_status = C4::Context->preference('Reference_NFL_Statuses') || '1|2';

 
 

-        my ( $transfertwhen, $transfertfrom, $transfertto ) = C4::Circulation::GetTransfers($item->{itemnumber});
+    while ( my $item = $items->next ) {
+        my $status;
+        my $substatus = '';
+        my $recalls_count;

 
 

-        my $reservestatus = C4::Reserves::GetReserveStatus( $item->{itemnumber} );
+        if ( C4::Context->preference('UseRecalls') ) {
+            $recalls_count = Koha::Recalls->search({ item_id => $item->itemnumber, status => 'waiting' })->count;
+        }

 
 

-        if ( $itemtypes->{ $item->{itype} }->{notforloan} || $item->{notforloan} || $item->{onloan} || $item->{withdrawn} || $item->{itemlost} || $item->{damaged} ||
-             (defined $transfertwhen && $transfertwhen ne '') || $item->{itemnotforloan} || (defined $reservestatus && $reservestatus eq "Waiting") ){ 
-            if ( $item->{notforloan} < 0) {
-                $status = "On order";
-            } 
-            if ( $item->{itemnotforloan} > 0 || $item->{notforloan} > 0 || $itemtypes->{ $item->{itype} }->{notforloan} == 1 ) {
-                $status = "reference";
-            }
-            if ($item->{onloan}) {
-                $status = "Checked out";
-            }
-            if ( $item->{withdrawn}) {
-                $status = "Withdrawn";
-            }
-            if ($item->{itemlost}) {
-                $status = "Lost";
-            }
-            if ($item->{damaged}) {
-                $status = "Damaged"; 
-            }
-            if (defined $transfertwhen && $transfertwhen ne '') {
-                $status = 'In transit';
-            }
-            if (defined $reservestatus && $reservestatus eq "Waiting") {
-                $status = 'Waiting';
-            }
-        } else {
+        if ($recalls_count) {
+            # recalls take priority over holds
+            $status = 'other';
+            $substatus = 'Recall waiting';
+        }
+        elsif ( $item->has_pending_hold ) {
+            $status = 'other';
+            $substatus = 'Pending hold';
+        }
+        elsif ( $item->holds->waiting->count ) {
+            $status = 'other';
+            $substatus = 'Hold waiting';
+        }
+        elsif ($item->get_transfer) {
+            $status = 'other';
+            $substatus = 'In transit';
+        }
+        elsif ($item->damaged) {
+            $status = 'other';
+            $substatus = "Damaged";
+        }
+        elsif ($item->itemlost) {
+            $status = 'other';
+            $substatus = "Lost";
+        }
+        elsif ( $item->withdrawn) {
+            $status = 'other';
+            $substatus = "Withdrawn";
+        }
+        elsif ($item->onloan) {
+            $status = 'other';
+            $substatus = "Checked out";
+        }
+        elsif ( $item->notforloan ) {
+            $status = $item->notforloan =~ /^($ref_status)$/
+                ? "reference"
+                : "reallynotforloan";
+            $substatus = exists $descs{$item->notforloan} ? $descs{$item->notforloan}->{opac_description} : "Not for loan";
+        }
+        elsif ( exists $itemtypes->{ $item->effective_itemtype }
+            && $itemtypes->{ $item->effective_itemtype }->{notforloan}
+            && $itemtypes->{ $item->effective_itemtype }->{notforloan} == 1 )
+        {
+            $status = "1" =~ /^($ref_status)$/
+                ? "reference"
+                : "reallynotforloan";
+            $substatus = "Not for loan";
+        }
+        else {

             $status = "available";
         }
             $status = "available";
         }

-        my $homebranch = $item->{homebranch}? xml_escape($branches{$item->{homebranch}}):'';
-        my $holdingbranch = $item->{holdingbranch}? xml_escape($branches{$item->{holdingbranch}}):'';
-        $location = $item->{location}? xml_escape($shelflocations->{$item->{location}}||$item->{location}):'';
-        $ccode = $item->{ccode}? xml_escape($ccodes->{$item->{ccode}}||$item->{ccode}):'';
-        my $itemcallnumber = xml_escape($item->{itemcallnumber});
-        my $stocknumber = $item->{stocknumber}? xml_escape($item->{stocknumber}):'';
+        my $homebranch     = C4::Koha::xml_escape($branches{$item->homebranch});
+        my $holdingbranch  = C4::Koha::xml_escape($branches{$item->holdingbranch});
+        my $resultbranch   = C4::Context->preference('OPACResultsLibrary') eq 'homebranch' ? $homebranch : $holdingbranch;
+        my $location       = C4::Koha::xml_escape($item->location && exists $shelflocations->{$item->location} ? $shelflocations->{$item->location} : $item->location);
+        my $ccode          = C4::Koha::xml_escape($item->ccode    && exists $ccodes->{$item->ccode}            ? $ccodes->{$item->ccode}            : $item->ccode);
+        my $itemcallnumber = C4::Koha::xml_escape($item->itemcallnumber);
+        my $stocknumber    = C4::Koha::xml_escape($item->stocknumber);

         $xml .=
             "<item>"
           . "<homebranch>$homebranch</homebranch>"
           . "<holdingbranch>$holdingbranch</holdingbranch>"
         $xml .=
             "<item>"
           . "<homebranch>$homebranch</homebranch>"
           . "<holdingbranch>$holdingbranch</holdingbranch>"

+          . "<resultbranch>$resultbranch</resultbranch>"

           . "<location>$location</location>"
           . "<ccode>$ccode</ccode>"
           . "<location>$location</location>"
           . "<ccode>$ccode</ccode>"

-          . "<status>$status</status>"
+          . "<status>".( $status // q{} )."</status>"
+          . "<substatus>$substatus</substatus>"

           . "<itemcallnumber>$itemcallnumber</itemcallnumber>"
           . "<stocknumber>$stocknumber</stocknumber>"
           . "</item>";
           . "<itemcallnumber>$itemcallnumber</itemcallnumber>"
           . "<stocknumber>$stocknumber</stocknumber>"
           . "</item>";