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