Bug 12265: [QA Follow-up] Replace DBIx search by find
[koha.git] / 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
36 use Encode;
37
38 use vars qw($VERSION @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     $VERSION = 3.07.00.049;
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 $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                     $value = GetAuthorisedValueDesc( $tag, $letter, $value, '', $tagslib )
86                         if $av->{ $tag }->{ $letter };
87                     push( @new_subfields, $letter, $value );
88                 } 
89                 $field ->replace_with( MARC::Field->new(
90                     $tag,
91                     $field->indicator(1),
92                     $field->indicator(2),
93                     @new_subfields
94                 ) );
95             }
96         }
97     }
98     return $record;
99 }
100
101 =head2 getAuthorisedValues4MARCSubfields
102
103 Returns a ref of hash of ref of hash for tag -> letter controled by authorised values
104 Is only used in this module currently.
105
106 =cut
107
108 sub getAuthorisedValues4MARCSubfields {
109     my ($frameworkcode) = @_;
110     unless ( $authval_per_framework{ $frameworkcode } ) {
111         my $dbh = C4::Context->dbh;
112         my $sth = $dbh->prepare("SELECT DISTINCT tagfield, tagsubfield
113                                  FROM marc_subfield_structure
114                                  WHERE authorised_value IS NOT NULL
115                                    AND authorised_value!=''
116                                    AND frameworkcode=?");
117         $sth->execute( $frameworkcode );
118         my $av = { };
119         while ( my ( $tag, $letter ) = $sth->fetchrow() ) {
120             $av->{ $tag }->{ $letter } = 1;
121         }
122         $authval_per_framework{ $frameworkcode } = $av;
123     }
124     return $authval_per_framework{ $frameworkcode };
125 }
126
127 =head2 XSLTParse4Display
128
129 Returns xml for biblionumber and requested XSLT transformation.
130 Returns undef if the transform fails.
131
132 Used in OPAC results and detail, intranet results and detail, list display.
133 (Depending on the settings of your XSLT preferences.)
134
135 The helper function _get_best_default_xslt_filename is used in a unit test.
136
137 =cut
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::Languages::getlanguage();
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::Languages::getlanguage();
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     my $itemsxml  = buildKohaItemsNamespace($biblionumber, $hidden_items);
199     my $xmlrecord = $record->as_xml(C4::Context->preference('marcflavour'));
200     my $sysxml = "<sysprefs>\n";
201     foreach my $syspref ( qw/ hidelostitems OPACURLOpenInNewWindow
202                               DisplayOPACiconsXSLT URLLinkText viewISBD
203                               OPACBaseURL TraceCompleteSubfields UseICU
204                               UseAuthoritiesForTracings TraceSubjectSubdivisions
205                               Display856uAsImage OPACDisplay856uAsImage 
206                               UseControlNumber IntranetBiblioDefaultView BiblioDefaultView
207                               singleBranchMode OPACItemLocation DisplayIconsXSLT
208                               AlternateHoldingsField AlternateHoldingsSeparator
209                               TrackClicks / )
210     {
211         my $sp = C4::Context->preference( $syspref );
212         next unless defined($sp);
213         $sysxml .= "<syspref name=\"$syspref\">$sp</syspref>\n";
214     }
215     $sysxml .= "</sysprefs>\n";
216     $xmlrecord =~ s/\<\/record\>/$itemsxml$sysxml\<\/record\>/;
217     if ($fixamps) { # We need to correct the HTML entities that Zebra outputs
218         $xmlrecord =~ s/\&amp;amp;/\&amp;/g;
219         $xmlrecord =~ s/\&amp\;lt\;/\&lt\;/g;
220         $xmlrecord =~ s/\&amp\;gt\;/\&gt\;/g;
221     }
222     $xmlrecord =~ s/\& /\&amp\; /;
223     $xmlrecord =~ s/\&amp\;amp\; /\&amp\; /;
224
225     #If the xslt should fail, we will return undef (old behavior was
226     #raw MARC)
227     #Note that we did set do_not_return_source at object construction
228     return $engine->transform($xmlrecord, $xslfilename ); #file or URL
229 }
230
231 =head2 buildKohaItemsNamespace
232
233 Returns XML for items.
234 Is only used in this module currently.
235
236 =cut
237
238 sub buildKohaItemsNamespace {
239     my ($biblionumber, $hidden_items) = @_;
240
241     my @items = C4::Items::GetItemsInfo($biblionumber);
242     if ($hidden_items && @$hidden_items) {
243         my %hi = map {$_ => 1} @$hidden_items;
244         @items = grep { !$hi{$_->{itemnumber}} } @items;
245     }
246
247     my $shelflocations = GetKohaAuthorisedValues('items.location',GetFrameworkCode($biblionumber), 'opac');
248     my $ccodes         = GetKohaAuthorisedValues('items.ccode',GetFrameworkCode($biblionumber), 'opac');
249
250     my $branches = GetBranches();
251     my $itemtypes = GetItemTypes();
252     my $location = "";
253     my $ccode = "";
254     my $xml = '';
255     for my $item (@items) {
256         my $status;
257
258         my ( $transfertwhen, $transfertfrom, $transfertto ) = C4::Circulation::GetTransfers($item->{itemnumber});
259
260         my $reservestatus = C4::Reserves::GetReserveStatus( $item->{itemnumber} );
261
262         if ( $itemtypes->{ $item->{itype} }->{notforloan} || $item->{notforloan} || $item->{onloan} || $item->{withdrawn} || $item->{itemlost} || $item->{damaged} ||
263              (defined $transfertwhen && $transfertwhen ne '') || $item->{itemnotforloan} || (defined $reservestatus && $reservestatus eq "Waiting") ){ 
264             if ( $item->{notforloan} < 0) {
265                 $status = "On order";
266             } 
267             if ( $item->{itemnotforloan} > 0 || $item->{notforloan} > 0 || $itemtypes->{ $item->{itype} }->{notforloan} == 1 ) {
268                 $status = "reference";
269             }
270             if ($item->{onloan}) {
271                 $status = "Checked out";
272             }
273             if ( $item->{withdrawn}) {
274                 $status = "Withdrawn";
275             }
276             if ($item->{itemlost}) {
277                 $status = "Lost";
278             }
279             if ($item->{damaged}) {
280                 $status = "Damaged"; 
281             }
282             if (defined $transfertwhen && $transfertwhen ne '') {
283                 $status = 'In transit';
284             }
285             if (defined $reservestatus && $reservestatus eq "Waiting") {
286                 $status = 'Waiting';
287             }
288         } else {
289             $status = "available";
290         }
291         my $homebranch = $item->{homebranch}? xml_escape($branches->{$item->{homebranch}}->{'branchname'}):'';
292         my $holdingbranch = $item->{holdingbranch}? xml_escape($branches->{$item->{holdingbranch}}->{'branchname'}):'';
293         $location = $item->{location}? xml_escape($shelflocations->{$item->{location}}||$item->{location}):'';
294         $ccode = $item->{ccode}? xml_escape($ccodes->{$item->{ccode}}||$item->{ccode}):'';
295         my $itemcallnumber = xml_escape($item->{itemcallnumber});
296         $xml.= "<item><homebranch>$homebranch</homebranch>".
297                 "<holdingbranch>$holdingbranch</holdingbranch>".
298                 "<location>$location</location>".
299                 "<ccode>$ccode</ccode>".
300                 "<status>$status</status>".
301                 "<itemcallnumber>".$itemcallnumber."</itemcallnumber>".
302                 "</item>";
303     }
304     $xml = "<items xmlns=\"http://www.koha-community.org/items\">".$xml."</items>";
305     return $xml;
306 }
307
308 =head2 engine
309
310 Returns reference to XSLT handler object.
311
312 =cut
313
314 sub engine {
315     return $engine;
316 }
317
318 1;
319
320 __END__
321
322 =head1 AUTHOR
323
324 Joshua Ferraro <jmf@liblime.com>
325
326 Koha Development Team <http://koha-community.org/>
327
328 =cut