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         $value //= q{};
 273         $varxml .= "<variable name=\"$key\">$value</variable>\n";
 274     }
 275     $varxml .= "</variables>\n";
 276
 277     $xmlrecord =~ s/\<\/record\>/$itemsxml$sysxml$varxml\<\/record\>/;
 278     if ($fixamps) { # We need to correct the ampersand entities that Zebra outputs
 279         $xmlrecord =~ s/\&amp;amp;/\&amp;/g;
 280         $xmlrecord =~ s/\&amp\;lt\;/\&lt\;/g;
 281         $xmlrecord =~ s/\&amp\;gt\;/\&gt\;/g;
 282     }
 283     $xmlrecord =~ s/\& /\&amp\; /;
 284     $xmlrecord =~ s/\&amp\;amp\; /\&amp\; /;
 285
 286     #If the xslt should fail, we will return undef (old behavior was
 287     #raw MARC)
 288     #Note that we did set do_not_return_source at object construction
 289     return $engine->transform($xmlrecord, $xslfilename ); #file or URL
 290 }
 291
 292 =head2 buildKohaItemsNamespace
 293
 294     my $items_xml = buildKohaItemsNamespace( $biblionumber, [ $hidden_items, $items ] );
 295
 296 Returns XML for items. It accepts two optional parameters:
 297 - I<$hidden_items>: An arrayref of itemnumber values, for items that should be hidden
 298 - I<$items>: A Koha::Items resultset, for the items to be returned
 299
 300 If both parameters are passed, I<$items> is used as the basis resultset, and I<$hidden_items>
 301 are filtered out of it.
 302
 303 Is only used in this module currently.
 304
 305 =cut
 306
 307 sub buildKohaItemsNamespace {
 308     my ($biblionumber, $hidden_items, $items_rs) = @_;
 309
 310     $hidden_items ||= [];
 311
 312     my $query = {};
 313     $query = { 'me.itemnumber' => { not_in => $hidden_items } }
 314       if $hidden_items;
 315
 316     unless ( $items_rs && ref($items_rs) eq 'Koha::Items' ) {
 317         $query->{'me.biblionumber'} = $biblionumber;
 318         $items_rs = Koha::Items->new;
 319     }
 320
 321     my $items = $items_rs->search( $query, { prefetch => [ 'branchtransfers', 'reserves' ] } );
 322
 323     my $shelflocations =
 324       { map { $_->{authorised_value} => $_->{opac_description} } Koha::AuthorisedValues->get_descriptions_by_koha_field( { frameworkcode => "", kohafield => 'items.location' } ) };
 325     my $ccodes =
 326       { map { $_->{authorised_value} => $_->{opac_description} } Koha::AuthorisedValues->get_descriptions_by_koha_field( { frameworkcode => "", kohafield => 'items.ccode' } ) };
 327
 328     my %branches = map { $_->branchcode => $_->branchname } Koha::Libraries->search({}, { order_by => 'branchname' });
 329
 330     my $itemtypes = { map { $_->{itemtype} => $_ } @{ Koha::ItemTypes->search->unblessed } };
 331     my $xml = '';
 332     my %descs = map { $_->{authorised_value} => $_ } Koha::AuthorisedValues->get_descriptions_by_koha_field( { kohafield => 'items.notforloan' } );
 333     my $ref_status = C4::Context->preference('Reference_NFL_Statuses') || '1|2';
 334
 335     while ( my $item = $items->next ) {
 336         my $status;
 337         my $substatus = '';
 338
 339         if ($item->has_pending_hold) {
 340             $status = 'Pending hold';
 341         }
 342         elsif ( $item->holds->waiting->count ) {
 343             $status = 'Waiting';
 344         }
 345         elsif ($item->get_transfer) {
 346             $status = 'In transit';
 347         }
 348         elsif ($item->damaged) {
 349             $status = "Damaged";
 350         }
 351         elsif ($item->itemlost) {
 352             $status = "Lost";
 353         }
 354         elsif ( $item->withdrawn) {
 355             $status = "Withdrawn";
 356         }
 357         elsif ($item->onloan) {
 358             $status = "Checked out";
 359         }
 360         elsif ( $item->notforloan ) {
 361             $status = $item->notforloan =~ /^($ref_status)$/
 362                 ? "reference"
 363                 : "reallynotforloan";
 364             $substatus = exists $descs{$item->notforloan} ? $descs{$item->notforloan}->{opac_description} : "Not for loan";
 365         }
 366         elsif ( exists $itemtypes->{ $item->effective_itemtype }
 367             && $itemtypes->{ $item->effective_itemtype }->{notforloan}
 368             && $itemtypes->{ $item->effective_itemtype }->{notforloan} == 1 )
 369         {
 370             $status = "1" =~ /^($ref_status)$/
 371                 ? "reference"
 372                 : "reallynotforloan";
 373             $substatus = "Not for loan";
 374         }
 375         else {
 376             $status = "available";
 377         }
 378         my $homebranch     = xml_escape($branches{$item->homebranch});
 379         my $holdingbranch  = xml_escape($branches{$item->holdingbranch});
 380         my $location       = xml_escape($item->location && exists $shelflocations->{$item->location} ? $shelflocations->{$item->location} : $item->location);
 381         my $ccode          = xml_escape($item->ccode    && exists $ccodes->{$item->ccode}            ? $ccodes->{$item->ccode}            : $item->ccode);
 382         my $itemcallnumber = xml_escape($item->itemcallnumber);
 383         my $stocknumber    = xml_escape($item->stocknumber);
 384         $xml .=
 385             "<item>"
 386           . "<homebranch>$homebranch</homebranch>"
 387           . "<holdingbranch>$holdingbranch</holdingbranch>"
 388           . "<location>$location</location>"
 389           . "<ccode>$ccode</ccode>"
 390           . "<status>".( $status // q{} )."</status>"
 391           . "<substatus>$substatus</substatus>"
 392           . "<itemcallnumber>$itemcallnumber</itemcallnumber>"
 393           . "<stocknumber>$stocknumber</stocknumber>"
 394           . "</item>";
 395     }
 396     $xml = "<items xmlns=\"http://www.koha-community.org/items\">".$xml."</items>";
 397     return $xml;
 398 }
 399
 400 =head2 engine
 401
 402 Returns reference to XSLT handler object.
 403
 404 =cut
 405
 406 sub engine {
 407     return $engine;
 408 }
 409
 410 1;
 411
 412 __END__
 413
 414 =head1 AUTHOR
 415
 416 Joshua Ferraro <jmf@liblime.com>
 417
 418 Koha Development Team <http://koha-community.org/>
 419
 420 =cut