C4/XSLT.pm

   1 package C4::XSLT;
   2
   3 # Copyright (C) 2006 LibLime
   4 # <jmf at liblime dot com>
   5 # Parts Copyright Katrin Fischer 2011
   6 # Parts Copyright ByWater Solutions 2011
   7 # Parts Copyright Biblibre 2012
   8 #
   9 # This file is part of Koha.
  10 #
  11 # Koha is free software; you can redistribute it and/or modify it
  12 # under the terms of the GNU General Public License as published by
  13 # the Free Software Foundation; either version 3 of the License, or
  14 # (at your option) any later version.
  15 #
  16 # Koha is distributed in the hope that it will be useful, but
  17 # WITHOUT ANY WARRANTY; without even the implied warranty of
  18 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  19 # GNU General Public License for more details.
  20 #
  21 # You should have received a copy of the GNU General Public License
  22 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  23
  24 use Modern::Perl;
  25
  26 use C4::Context;
  27 use C4::Koha qw( xml_escape );
  28 use C4::Biblio qw( GetAuthorisedValueDesc GetFrameworkCode GetMarcStructure );
  29 use Koha::AuthorisedValues;
  30 use Koha::ItemTypes;
  31 use Koha::XSLT::Base;
  32 use Koha::Libraries;
  33 use Koha::Recalls;
  34
  35 my $engine; #XSLT Handler object
  36 my %authval_per_framework;
  37     # Cache for tagfield-tagsubfield to decode per framework.
  38     # Should be preferably be placed in Koha-core...
  39
  40 our (@ISA, @EXPORT_OK);
  41 BEGIN {
  42     require Exporter;
  43     @ISA = qw(Exporter);
  44     @EXPORT_OK = qw(
  45         transformMARCXML4XSLT
  46         getAuthorisedValues4MARCSubfields
  47         buildKohaItemsNamespace
  48         XSLTParse4Display
  49     );
  50     $engine=Koha::XSLT::Base->new( { do_not_return_source => 1 } );
  51 }
  52
  53 =head1 NAME
  54
  55 C4::XSLT - Functions for displaying XSLT-generated content
  56
  57 =head1 FUNCTIONS
  58
  59 =head2 transformMARCXML4XSLT
  60
  61 Replaces codes with authorized values in a MARC::Record object
  62
  63 =cut
  64
  65 sub transformMARCXML4XSLT {
  66     my ($biblionumber, $record, $opac, $branches, $itemtypes, $av) = @_;
  67     my $frameworkcode = GetFrameworkCode($biblionumber) || '';
  68     my $tagslib = &GetMarcStructure(1, $frameworkcode, { unsafe => 1 });
  69     my @fields;
  70     # FIXME: wish there was a better way to handle exceptions
  71     eval {
  72         @fields = $record->fields();
  73     };
  74     if ($@) { warn "PROBLEM WITH RECORD"; next; }
  75     my $marcflavour = C4::Context->preference('marcflavour');
  76     foreach my $tag ( keys %$av ) {
  77         foreach my $field ( $record->field( $tag ) ) {
  78             if ( defined $av->{ $tag } ) {
  79                 my @new_subfields = ();
  80                 my $updated = 0;
  81                 for my $subfield ( $field->subfields() ) {
  82                     my ( $letter, $value ) = @$subfield;
  83                     if( defined $av->{ $tag }->{ $letter } ){
  84                         my $category = $av->{$tag}->{$letter}->{category};
  85                         # Replace the field value with the authorised value *except* for MARC21/NORMARC field 942$n (suppression in opac)
  86                         if( $category eq 'branches' ){
  87                             $value = defined $branches->{$value} ? $branches->{$value}: q{} ;
  88                             $updated = 1;
  89                         }
  90                         elsif( $category eq 'itemtypes' ){
  91                             $value = defined $itemtypes->{$value}->{translated_description} ? $itemtypes->{$value}->{translated_description} : q{};
  92                             $updated = 1;
  93                         }
  94                         elsif ( !( $tag eq '942' && $subfield->[0] eq 'n' ) || $marcflavour eq 'UNIMARC' ) {
  95                             my $desc_field = $opac ? "lib_opac" : "lib";
  96                             if ( defined $av->{$tag}->{$letter}->{$category}->{$value}->{$desc_field} ) {
  97                                 $value = $av->{$tag}->{$letter}->{$category}->{$value}->{$desc_field} || $value;
  98                                 $updated = 1;
  99                             }
 100                         }
 101                     }
 102                     push( @new_subfields, $letter, $value );
 103                 }
 104                 $field ->replace_with( MARC::Field->new(
 105                     $tag,
 106                     $field->indicator(1),
 107                     $field->indicator(2),
 108                     @new_subfields
 109                 ) ) if $updated;
 110             }
 111         }
 112     }
 113     return $record;
 114 }
 115
 116 =head2 getAuthorisedValues4MARCSubfields
 117
 118 Returns a ref of hash of ref of hash for tag -> letter controlled by authorised values
 119 Is only used in this module currently.
 120
 121 =cut
 122
 123 sub getAuthorisedValues4MARCSubfields {
 124     my ($frameworkcode) = @_;
 125     unless ( $authval_per_framework{ $frameworkcode } ) {
 126         my $dbh = C4::Context->dbh;
 127         my $sth = $dbh->prepare("SELECT DISTINCT tagfield, tagsubfield, authorised_value
 128                                  FROM marc_subfield_structure
 129                                  WHERE authorised_value IS NOT NULL
 130                                    AND authorised_value!=''
 131                                    AND frameworkcode=?");
 132         $sth->execute( $frameworkcode );
 133         my $av = { };
 134         while ( my ( $tag, $letter, $category ) = $sth->fetchrow() ) {
 135             my $authorised_values = { map { $_->{authorised_value} => $_ } @{ Koha::AuthorisedValues->search({ category => $category })->unblessed } };
 136             $av->{ $tag }->{ $letter }->{category} = $category;
 137             $av->{ $tag }->{ $letter }->{$category} = $authorised_values unless ( $category eq 'itemtypes' || $category eq 'branches' );
 138         }
 139         $authval_per_framework{ $frameworkcode } = $av;
 140     }
 141     return $authval_per_framework{ $frameworkcode };
 142 }
 143
 144 =head2 XSLTParse4Display
 145
 146 Returns xml for biblionumber and requested XSLT transformation.
 147 Returns undef if the transform fails.
 148
 149 Used in OPAC results and detail, intranet results and detail, list display.
 150 (Depending on the settings of your XSLT preferences.)
 151
 152 The helper function _get_best_default_xslt_filename is used in a unit test.
 153
 154 =cut
 155
 156 sub _get_best_default_xslt_filename {
 157     my ($htdocs, $theme, $lang, $base_xslfile) = @_;
 158
 159     my @candidates = (
 160         "$htdocs/$theme/$lang/xslt/${base_xslfile}", # exact match
 161         "$htdocs/$theme/en/xslt/${base_xslfile}",    # if not, preferred theme in English
 162         "$htdocs/prog/$lang/xslt/${base_xslfile}",   # if not, 'prog' theme in preferred language
 163         "$htdocs/prog/en/xslt/${base_xslfile}",      # otherwise, prog theme in English; should always
 164                                                      # exist
 165     );
 166     my $xslfilename;
 167     foreach my $filename (@candidates) {
 168         $xslfilename = $filename;
 169         if (-f $filename) {
 170             last; # we have a winner!
 171         }
 172     }
 173     return $xslfilename;
 174 }
 175
 176 sub get_xslt_sysprefs {
 177     my $sysxml = "<sysprefs>\n";
 178     foreach my $syspref ( qw/ hidelostitems OPACURLOpenInNewWindow
 179                               DisplayOPACiconsXSLT URLLinkText viewISBD
 180                               OPACBaseURL TraceCompleteSubfields UseICUStyleQuotes
 181                               UseAuthoritiesForTracings TraceSubjectSubdivisions
 182                               Display856uAsImage OPACDisplay856uAsImage
 183                               UseControlNumber IntranetBiblioDefaultView BiblioDefaultView
 184                               OPACItemLocation DisplayIconsXSLT
 185                               AlternateHoldingsField AlternateHoldingsSeparator
 186                               TrackClicks opacthemes IdRef OpacSuppression
 187                               OPACResultsLibrary OPACShowOpenURL
 188                               OpenURLResolverURL OpenURLImageLocation
 189                               OPACResultsMaxItems OPACResultsMaxItemsUnavailable OPACResultsUnavailableGroupingBy
 190                               OpenURLText OPACShowMusicalInscripts OPACPlayMusicalInscripts / )
 191     {
 192         my $sp = C4::Context->preference( $syspref );
 193         next unless defined($sp);
 194         $sysxml .= "<syspref name=\"$syspref\">$sp</syspref>\n";
 195     }
 196
 197     # singleBranchMode was a system preference, but no longer is
 198     # we can retain it here for compatibility
 199     my $singleBranchMode = Koha::Libraries->search->count == 1 ? 1 : 0;
 200     $sysxml .= "<syspref name=\"singleBranchMode\">$singleBranchMode</syspref>\n";
 201
 202     $sysxml .= "</sysprefs>\n";
 203     return $sysxml;
 204 }
 205
 206 sub get_xsl_filename {
 207     my ( $xslsyspref ) = @_;
 208
 209     my $lang   = C4::Languages::getlanguage();
 210
 211     my $xslfilename = C4::Context->preference($xslsyspref) || "default";
 212
 213     if ( $xslfilename =~ /^\s*"?default"?\s*$/i ) {
 214
 215         my ( $htdocs, $theme, $xslfile );
 216
 217         if ($xslsyspref eq "XSLTDetailsDisplay") {
 218             $htdocs  = C4::Context->config('intrahtdocs');
 219             $theme   = C4::Context->preference("template");
 220             $xslfile = C4::Context->preference('marcflavour') .
 221                        "slim2intranetDetail.xsl";
 222         } elsif ($xslsyspref eq "XSLTResultsDisplay") {
 223             $htdocs  = C4::Context->config('intrahtdocs');
 224             $theme   = C4::Context->preference("template");
 225             $xslfile = C4::Context->preference('marcflavour') .
 226                         "slim2intranetResults.xsl";
 227         } elsif ($xslsyspref eq "OPACXSLTDetailsDisplay") {
 228             $htdocs  = C4::Context->config('opachtdocs');
 229             $theme   = C4::Context->preference("opacthemes");
 230             $xslfile = C4::Context->preference('marcflavour') .
 231                        "slim2OPACDetail.xsl";
 232         } elsif ($xslsyspref eq "OPACXSLTResultsDisplay") {
 233             $htdocs  = C4::Context->config('opachtdocs');
 234             $theme   = C4::Context->preference("opacthemes");
 235             $xslfile = C4::Context->preference('marcflavour') .
 236                        "slim2OPACResults.xsl";
 237         } elsif ($xslsyspref eq 'XSLTListsDisplay') {
 238             # Lists default to *Results.xslt
 239             $htdocs  = C4::Context->config('intrahtdocs');
 240             $theme   = C4::Context->preference("template");
 241             $xslfile = C4::Context->preference('marcflavour') .
 242                         "slim2intranetResults.xsl";
 243         } elsif ($xslsyspref eq 'OPACXSLTListsDisplay') {
 244             # Lists default to *Results.xslt
 245             $htdocs  = C4::Context->config('opachtdocs');
 246             $theme   = C4::Context->preference("opacthemes");
 247             $xslfile = C4::Context->preference('marcflavour') .
 248                        "slim2OPACResults.xsl";
 249         }
 250         $xslfilename = _get_best_default_xslt_filename($htdocs, $theme, $lang, $xslfile);
 251     }
 252
 253     if ( $xslfilename =~ m/\{langcode\}/ ) {
 254         $xslfilename =~ s/\{langcode\}/$lang/;
 255     }
 256
 257     return $xslfilename;
 258 }
 259
 260 sub XSLTParse4Display {
 261     my ( $params ) = @_;
 262
 263     my $biblionumber = $params->{biblionumber};
 264     my $orig_record  = $params->{record};
 265     my $xslsyspref   = $params->{xsl_syspref};
 266     my $fixamps      = $params->{fix_amps};
 267     my $hidden_items = $params->{hidden_items} || [];
 268     my $variables    = $params->{xslt_variables};
 269     my $items_rs     = $params->{items_rs};
 270     my $branches     = $params->{branches};
 271     my $itemtypes    = $params->{itemtypes};
 272
 273     $branches = { map { $_->branchcode => $_->branchname } Koha::Libraries->search({}, { order_by => 'branchname' })->as_list } unless $branches;
 274     $itemtypes = { map { $_->{itemtype} => $_ } @{ Koha::ItemTypes->search_with_localization->unblessed } } unless $itemtypes;
 275
 276     die "Mandatory \$params->{xsl_syspref} was not provided, called with biblionumber $params->{biblionumber}"
 277         if not defined $params->{xsl_syspref};
 278
 279     my $xslfilename = get_xsl_filename( $xslsyspref);
 280
 281     # grab the XML, run it through our stylesheet, push it out to the browser
 282     my $authorised_values = getAuthorisedValues4MARCSubfields("");
 283     my $record = transformMARCXML4XSLT($biblionumber, $orig_record, undef, $branches, $itemtypes, $authorised_values );
 284     my $itemsxml;
 285     if ( $xslsyspref eq "OPACXSLTDetailsDisplay" || $xslsyspref eq "XSLTDetailsDisplay" || $xslsyspref eq "XSLTResultsDisplay" ) {
 286         $itemsxml = ""; #We don't use XSLT for items display on these pages
 287     } else {
 288         $itemsxml = buildKohaItemsNamespace($biblionumber, $hidden_items, $items_rs, $branches, $itemtypes);
 289     }
 290     my $xmlrecord = $record->as_xml(C4::Context->preference('marcflavour'));
 291
 292     $variables ||= {};
 293     my $biblio;
 294     if (C4::Context->preference('OPACShowOpenURL')) {
 295         my @biblio_itemtypes;
 296         $biblio //= Koha::Biblios->find($biblionumber);
 297         if (C4::Context->preference('item-level_itypes')) {
 298             @biblio_itemtypes = $biblio->items->get_column("itype");
 299         } else {
 300             push @biblio_itemtypes, $biblio->itemtype;
 301         }
 302         my @itypes = split( /\s/, C4::Context->preference('OPACOpenURLItemTypes') );
 303         my %original = ();
 304         map { $original{$_} = 1 } @biblio_itemtypes;
 305         if ( grep { $original{$_} } @itypes ) {
 306             $variables->{OpenURLResolverURL} = $biblio->get_openurl;
 307         }
 308     }
 309
 310     my $varxml = "<variables>\n";
 311     while (my ($key, $value) = each %$variables) {
 312         $value //= q{};
 313         $varxml .= "<variable name=\"$key\">$value</variable>\n";
 314     }
 315     $varxml .= "</variables>\n";
 316
 317     my $sysxml = get_xslt_sysprefs();
 318     $xmlrecord =~ s/\<\/record\>/$itemsxml$sysxml$varxml\<\/record\>/;
 319     if ($fixamps) { # We need to correct the ampersand entities that Zebra outputs
 320         $xmlrecord =~ s/\&amp;amp;/\&amp;/g;
 321         $xmlrecord =~ s/\&amp\;lt\;/\&lt\;/g;
 322         $xmlrecord =~ s/\&amp\;gt\;/\&gt\;/g;
 323     }
 324     $xmlrecord =~ s/\& /\&amp\; /;
 325     $xmlrecord =~ s/\&amp\;amp\; /\&amp\; /;
 326
 327     #If the xslt should fail, we will return undef (old behavior was
 328     #raw MARC)
 329     #Note that we did set do_not_return_source at object construction
 330     return $engine->transform($xmlrecord, $xslfilename ); #file or URL
 331 }
 332
 333 =head2 buildKohaItemsNamespace
 334
 335     my $items_xml = buildKohaItemsNamespace( $biblionumber, [ $hidden_items, $items ] );
 336
 337 Returns XML for items. It accepts two optional parameters:
 338 - I<$hidden_items>: An arrayref of itemnumber values, for items that should be hidden
 339 - I<$items>: A Koha::Items resultset, for the items to be returned
 340
 341 If both parameters are passed, I<$items> is used as the basis resultset, and I<$hidden_items>
 342 are filtered out of it.
 343
 344 Is only used in this module currently.
 345
 346 =cut
 347
 348 sub buildKohaItemsNamespace {
 349     my ($biblionumber, $hidden_items, $items_rs, $branches, $itemtypes) = @_;
 350
 351     $hidden_items ||= [];
 352
 353     my $query = {};
 354     $query = { 'me.itemnumber' => { not_in => $hidden_items } }
 355       if $hidden_items;
 356
 357     unless ( $items_rs && ref($items_rs) eq 'Koha::Items' ) {
 358         $query->{'me.biblionumber'} = $biblionumber;
 359         $items_rs = Koha::Items->new;
 360     }
 361
 362     my $items = $items_rs->search( $query, { prefetch => [ 'branchtransfers', 'reserves' ] } );
 363
 364     my $shelflocations =
 365       { map { $_->{authorised_value} => $_->{opac_description} } Koha::AuthorisedValues->get_descriptions_by_koha_field( { frameworkcode => "", kohafield => 'items.location' } ) };
 366     my $ccodes =
 367       { map { $_->{authorised_value} => $_->{opac_description} } Koha::AuthorisedValues->get_descriptions_by_koha_field( { frameworkcode => "", kohafield => 'items.ccode' } ) };
 368
 369     my $xml = '';
 370     my %descs = map { $_->{authorised_value} => $_ } Koha::AuthorisedValues->get_descriptions_by_koha_field( { kohafield => 'items.notforloan' } );
 371     my $ref_status = C4::Context->preference('Reference_NFL_Statuses') || '1|2';
 372
 373     while ( my $item = $items->next ) {
 374         my $status;
 375         my $substatus = '';
 376         my $recalls_count;
 377
 378         if ( C4::Context->preference('UseRecalls') ) {
 379             $recalls_count = Koha::Recalls->search({ itemnumber => $item->itemnumber, status => 'waiting' })->count;
 380         }
 381
 382         if ($recalls_count) {
 383             # recalls take priority over holds
 384             $status = 'other';
 385             $substatus = 'Recall waiting';
 386         }
 387         elsif ( $item->has_pending_hold ) {
 388             $status = 'other';
 389             $substatus = 'Pending hold';
 390         }
 391         elsif ( $item->holds->waiting->count ) {
 392             $status = 'other';
 393             $substatus = 'Hold waiting';
 394         }
 395         elsif ($item->get_transfer) {
 396             $status = 'other';
 397             $substatus = 'In transit';
 398         }
 399         elsif ($item->damaged) {
 400             $status = 'other';
 401             $substatus = "Damaged";
 402         }
 403         elsif ($item->itemlost) {
 404             $status = 'other';
 405             $substatus = "Lost";
 406         }
 407         elsif ( $item->withdrawn) {
 408             $status = 'other';
 409             $substatus = "Withdrawn";
 410         }
 411         elsif ($item->onloan) {
 412             $status = 'other';
 413             $substatus = "Checked out";
 414         }
 415         elsif ( $item->notforloan ) {
 416             $status = $item->notforloan =~ /^($ref_status)$/
 417                 ? "reference"
 418                 : "reallynotforloan";
 419             $substatus = exists $descs{$item->notforloan} ? $descs{$item->notforloan}->{opac_description} : "Not for loan";
 420         }
 421         elsif ( exists $itemtypes->{ $item->effective_itemtype }
 422             && $itemtypes->{ $item->effective_itemtype }->{notforloan}
 423             && $itemtypes->{ $item->effective_itemtype }->{notforloan} == 1 )
 424         {
 425             $status = "1" =~ /^($ref_status)$/
 426                 ? "reference"
 427                 : "reallynotforloan";
 428             $substatus = "Not for loan";
 429         }
 430         else {
 431             $status = "available";
 432         }
 433         my $homebranch     = C4::Koha::xml_escape($branches->{$item->homebranch});
 434         my $holdingbranch  = C4::Koha::xml_escape($branches->{$item->holdingbranch});
 435         my $resultbranch   = C4::Context->preference('OPACResultsLibrary') eq 'homebranch' ? $homebranch : $holdingbranch;
 436         my $location       = C4::Koha::xml_escape($item->location && exists $shelflocations->{$item->location} ? $shelflocations->{$item->location} : $item->location);
 437         my $ccode          = C4::Koha::xml_escape($item->ccode    && exists $ccodes->{$item->ccode}            ? $ccodes->{$item->ccode}            : $item->ccode);
 438         my $itemcallnumber = C4::Koha::xml_escape($item->itemcallnumber);
 439         my $stocknumber    = C4::Koha::xml_escape($item->stocknumber);
 440         $xml .=
 441             "<item>"
 442           . "<homebranch>$homebranch</homebranch>"
 443           . "<holdingbranch>$holdingbranch</holdingbranch>"
 444           . "<resultbranch>$resultbranch</resultbranch>"
 445           . "<location>$location</location>"
 446           . "<ccode>$ccode</ccode>"
 447           . "<status>".( $status // q{} )."</status>"
 448           . "<substatus>$substatus</substatus>"
 449           . "<itemcallnumber>$itemcallnumber</itemcallnumber>"
 450           . "<stocknumber>$stocknumber</stocknumber>"
 451           . "</item>";
 452     }
 453     $xml = "<items xmlns=\"http://www.koha-community.org/items\">".$xml."</items>";
 454     return $xml;
 455 }
 456
 457 =head2 engine
 458
 459 Returns reference to XSLT handler object.
 460
 461 =cut
 462
 463 sub engine {
 464     return $engine;
 465 }
 466
 467 1;
 468
 469 __END__
 470
 471 =head1 AUTHOR
 472
 473 Joshua Ferraro <jmf@liblime.com>
 474
 475 Koha Development Team <http://koha-community.org/>
 476
 477 =cut