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::XSLT_Handler;
  33 use Koha::Libraries;
  34
  35 use Encode;
  36
  37 use vars qw(@ISA @EXPORT);
  38
  39 my $engine; #XSLT Handler object
  40 my %authval_per_framework;
  41     # Cache for tagfield-tagsubfield to decode per framework.
  42     # Should be preferably be placed in Koha-core...
  43
  44 BEGIN {
  45     require Exporter;
  46     @ISA = qw(Exporter);
  47     @EXPORT = qw(
  48         &XSLTParse4Display
  49     );
  50     $engine=Koha::XSLT_Handler->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 Is only used in this module currently.
  63
  64 =cut
  65
  66 sub transformMARCXML4XSLT {
  67     my ($biblionumber, $record) = @_;
  68     my $frameworkcode = GetFrameworkCode($biblionumber) || '';
  69     my $tagslib = &GetMarcStructure(1, $frameworkcode, { unsafe => 1 });
  70     my @fields;
  71     # FIXME: wish there was a better way to handle exceptions
  72     eval {
  73         @fields = $record->fields();
  74     };
  75     if ($@) { warn "PROBLEM WITH RECORD"; next; }
  76     my $marcflavour = C4::Context->preference('marcflavour');
  77     my $av = getAuthorisedValues4MARCSubfields($frameworkcode);
  78     foreach my $tag ( keys %$av ) {
  79         foreach my $field ( $record->field( $tag ) ) {
  80             if ( $av->{ $tag } ) {
  81                 my @new_subfields = ();
  82                 for my $subfield ( $field->subfields() ) {
  83                     my ( $letter, $value ) = @$subfield;
  84                     # Replace the field value with the authorised value *except* for MARC21/NORMARC field 942$n (suppression in opac)
  85                     if ( !( $tag eq '942' && $subfield eq 'n' ) || $marcflavour eq 'UNIMARC' ) {
  86                         $value = GetAuthorisedValueDesc( $tag, $letter, $value, '', $tagslib )
  87                             if $av->{ $tag }->{ $letter };
  88                     }
  89                     push( @new_subfields, $letter, $value );
  90                 }
  91                 $field ->replace_with( MARC::Field->new(
  92                     $tag,
  93                     $field->indicator(1),
  94                     $field->indicator(2),
  95                     @new_subfields
  96                 ) );
  97             }
  98         }
  99     }
 100     return $record;
 101 }
 102
 103 =head2 getAuthorisedValues4MARCSubfields
 104
 105 Returns a ref of hash of ref of hash for tag -> letter controlled by authorised values
 106 Is only used in this module currently.
 107
 108 =cut
 109
 110 sub getAuthorisedValues4MARCSubfields {
 111     my ($frameworkcode) = @_;
 112     unless ( $authval_per_framework{ $frameworkcode } ) {
 113         my $dbh = C4::Context->dbh;
 114         my $sth = $dbh->prepare("SELECT DISTINCT tagfield, tagsubfield
 115                                  FROM marc_subfield_structure
 116                                  WHERE authorised_value IS NOT NULL
 117                                    AND authorised_value!=''
 118                                    AND frameworkcode=?");
 119         $sth->execute( $frameworkcode );
 120         my $av = { };
 121         while ( my ( $tag, $letter ) = $sth->fetchrow() ) {
 122             $av->{ $tag }->{ $letter } = 1;
 123         }
 124         $authval_per_framework{ $frameworkcode } = $av;
 125     }
 126     return $authval_per_framework{ $frameworkcode };
 127 }
 128
 129 =head2 XSLTParse4Display
 130
 131 Returns xml for biblionumber and requested XSLT transformation.
 132 Returns undef if the transform fails.
 133
 134 Used in OPAC results and detail, intranet results and detail, list display.
 135 (Depending on the settings of your XSLT preferences.)
 136
 137 The helper function _get_best_default_xslt_filename is used in a unit test.
 138
 139 =cut
 140
 141 sub _get_best_default_xslt_filename {
 142     my ($htdocs, $theme, $lang, $base_xslfile) = @_;
 143
 144     my @candidates = (
 145         "$htdocs/$theme/$lang/xslt/${base_xslfile}", # exact match
 146         "$htdocs/$theme/en/xslt/${base_xslfile}",    # if not, preferred theme in English
 147         "$htdocs/prog/$lang/xslt/${base_xslfile}",   # if not, 'prog' theme in preferred language
 148         "$htdocs/prog/en/xslt/${base_xslfile}",      # otherwise, prog theme in English; should always
 149                                                      # exist
 150     );
 151     my $xslfilename;
 152     foreach my $filename (@candidates) {
 153         $xslfilename = $filename;
 154         if (-f $filename) {
 155             last; # we have a winner!
 156         }
 157     }
 158     return $xslfilename;
 159 }
 160
 161 sub get_xslt_sysprefs {
 162     my $sysxml = "<sysprefs>\n";
 163     foreach my $syspref ( qw/ hidelostitems OPACURLOpenInNewWindow
 164                               DisplayOPACiconsXSLT URLLinkText viewISBD
 165                               OPACBaseURL TraceCompleteSubfields UseICU
 166                               UseAuthoritiesForTracings TraceSubjectSubdivisions
 167                               Display856uAsImage OPACDisplay856uAsImage
 168                               UseControlNumber IntranetBiblioDefaultView BiblioDefaultView
 169                               OPACItemLocation DisplayIconsXSLT
 170                               AlternateHoldingsField AlternateHoldingsSeparator
 171                               TrackClicks opacthemes IdRef OpacSuppression
 172                               OPACResultsLibrary / )
 173     {
 174         my $sp = C4::Context->preference( $syspref );
 175         next unless defined($sp);
 176         $sysxml .= "<syspref name=\"$syspref\">$sp</syspref>\n";
 177     }
 178
 179     # singleBranchMode was a system preference, but no longer is
 180     # we can retain it here for compatibility
 181     my $singleBranchMode = Koha::Libraries->search->count == 1;
 182     $sysxml .= "<syspref name=\"singleBranchMode\">$singleBranchMode</syspref>\n";
 183
 184     $sysxml .= "</sysprefs>\n";
 185     return $sysxml;
 186 }
 187
 188 sub XSLTParse4Display {
 189     my ( $biblionumber, $orig_record, $xslsyspref, $fixamps, $hidden_items, $sysxml, $xslfilename, $lang ) = @_;
 190
 191     $sysxml ||= C4::Context->preference($xslsyspref);
 192     $xslfilename ||= C4::Context->preference($xslsyspref);
 193     $lang ||= C4::Languages::getlanguage();
 194
 195     if ( $xslfilename =~ /^\s*"?default"?\s*$/i ) {
 196         my $htdocs;
 197         my $theme;
 198         my $xslfile;
 199         if ($xslsyspref eq "XSLTDetailsDisplay") {
 200             $htdocs  = C4::Context->config('intrahtdocs');
 201             $theme   = C4::Context->preference("template");
 202             $xslfile = C4::Context->preference('marcflavour') .
 203                        "slim2intranetDetail.xsl";
 204         } elsif ($xslsyspref eq "XSLTResultsDisplay") {
 205             $htdocs  = C4::Context->config('intrahtdocs');
 206             $theme   = C4::Context->preference("template");
 207             $xslfile = C4::Context->preference('marcflavour') .
 208                         "slim2intranetResults.xsl";
 209         } elsif ($xslsyspref eq "OPACXSLTDetailsDisplay") {
 210             $htdocs  = C4::Context->config('opachtdocs');
 211             $theme   = C4::Context->preference("opacthemes");
 212             $xslfile = C4::Context->preference('marcflavour') .
 213                        "slim2OPACDetail.xsl";
 214         } elsif ($xslsyspref eq "OPACXSLTResultsDisplay") {
 215             $htdocs  = C4::Context->config('opachtdocs');
 216             $theme   = C4::Context->preference("opacthemes");
 217             $xslfile = C4::Context->preference('marcflavour') .
 218                        "slim2OPACResults.xsl";
 219         } elsif ($xslsyspref eq 'XSLTListsDisplay') {
 220             # Lists default to *Results.xslt
 221             $htdocs  = C4::Context->config('intrahtdocs');
 222             $theme   = C4::Context->preference("template");
 223             $xslfile = C4::Context->preference('marcflavour') .
 224                         "slim2intranetResults.xsl";
 225         } elsif ($xslsyspref eq 'OPACXSLTListsDisplay') {
 226             # Lists default to *Results.xslt
 227             $htdocs  = C4::Context->config('opachtdocs');
 228             $theme   = C4::Context->preference("opacthemes");
 229             $xslfile = C4::Context->preference('marcflavour') .
 230                        "slim2OPACResults.xsl";
 231         }
 232         $xslfilename = _get_best_default_xslt_filename($htdocs, $theme, $lang, $xslfile);
 233     }
 234
 235     if ( $xslfilename =~ m/\{langcode\}/ ) {
 236         $xslfilename =~ s/\{langcode\}/$lang/;
 237     }
 238
 239     # grab the XML, run it through our stylesheet, push it out to the browser
 240     my $record = transformMARCXML4XSLT($biblionumber, $orig_record);
 241     my $itemsxml  = buildKohaItemsNamespace($biblionumber, $hidden_items);
 242     my $xmlrecord = $record->as_xml(C4::Context->preference('marcflavour'));
 243
 244     $xmlrecord =~ s/\<\/record\>/$itemsxml$sysxml\<\/record\>/;
 245     if ($fixamps) { # We need to correct the HTML entities that Zebra outputs
 246         $xmlrecord =~ s/\&amp;amp;/\&amp;/g;
 247         $xmlrecord =~ s/\&amp\;lt\;/\&lt\;/g;
 248         $xmlrecord =~ s/\&amp\;gt\;/\&gt\;/g;
 249     }
 250     $xmlrecord =~ s/\& /\&amp\; /;
 251     $xmlrecord =~ s/\&amp\;amp\; /\&amp\; /;
 252
 253     #If the xslt should fail, we will return undef (old behavior was
 254     #raw MARC)
 255     #Note that we did set do_not_return_source at object construction
 256     return $engine->transform($xmlrecord, $xslfilename ); #file or URL
 257 }
 258
 259 =head2 buildKohaItemsNamespace
 260
 261 Returns XML for items.
 262 Is only used in this module currently.
 263
 264 =cut
 265
 266 sub buildKohaItemsNamespace {
 267     my ($biblionumber, $hidden_items) = @_;
 268
 269     my @items = C4::Items::GetItemsInfo($biblionumber);
 270     if ($hidden_items && @$hidden_items) {
 271         my %hi = map {$_ => 1} @$hidden_items;
 272         @items = grep { !$hi{$_->{itemnumber}} } @items;
 273     }
 274
 275     my $shelflocations = GetKohaAuthorisedValues('items.location',GetFrameworkCode($biblionumber), 'opac');
 276     my $ccodes         = GetKohaAuthorisedValues('items.ccode',GetFrameworkCode($biblionumber), 'opac');
 277
 278     my %branches = map { $_->branchcode => $_->branchname } Koha::Libraries->search({}, { order_by => 'branchname' });
 279
 280     my $itemtypes = GetItemTypes();
 281     my $location = "";
 282     my $ccode = "";
 283     my $xml = '';
 284     for my $item (@items) {
 285         my $status;
 286
 287         my ( $transfertwhen, $transfertfrom, $transfertto ) = C4::Circulation::GetTransfers($item->{itemnumber});
 288
 289         my $reservestatus = C4::Reserves::GetReserveStatus( $item->{itemnumber} );
 290
 291         if ( $itemtypes->{ $item->{itype} }->{notforloan} || $item->{notforloan} || $item->{onloan} || $item->{withdrawn} || $item->{itemlost} || $item->{damaged} ||
 292              (defined $transfertwhen && $transfertwhen ne '') || $item->{itemnotforloan} || (defined $reservestatus && $reservestatus eq "Waiting") ){
 293             if ( $item->{notforloan} < 0) {
 294                 $status = "On order";
 295             }
 296             if ( $item->{itemnotforloan} > 0 || $item->{notforloan} > 0 || $itemtypes->{ $item->{itype} }->{notforloan} == 1 ) {
 297                 $status = "reference";
 298             }
 299             if ($item->{onloan}) {
 300                 $status = "Checked out";
 301             }
 302             if ( $item->{withdrawn}) {
 303                 $status = "Withdrawn";
 304             }
 305             if ($item->{itemlost}) {
 306                 $status = "Lost";
 307             }
 308             if ($item->{damaged}) {
 309                 $status = "Damaged";
 310             }
 311             if (defined $transfertwhen && $transfertwhen ne '') {
 312                 $status = 'In transit';
 313             }
 314             if (defined $reservestatus && $reservestatus eq "Waiting") {
 315                 $status = 'Waiting';
 316             }
 317         } else {
 318             $status = "available";
 319         }
 320         my $homebranch = $item->{homebranch}? xml_escape($branches{$item->{homebranch}}):'';
 321         my $holdingbranch = $item->{holdingbranch}? xml_escape($branches{$item->{holdingbranch}}):'';
 322         $location = $item->{location}? xml_escape($shelflocations->{$item->{location}}||$item->{location}):'';
 323         $ccode = $item->{ccode}? xml_escape($ccodes->{$item->{ccode}}||$item->{ccode}):'';
 324         my $itemcallnumber = xml_escape($item->{itemcallnumber});
 325         $xml .=
 326             "<item>"
 327           . "<homebranch>$homebranch</homebranch>"
 328           . "<holdingbranch>$holdingbranch</holdingbranch>"
 329           . "<location>$location</location>"
 330           . "<ccode>$ccode</ccode>"
 331           . "<status>$status</status>"
 332           . "<itemcallnumber>$itemcallnumber</itemcallnumber>"
 333           . "</item>";
 334     }
 335     $xml = "<items xmlns=\"http://www.koha-community.org/items\">".$xml."</items>";
 336     return $xml;
 337 }
 338
 339 =head2 engine
 340
 341 Returns reference to XSLT handler object.
 342
 343 =cut
 344
 345 sub engine {
 346     return $engine;
 347 }
 348
 349 1;
 350
 351 __END__
 352
 353 =head1 AUTHOR
 354
 355 Joshua Ferraro <jmf@liblime.com>
 356
 357 Koha Development Team <http://koha-community.org/>
 358
 359 =cut