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