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