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