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_Handler;
  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     );
  52     $engine=Koha::XSLT_Handler->new( { do_not_return_source => 1 } );
  53 }
  54
  55 =head1 NAME
  56
  57 C4::XSLT - Functions for displaying XSLT-generated content
  58
  59 =head1 FUNCTIONS
  60
  61 =head2 transformMARCXML4XSLT
  62
  63 Replaces codes with authorized values in a MARC::Record object
  64 Is only used in this module currently.
  65
  66 =cut
  67
  68 sub transformMARCXML4XSLT {
  69     my ($biblionumber, $record) = @_;
  70     my $frameworkcode = GetFrameworkCode($biblionumber) || '';
  71     my $tagslib = &GetMarcStructure(1, $frameworkcode, { unsafe => 1 });
  72     my @fields;
  73     # FIXME: wish there was a better way to handle exceptions
  74     eval {
  75         @fields = $record->fields();
  76     };
  77     if ($@) { warn "PROBLEM WITH RECORD"; next; }
  78     my $marcflavour = C4::Context->preference('marcflavour');
  79     my $av = getAuthorisedValues4MARCSubfields($frameworkcode);
  80     foreach my $tag ( keys %$av ) {
  81         foreach my $field ( $record->field( $tag ) ) {
  82             if ( $av->{ $tag } ) {
  83                 my @new_subfields = ();
  84                 for my $subfield ( $field->subfields() ) {
  85                     my ( $letter, $value ) = @$subfield;
  86                     # Replace the field value with the authorised value *except* for MARC21/NORMARC field 942$n (suppression in opac)
  87                     if ( !( $tag eq '942' && $subfield eq 'n' ) || $marcflavour eq 'UNIMARC' ) {
  88                         $value = GetAuthorisedValueDesc( $tag, $letter, $value, '', $tagslib )
  89                             if $av->{ $tag }->{ $letter };
  90                     }
  91                     push( @new_subfields, $letter, $value );
  92                 }
  93                 $field ->replace_with( MARC::Field->new(
  94                     $tag,
  95                     $field->indicator(1),
  96                     $field->indicator(2),
  97                     @new_subfields
  98                 ) );
  99             }
 100         }
 101     }
 102     return $record;
 103 }
 104
 105 =head2 getAuthorisedValues4MARCSubfields
 106
 107 Returns a ref of hash of ref of hash for tag -> letter controlled by authorised values
 108 Is only used in this module currently.
 109
 110 =cut
 111
 112 sub getAuthorisedValues4MARCSubfields {
 113     my ($frameworkcode) = @_;
 114     unless ( $authval_per_framework{ $frameworkcode } ) {
 115         my $dbh = C4::Context->dbh;
 116         my $sth = $dbh->prepare("SELECT DISTINCT tagfield, tagsubfield
 117                                  FROM marc_subfield_structure
 118                                  WHERE authorised_value IS NOT NULL
 119                                    AND authorised_value!=''
 120                                    AND frameworkcode=?");
 121         $sth->execute( $frameworkcode );
 122         my $av = { };
 123         while ( my ( $tag, $letter ) = $sth->fetchrow() ) {
 124             $av->{ $tag }->{ $letter } = 1;
 125         }
 126         $authval_per_framework{ $frameworkcode } = $av;
 127     }
 128     return $authval_per_framework{ $frameworkcode };
 129 }
 130
 131 =head2 XSLTParse4Display
 132
 133 Returns xml for biblionumber and requested XSLT transformation.
 134 Returns undef if the transform fails.
 135
 136 Used in OPAC results and detail, intranet results and detail, list display.
 137 (Depending on the settings of your XSLT preferences.)
 138
 139 The helper function _get_best_default_xslt_filename is used in a unit test.
 140
 141 =cut
 142
 143 sub _get_best_default_xslt_filename {
 144     my ($htdocs, $theme, $lang, $base_xslfile) = @_;
 145
 146     my @candidates = (
 147         "$htdocs/$theme/$lang/xslt/${base_xslfile}", # exact match
 148         "$htdocs/$theme/en/xslt/${base_xslfile}",    # if not, preferred theme in English
 149         "$htdocs/prog/$lang/xslt/${base_xslfile}",   # if not, 'prog' theme in preferred language
 150         "$htdocs/prog/en/xslt/${base_xslfile}",      # otherwise, prog theme in English; should always
 151                                                      # exist
 152     );
 153     my $xslfilename;
 154     foreach my $filename (@candidates) {
 155         $xslfilename = $filename;
 156         if (-f $filename) {
 157             last; # we have a winner!
 158         }
 159     }
 160     return $xslfilename;
 161 }
 162
 163 sub get_xslt_sysprefs {
 164     my $sysxml = "<sysprefs>\n";
 165     foreach my $syspref ( qw/ hidelostitems OPACURLOpenInNewWindow
 166                               DisplayOPACiconsXSLT URLLinkText viewISBD
 167                               OPACBaseURL TraceCompleteSubfields UseICU
 168                               UseAuthoritiesForTracings TraceSubjectSubdivisions
 169                               Display856uAsImage OPACDisplay856uAsImage
 170                               UseControlNumber IntranetBiblioDefaultView BiblioDefaultView
 171                               OPACItemLocation DisplayIconsXSLT
 172                               AlternateHoldingsField AlternateHoldingsSeparator
 173                               TrackClicks opacthemes IdRef OpacSuppression
 174                               OPACResultsLibrary OPACShowOpenURL
 175                               OpenURLResolverURL OpenURLImageLocation
 176                               OpenURLText / )
 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 XSLTParse4Display {
 193     my ( $biblionumber, $orig_record, $xslsyspref, $fixamps, $hidden_items, $sysxml, $xslfilename, $lang, $variables ) = @_;
 194
 195     $sysxml ||= C4::Context->preference($xslsyspref);
 196     $xslfilename ||= C4::Context->preference($xslsyspref);
 197     $lang ||= C4::Languages::getlanguage();
 198
 199     if ( $xslfilename =~ /^\s*"?default"?\s*$/i ) {
 200         my $htdocs;
 201         my $theme;
 202         my $xslfile;
 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     # grab the XML, run it through our stylesheet, push it out to the browser
 244     my $record = transformMARCXML4XSLT($biblionumber, $orig_record);
 245     my $itemsxml;
 246     if ( $xslsyspref eq "OPACXSLTDetailsDisplay" || $xslsyspref eq "XSLTDetailsDisplay" || $xslsyspref eq "XSLTResultsDisplay" ) {
 247         $itemsxml = ""; #We don't use XSLT for items display on these pages
 248     } else {
 249         $itemsxml = buildKohaItemsNamespace($biblionumber, $hidden_items);
 250     }
 251     my $xmlrecord = $record->as_xml(C4::Context->preference('marcflavour'));
 252
 253     $variables ||= {};
 254     if (C4::Context->preference('OPACShowOpenURL')) {
 255         my @biblio_itemtypes;
 256         my $biblio = Koha::Biblios->find($biblionumber);
 257         if (C4::Context->preference('item-level_itypes')) {
 258             @biblio_itemtypes = $biblio->items->get_column("itype");
 259         } else {
 260             push @biblio_itemtypes, $biblio->itemtype;
 261         }
 262         my @itypes = split( /\s/, C4::Context->preference('OPACOpenURLItemTypes') );
 263         my %original = ();
 264         map { $original{$_} = 1 } @biblio_itemtypes;
 265         if ( grep { $original{$_} } @itypes ) {
 266             $variables->{OpenURLResolverURL} = $biblio->get_openurl;
 267         }
 268     }
 269     my $varxml = "<variables>\n";
 270     while (my ($key, $value) = each %$variables) {
 271         $varxml .= "<variable name=\"$key\">$value</variable>\n";
 272     }
 273     $varxml .= "</variables>\n";
 274
 275     $xmlrecord =~ s/\<\/record\>/$itemsxml$sysxml$varxml\<\/record\>/;
 276     if ($fixamps) { # We need to correct the ampersand entities that Zebra outputs
 277         $xmlrecord =~ s/\&amp;amp;/\&amp;/g;
 278         $xmlrecord =~ s/\&amp\;lt\;/\&lt\;/g;
 279         $xmlrecord =~ s/\&amp\;gt\;/\&gt\;/g;
 280     }
 281     $xmlrecord =~ s/\& /\&amp\; /;
 282     $xmlrecord =~ s/\&amp\;amp\; /\&amp\; /;
 283
 284     #If the xslt should fail, we will return undef (old behavior was
 285     #raw MARC)
 286     #Note that we did set do_not_return_source at object construction
 287     return $engine->transform($xmlrecord, $xslfilename ); #file or URL
 288 }
 289
 290 =head2 buildKohaItemsNamespace
 291
 292 Returns XML for items.
 293 Is only used in this module currently.
 294
 295 =cut
 296
 297 sub buildKohaItemsNamespace {
 298     my ($biblionumber, $hidden_items) = @_;
 299
 300     my @items = C4::Items::GetItemsInfo($biblionumber);
 301     if ($hidden_items && @$hidden_items) {
 302         my %hi = map {$_ => 1} @$hidden_items;
 303         @items = grep { !$hi{$_->{itemnumber}} } @items;
 304     }
 305
 306     my $shelflocations =
 307       { map { $_->{authorised_value} => $_->{opac_description} } Koha::AuthorisedValues->get_descriptions_by_koha_field( { frameworkcode => GetFrameworkCode($biblionumber), kohafield => 'items.location' } ) };
 308     my $ccodes =
 309       { map { $_->{authorised_value} => $_->{opac_description} } Koha::AuthorisedValues->get_descriptions_by_koha_field( { frameworkcode => GetFrameworkCode($biblionumber), kohafield => 'items.ccode' } ) };
 310
 311     my %branches = map { $_->branchcode => $_->branchname } Koha::Libraries->search({}, { order_by => 'branchname' });
 312
 313     my $itemtypes = { map { $_->{itemtype} => $_ } @{ Koha::ItemTypes->search->unblessed } };
 314     my $location = "";
 315     my $ccode = "";
 316     my $xml = '';
 317     for my $item (@items) {
 318         my $status;
 319
 320         my ( $transfertwhen, $transfertfrom, $transfertto ) = C4::Circulation::GetTransfers($item->{itemnumber});
 321
 322         my $reservestatus = C4::Reserves::GetReserveStatus( $item->{itemnumber} );
 323
 324         if ( ( $item->{itype} && $itemtypes->{ $item->{itype} }->{notforloan} ) || $item->{notforloan} || $item->{onloan} || $item->{withdrawn} || $item->{itemlost} || $item->{damaged} ||
 325              (defined $transfertwhen && $transfertwhen ne '') || $item->{itemnotforloan} || (defined $reservestatus && $reservestatus eq "Waiting") || $item->{has_pending_hold} ){
 326             if ( $item->{notforloan} < 0) {
 327                 $status = "On order";
 328             }
 329             if ( $item->{itemnotforloan} && $item->{itemnotforloan} > 0 || $item->{notforloan} && $item->{notforloan} > 0 || $item->{itype} && $itemtypes->{ $item->{itype} }->{notforloan} && $itemtypes->{ $item->{itype} }->{notforloan} == 1 ) {
 330                 $status = "reference";
 331             }
 332             if ($item->{onloan}) {
 333                 $status = "Checked out";
 334             }
 335             if ( $item->{withdrawn}) {
 336                 $status = "Withdrawn";
 337             }
 338             if ($item->{itemlost}) {
 339                 $status = "Lost";
 340             }
 341             if ($item->{damaged}) {
 342                 $status = "Damaged";
 343             }
 344             if (defined $transfertwhen && $transfertwhen ne '') {
 345                 $status = 'In transit';
 346             }
 347             if (defined $reservestatus && $reservestatus eq "Waiting") {
 348                 $status = 'Waiting';
 349             }
 350             if ($item->{has_pending_hold}) {
 351                 $status = 'Pending hold';
 352             }
 353         } else {
 354             $status = "available";
 355         }
 356         my $homebranch = $item->{homebranch}? xml_escape($branches{$item->{homebranch}}):'';
 357         my $holdingbranch = $item->{holdingbranch}? xml_escape($branches{$item->{holdingbranch}}):'';
 358         $location = $item->{location}? xml_escape($shelflocations->{$item->{location}}||$item->{location}):'';
 359         $ccode = $item->{ccode}? xml_escape($ccodes->{$item->{ccode}}||$item->{ccode}):'';
 360         my $itemcallnumber = xml_escape($item->{itemcallnumber});
 361         my $stocknumber = $item->{stocknumber}? xml_escape($item->{stocknumber}):'';
 362         $xml .=
 363             "<item>"
 364           . "<homebranch>$homebranch</homebranch>"
 365           . "<holdingbranch>$holdingbranch</holdingbranch>"
 366           . "<location>$location</location>"
 367           . "<ccode>$ccode</ccode>"
 368           . "<status>".( $status // q{} )."</status>"
 369           . "<itemcallnumber>$itemcallnumber</itemcallnumber>"
 370           . "<stocknumber>$stocknumber</stocknumber>"
 371           . "</item>";
 372     }
 373     $xml = "<items xmlns=\"http://www.koha-community.org/items\">".$xml."</items>";
 374     return $xml;
 375 }
 376
 377 =head2 engine
 378
 379 Returns reference to XSLT handler object.
 380
 381 =cut
 382
 383 sub engine {
 384     return $engine;
 385 }
 386
 387 1;
 388
 389 __END__
 390
 391 =head1 AUTHOR
 392
 393 Joshua Ferraro <jmf@liblime.com>
 394
 395 Koha Development Team <http://koha-community.org/>
 396
 397 =cut