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 under the
  12 # terms of the GNU General Public License as published by the Free Software
  13 # Foundation; either version 3 of the License, or (at your option) any later
  14 # version.
  15 #
  16 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  17 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  18 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU General Public License along
  21 # with Koha; if not, write to the Free Software Foundation, Inc.,
  22 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  23
  24 use strict;
  25 use warnings;
  26
  27 use C4::Context;
  28 use C4::Branch;
  29 use C4::Items;
  30 use C4::Koha;
  31 use C4::Biblio;
  32 use C4::Circulation;
  33 use C4::Reserves;
  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);
  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 XSLTParse4Display {
 164     my ( $biblionumber, $orig_record, $xslsyspref, $fixamps, $hidden_items ) = @_;
 165     my $xslfilename = C4::Context->preference($xslsyspref);
 166     if ( $xslfilename =~ /^\s*"?default"?\s*$/i ) {
 167         my $htdocs;
 168         my $theme;
 169         my $lang = C4::Languages::getlanguage();
 170         my $xslfile;
 171         if ($xslsyspref eq "XSLTDetailsDisplay") {
 172             $htdocs  = C4::Context->config('intrahtdocs');
 173             $theme   = C4::Context->preference("template");
 174             $xslfile = C4::Context->preference('marcflavour') .
 175                        "slim2intranetDetail.xsl";
 176         } elsif ($xslsyspref eq "XSLTResultsDisplay") {
 177             $htdocs  = C4::Context->config('intrahtdocs');
 178             $theme   = C4::Context->preference("template");
 179             $xslfile = C4::Context->preference('marcflavour') .
 180                         "slim2intranetResults.xsl";
 181         } elsif ($xslsyspref eq "OPACXSLTDetailsDisplay") {
 182             $htdocs  = C4::Context->config('opachtdocs');
 183             $theme   = C4::Context->preference("opacthemes");
 184             $xslfile = C4::Context->preference('marcflavour') .
 185                        "slim2OPACDetail.xsl";
 186         } elsif ($xslsyspref eq "OPACXSLTResultsDisplay") {
 187             $htdocs  = C4::Context->config('opachtdocs');
 188             $theme   = C4::Context->preference("opacthemes");
 189             $xslfile = C4::Context->preference('marcflavour') .
 190                        "slim2OPACResults.xsl";
 191         }
 192         $xslfilename = _get_best_default_xslt_filename($htdocs, $theme, $lang, $xslfile);
 193     }
 194
 195     if ( $xslfilename =~ m/\{langcode\}/ ) {
 196         my $lang = C4::Languages::getlanguage();
 197         $xslfilename =~ s/\{langcode\}/$lang/;
 198     }
 199
 200     # grab the XML, run it through our stylesheet, push it out to the browser
 201     my $record = transformMARCXML4XSLT($biblionumber, $orig_record);
 202     my $itemsxml  = buildKohaItemsNamespace($biblionumber, $hidden_items);
 203     my $xmlrecord = $record->as_xml(C4::Context->preference('marcflavour'));
 204     my $sysxml = "<sysprefs>\n";
 205     foreach my $syspref ( qw/ hidelostitems OPACURLOpenInNewWindow
 206                               DisplayOPACiconsXSLT URLLinkText viewISBD
 207                               OPACBaseURL TraceCompleteSubfields UseICU
 208                               UseAuthoritiesForTracings TraceSubjectSubdivisions
 209                               Display856uAsImage OPACDisplay856uAsImage
 210                               UseControlNumber IntranetBiblioDefaultView BiblioDefaultView
 211                               OPACItemLocation DisplayIconsXSLT
 212                               AlternateHoldingsField AlternateHoldingsSeparator
 213                               TrackClicks opacthemes IdRef OpacSuppression / )
 214     {
 215         my $sp = C4::Context->preference( $syspref );
 216         next unless defined($sp);
 217         $sysxml .= "<syspref name=\"$syspref\">$sp</syspref>\n";
 218     }
 219
 220     # singleBranchMode was a system preference, but no longer is
 221     # we can retain it here for compatibility
 222     my $singleBranchMode = Koha::Libraries->search->count == 1;
 223     $sysxml .= "<syspref name=\"singleBranchMode\">$singleBranchMode</syspref>\n";
 224
 225     $sysxml .= "</sysprefs>\n";
 226     $xmlrecord =~ s/\<\/record\>/$itemsxml$sysxml\<\/record\>/;
 227     if ($fixamps) { # We need to correct the HTML entities that Zebra outputs
 228         $xmlrecord =~ s/\&amp;amp;/\&amp;/g;
 229         $xmlrecord =~ s/\&amp\;lt\;/\&lt\;/g;
 230         $xmlrecord =~ s/\&amp\;gt\;/\&gt\;/g;
 231     }
 232     $xmlrecord =~ s/\& /\&amp\; /;
 233     $xmlrecord =~ s/\&amp\;amp\; /\&amp\; /;
 234
 235     #If the xslt should fail, we will return undef (old behavior was
 236     #raw MARC)
 237     #Note that we did set do_not_return_source at object construction
 238     return $engine->transform($xmlrecord, $xslfilename ); #file or URL
 239 }
 240
 241 =head2 buildKohaItemsNamespace
 242
 243 Returns XML for items.
 244 Is only used in this module currently.
 245
 246 =cut
 247
 248 sub buildKohaItemsNamespace {
 249     my ($biblionumber, $hidden_items) = @_;
 250
 251     my @items = C4::Items::GetItemsInfo($biblionumber);
 252     if ($hidden_items && @$hidden_items) {
 253         my %hi = map {$_ => 1} @$hidden_items;
 254         @items = grep { !$hi{$_->{itemnumber}} } @items;
 255     }
 256
 257     my $shelflocations = GetKohaAuthorisedValues('items.location',GetFrameworkCode($biblionumber), 'opac');
 258     my $ccodes         = GetKohaAuthorisedValues('items.ccode',GetFrameworkCode($biblionumber), 'opac');
 259
 260     my $branches = GetBranches();
 261     my $itemtypes = GetItemTypes();
 262     my $location = "";
 263     my $ccode = "";
 264     my $xml = '';
 265     for my $item (@items) {
 266         my $status;
 267
 268         my ( $transfertwhen, $transfertfrom, $transfertto ) = C4::Circulation::GetTransfers($item->{itemnumber});
 269
 270         my $reservestatus = C4::Reserves::GetReserveStatus( $item->{itemnumber} );
 271
 272         if ( $itemtypes->{ $item->{itype} }->{notforloan} || $item->{notforloan} || $item->{onloan} || $item->{withdrawn} || $item->{itemlost} || $item->{damaged} ||
 273              (defined $transfertwhen && $transfertwhen ne '') || $item->{itemnotforloan} || (defined $reservestatus && $reservestatus eq "Waiting") ){
 274             if ( $item->{notforloan} < 0) {
 275                 $status = "On order";
 276             }
 277             if ( $item->{itemnotforloan} > 0 || $item->{notforloan} > 0 || $itemtypes->{ $item->{itype} }->{notforloan} == 1 ) {
 278                 $status = "reference";
 279             }
 280             if ($item->{onloan}) {
 281                 $status = "Checked out";
 282             }
 283             if ( $item->{withdrawn}) {
 284                 $status = "Withdrawn";
 285             }
 286             if ($item->{itemlost}) {
 287                 $status = "Lost";
 288             }
 289             if ($item->{damaged}) {
 290                 $status = "Damaged";
 291             }
 292             if (defined $transfertwhen && $transfertwhen ne '') {
 293                 $status = 'In transit';
 294             }
 295             if (defined $reservestatus && $reservestatus eq "Waiting") {
 296                 $status = 'Waiting';
 297             }
 298         } else {
 299             $status = "available";
 300         }
 301         my $homebranch = $item->{homebranch}? xml_escape($branches->{$item->{homebranch}}->{'branchname'}):'';
 302         my $holdingbranch = $item->{holdingbranch}? xml_escape($branches->{$item->{holdingbranch}}->{'branchname'}):'';
 303         $location = $item->{location}? xml_escape($shelflocations->{$item->{location}}||$item->{location}):'';
 304         $ccode = $item->{ccode}? xml_escape($ccodes->{$item->{ccode}}||$item->{ccode}):'';
 305         my $itemcallnumber = xml_escape($item->{itemcallnumber});
 306         $xml.= "<item><homebranch>$homebranch</homebranch>".
 307                 "<holdingbranch>$holdingbranch</holdingbranch>".
 308                 "<location>$location</location>".
 309                 "<ccode>$ccode</ccode>".
 310                 "<status>$status</status>".
 311                 "<itemcallnumber>".$itemcallnumber."</itemcallnumber>".
 312                 "</item>";
 313     }
 314     $xml = "<items xmlns=\"http://www.koha-community.org/items\">".$xml."</items>";
 315     return $xml;
 316 }
 317
 318 =head2 engine
 319
 320 Returns reference to XSLT handler object.
 321
 322 =cut
 323
 324 sub engine {
 325     return $engine;
 326 }
 327
 328 1;
 329
 330 __END__
 331
 332 =head1 AUTHOR
 333
 334 Joshua Ferraro <jmf@liblime.com>
 335
 336 Koha Development Team <http://koha-community.org/>
 337
 338 =cut