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