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