]> git.koha-community.org Git - koha.git/blob - C4/XSLT.pm
Bug 11741: Correct display of < > in XSLT result lists
[koha.git] / C4 / XSLT.pm
1 package C4::XSLT;
2 # Copyright (C) 2006 LibLime
3 # <jmf at liblime dot com>
4 # Parts Copyright Katrin Fischer 2011
5 # Parts Copyright ByWater Solutions 2011
6 # Parts Copyright Biblibre 2012
7 #
8 # This file is part of Koha.
9 #
10 # Koha is free software; you can redistribute it and/or modify it under the
11 # terms of the GNU General Public License as published by the Free Software
12 # Foundation; either version 2 of the License, or (at your option) any later
13 # version.
14 #
15 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
16 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
17 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
18 #
19 # You should have received a copy of the GNU General Public License along
20 # with Koha; if not, write to the Free Software Foundation, Inc.,
21 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
22
23 use strict;
24 use warnings;
25
26 use C4::Context;
27 use C4::Branch;
28 use C4::Items;
29 use C4::Koha;
30 use C4::Biblio;
31 use C4::Circulation;
32 use C4::Reserves;
33 use Encode;
34 use XML::LibXML;
35 use XML::LibXSLT;
36 use LWP::Simple;
37
38 use vars qw($VERSION @ISA @EXPORT);
39
40 BEGIN {
41     require Exporter;
42     $VERSION = 3.07.00.049;
43     @ISA = qw(Exporter);
44     @EXPORT = qw(
45         &XSLTParse4Display
46         &GetURI
47     );
48 }
49
50 =head1 NAME
51
52 C4::XSLT - Functions for displaying XSLT-generated content
53
54 =head1 FUNCTIONS
55
56 =head2 GetURI
57
58 GetURI file and returns the xslt as a string
59
60 =cut
61
62 sub GetURI {
63     my ($uri) = @_;
64     my $string;
65     $string = get $uri ;
66     return $string;
67 }
68
69 =head2 transformMARCXML4XSLT
70
71 Replaces codes with authorized values in a MARC::Record object
72
73 =cut
74
75 sub transformMARCXML4XSLT {
76     my ($biblionumber, $record) = @_;
77     my $frameworkcode = GetFrameworkCode($biblionumber) || '';
78     my $tagslib = &GetMarcStructure(1,$frameworkcode);
79     my @fields;
80     # FIXME: wish there was a better way to handle exceptions
81     eval {
82         @fields = $record->fields();
83     };
84     if ($@) { warn "PROBLEM WITH RECORD"; next; }
85     my $av = getAuthorisedValues4MARCSubfields($frameworkcode);
86     foreach my $tag ( keys %$av ) {
87         foreach my $field ( $record->field( $tag ) ) {
88             if ( $av->{ $tag } ) {
89                 my @new_subfields = ();
90                 for my $subfield ( $field->subfields() ) {
91                     my ( $letter, $value ) = @$subfield;
92                     $value = GetAuthorisedValueDesc( $tag, $letter, $value, '', $tagslib )
93                         if $av->{ $tag }->{ $letter };
94                     push( @new_subfields, $letter, $value );
95                 } 
96                 $field ->replace_with( MARC::Field->new(
97                     $tag,
98                     $field->indicator(1),
99                     $field->indicator(2),
100                     @new_subfields
101                 ) );
102             }
103         }
104     }
105     return $record;
106 }
107
108 =head2 getAuthorisedValues4MARCSubfields
109
110 Returns a ref of hash of ref of hash for tag -> letter controled by authorised values
111
112 =cut
113
114 # Cache for tagfield-tagsubfield to decode per framework.
115 # Should be preferably be placed in Koha-core...
116 my %authval_per_framework;
117
118 sub getAuthorisedValues4MARCSubfields {
119     my ($frameworkcode) = @_;
120     unless ( $authval_per_framework{ $frameworkcode } ) {
121         my $dbh = C4::Context->dbh;
122         my $sth = $dbh->prepare("SELECT DISTINCT tagfield, tagsubfield
123                                  FROM marc_subfield_structure
124                                  WHERE authorised_value IS NOT NULL
125                                    AND authorised_value!=''
126                                    AND frameworkcode=?");
127         $sth->execute( $frameworkcode );
128         my $av = { };
129         while ( my ( $tag, $letter ) = $sth->fetchrow() ) {
130             $av->{ $tag }->{ $letter } = 1;
131         }
132         $authval_per_framework{ $frameworkcode } = $av;
133     }
134     return $authval_per_framework{ $frameworkcode };
135 }
136
137 my $stylesheet;
138
139 sub _get_best_default_xslt_filename {
140     my ($htdocs, $theme, $lang, $base_xslfile) = @_;
141
142     my @candidates = (
143         "$htdocs/$theme/$lang/xslt/${base_xslfile}", # exact match
144         "$htdocs/$theme/en/xslt/${base_xslfile}",    # if not, preferred theme in English
145         "$htdocs/prog/$lang/xslt/${base_xslfile}",   # if not, 'prog' theme in preferred language
146         "$htdocs/prog/en/xslt/${base_xslfile}",      # otherwise, prog theme in English; should always
147                                                      # exist
148     );
149     my $xslfilename;
150     foreach my $filename (@candidates) {
151         $xslfilename = $filename;
152         if (-f $filename) {
153             last; # we have a winner!
154         }
155     }
156     return $xslfilename;
157 }
158
159 sub XSLTParse4Display {
160     my ( $biblionumber, $orig_record, $xslsyspref, $fixamps, $hidden_items ) = @_;
161     my $xslfilename = C4::Context->preference($xslsyspref);
162     if ( $xslfilename =~ /^\s*"?default"?\s*$/i ) {
163         my $htdocs;
164         my $theme;
165         my $lang = C4::Templates::_current_language();
166         my $xslfile;
167         if ($xslsyspref eq "XSLTDetailsDisplay") {
168             $htdocs  = C4::Context->config('intrahtdocs');
169             $theme   = C4::Context->preference("template");
170             $xslfile = C4::Context->preference('marcflavour') .
171                        "slim2intranetDetail.xsl";
172         } elsif ($xslsyspref eq "XSLTResultsDisplay") {
173             $htdocs  = C4::Context->config('intrahtdocs');
174             $theme   = C4::Context->preference("template");
175             $xslfile = C4::Context->preference('marcflavour') .
176                         "slim2intranetResults.xsl";
177         } elsif ($xslsyspref eq "OPACXSLTDetailsDisplay") {
178             $htdocs  = C4::Context->config('opachtdocs');
179             $theme   = C4::Context->preference("opacthemes");
180             $xslfile = C4::Context->preference('marcflavour') .
181                        "slim2OPACDetail.xsl";
182         } elsif ($xslsyspref eq "OPACXSLTResultsDisplay") {
183             $htdocs  = C4::Context->config('opachtdocs');
184             $theme   = C4::Context->preference("opacthemes");
185             $xslfile = C4::Context->preference('marcflavour') .
186                        "slim2OPACResults.xsl";
187         }
188         $xslfilename = _get_best_default_xslt_filename($htdocs, $theme, $lang, $xslfile);
189     }
190
191     if ( $xslfilename =~ m/\{langcode\}/ ) {
192         my $lang = C4::Templates::_current_language();
193         $xslfilename =~ s/\{langcode\}/$lang/;
194     }
195
196     # grab the XML, run it through our stylesheet, push it out to the browser
197     my $record = transformMARCXML4XSLT($biblionumber, $orig_record);
198     #return $record->as_formatted();
199     my $itemsxml  = buildKohaItemsNamespace($biblionumber, $hidden_items);
200     my $xmlrecord = $record->as_xml(C4::Context->preference('marcflavour'));
201     my $sysxml = "<sysprefs>\n";
202     foreach my $syspref ( qw/ hidelostitems OPACURLOpenInNewWindow
203                               DisplayOPACiconsXSLT URLLinkText viewISBD
204                               OPACBaseURL TraceCompleteSubfields UseICU
205                               UseAuthoritiesForTracings TraceSubjectSubdivisions
206                               Display856uAsImage OPACDisplay856uAsImage 
207                               UseControlNumber IntranetBiblioDefaultView BiblioDefaultView
208                               singleBranchMode OPACItemLocation DisplayIconsXSLT
209                               AlternateHoldingsField AlternateHoldingsSeparator
210                               TrackClicks / )
211     {
212         my $sp = C4::Context->preference( $syspref );
213         next unless defined($sp);
214         $sysxml .= "<syspref name=\"$syspref\">$sp</syspref>\n";
215     }
216     $sysxml .= "</sysprefs>\n";
217     $xmlrecord =~ s/\<\/record\>/$itemsxml$sysxml\<\/record\>/;
218     if ($fixamps) { # We need to correct the HTML entities that Zebra outputs
219         $xmlrecord =~ s/\&amp;amp;/\&amp;/g;
220         $xmlrecord =~ s/\&amp\;lt\;/\&lt\;/g;
221         $xmlrecord =~ s/\&amp\;gt\;/\&gt\;/g;
222     }
223     $xmlrecord =~ s/\& /\&amp\; /;
224     $xmlrecord =~ s/\&amp\;amp\; /\&amp\; /;
225
226     my $parser = XML::LibXML->new();
227     # don't die when you find &, >, etc
228     $parser->recover_silently(0);
229     my $source = $parser->parse_string($xmlrecord);
230     unless ( $stylesheet->{$xslfilename} ) {
231         my $xslt = XML::LibXSLT->new();
232         my $style_doc;
233         if ( $xslfilename =~ /^https?:\/\// ) {
234             my $xsltstring = GetURI($xslfilename);
235             $style_doc = $parser->parse_string($xsltstring);
236         } else {
237             use Cwd;
238             $style_doc = $parser->parse_file($xslfilename);
239         }
240         $stylesheet->{$xslfilename} = $xslt->parse_stylesheet($style_doc);
241     }
242     my $results      = $stylesheet->{$xslfilename}->transform($source);
243     my $newxmlrecord = $stylesheet->{$xslfilename}->output_string($results);
244     return $newxmlrecord;
245 }
246
247 sub buildKohaItemsNamespace {
248     my ($biblionumber, $hidden_items) = @_;
249
250     my @items = C4::Items::GetItemsInfo($biblionumber);
251     if ($hidden_items && @$hidden_items) {
252         my %hi = map {$_ => 1} @$hidden_items;
253         @items = grep { !$hi{$_->{itemnumber}} } @items;
254     }
255
256     my $shelflocations = GetKohaAuthorisedValues('items.location',GetFrameworkCode($biblionumber), 'opac');
257     my $ccodes         = GetKohaAuthorisedValues('items.ccode',GetFrameworkCode($biblionumber), 'opac');
258
259     my $branches = GetBranches();
260     my $itemtypes = GetItemTypes();
261     my $location = "";
262     my $ccode = "";
263     my $xml = '';
264     for my $item (@items) {
265         my $status;
266
267         my ( $transfertwhen, $transfertfrom, $transfertto ) = C4::Circulation::GetTransfers($item->{itemnumber});
268
269         my $reservestatus = C4::Reserves::GetReserveStatus( $item->{itemnumber} );
270
271         if ( $itemtypes->{ $item->{itype} }->{notforloan} || $item->{notforloan} || $item->{onloan} || $item->{withdrawn} || $item->{itemlost} || $item->{damaged} ||
272              (defined $transfertwhen && $transfertwhen ne '') || $item->{itemnotforloan} || (defined $reservestatus && $reservestatus eq "Waiting") ){ 
273             if ( $item->{notforloan} < 0) {
274                 $status = "On order";
275             } 
276             if ( $item->{itemnotforloan} > 0 || $item->{notforloan} > 0 || $itemtypes->{ $item->{itype} }->{notforloan} == 1 ) {
277                 $status = "reference";
278             }
279             if ($item->{onloan}) {
280                 $status = "Checked out";
281             }
282             if ( $item->{withdrawn}) {
283                 $status = "Withdrawn";
284             }
285             if ($item->{itemlost}) {
286                 $status = "Lost";
287             }
288             if ($item->{damaged}) {
289                 $status = "Damaged"; 
290             }
291             if (defined $transfertwhen && $transfertwhen ne '') {
292                 $status = 'In transit';
293             }
294             if (defined $reservestatus && $reservestatus eq "Waiting") {
295                 $status = 'Waiting';
296             }
297         } else {
298             $status = "available";
299         }
300         my $homebranch = $item->{homebranch}? xml_escape($branches->{$item->{homebranch}}->{'branchname'}):'';
301         my $holdingbranch = $item->{holdingbranch}? xml_escape($branches->{$item->{holdingbranch}}->{'branchname'}):'';
302         $location = $item->{location}? xml_escape($shelflocations->{$item->{location}}||$item->{location}):'';
303         $ccode = $item->{ccode}? xml_escape($ccodes->{$item->{ccode}}||$item->{ccode}):'';
304         my $itemcallnumber = xml_escape($item->{itemcallnumber});
305         $xml.= "<item><homebranch>$homebranch</homebranch>".
306                 "<holdingbranch>$holdingbranch</holdingbranch>".
307                 "<location>$location</location>".
308                 "<ccode>$ccode</ccode>".
309                 "<status>$status</status>".
310                 "<itemcallnumber>".$itemcallnumber."</itemcallnumber>"
311         . "</item>";
312
313     }
314     $xml = "<items xmlns=\"http://www.koha-community.org/items\">".$xml."</items>";
315     return $xml;
316 }
317
318
319
320 1;
321 __END__
322
323 =head1 NOTES
324
325 =cut
326
327 =head1 AUTHOR
328
329 Joshua Ferraro <jmf@liblime.com>
330
331 =cut