Bug 10896: Add a --verbose option to koha-translate
[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 ampersand entities that Zebra outputs
219         $xmlrecord =~ s/\&amp;amp;/\&amp;/g;
220     }
221     $xmlrecord =~ s/\& /\&amp\; /;
222     $xmlrecord =~ s/\&amp\;amp\; /\&amp\; /;
223
224     my $parser = XML::LibXML->new();
225     # don't die when you find &, >, etc
226     $parser->recover_silently(0);
227     my $source = $parser->parse_string($xmlrecord);
228     unless ( $stylesheet->{$xslfilename} ) {
229         my $xslt = XML::LibXSLT->new();
230         my $style_doc;
231         if ( $xslfilename =~ /^https?:\/\// ) {
232             my $xsltstring = GetURI($xslfilename);
233             $style_doc = $parser->parse_string($xsltstring);
234         } else {
235             use Cwd;
236             $style_doc = $parser->parse_file($xslfilename);
237         }
238         $stylesheet->{$xslfilename} = $xslt->parse_stylesheet($style_doc);
239     }
240     my $results      = $stylesheet->{$xslfilename}->transform($source);
241     my $newxmlrecord = $stylesheet->{$xslfilename}->output_string($results);
242     return $newxmlrecord;
243 }
244
245 sub buildKohaItemsNamespace {
246     my ($biblionumber, $hidden_items) = @_;
247
248     my @items = C4::Items::GetItemsInfo($biblionumber);
249     if ($hidden_items && @$hidden_items) {
250         my %hi = map {$_ => 1} @$hidden_items;
251         @items = grep { !$hi{$_->{itemnumber}} } @items;
252     }
253
254     my $shelflocations = GetKohaAuthorisedValues('items.location',GetFrameworkCode($biblionumber), 'opac');
255     my $ccodes         = GetKohaAuthorisedValues('items.ccode',GetFrameworkCode($biblionumber), 'opac');
256
257     my $branches = GetBranches();
258     my $itemtypes = GetItemTypes();
259     my $location = "";
260     my $ccode = "";
261     my $xml = '';
262     for my $item (@items) {
263         my $status;
264
265         my ( $transfertwhen, $transfertfrom, $transfertto ) = C4::Circulation::GetTransfers($item->{itemnumber});
266
267         my $reservestatus = C4::Reserves::GetReserveStatus( $item->{itemnumber} );
268
269         if ( $itemtypes->{ $item->{itype} }->{notforloan} || $item->{notforloan} || $item->{onloan} || $item->{wthdrawn} || $item->{itemlost} || $item->{damaged} || 
270              (defined $transfertwhen && $transfertwhen ne '') || $item->{itemnotforloan} || (defined $reservestatus && $reservestatus eq "Waiting") ){ 
271             if ( $item->{notforloan} < 0) {
272                 $status = "On order";
273             } 
274             if ( $item->{itemnotforloan} > 0 || $item->{notforloan} > 0 || $itemtypes->{ $item->{itype} }->{notforloan} == 1 ) {
275                 $status = "reference";
276             }
277             if ($item->{onloan}) {
278                 $status = "Checked out";
279             }
280             if ( $item->{wthdrawn}) {
281                 $status = "Withdrawn";
282             }
283             if ($item->{itemlost}) {
284                 $status = "Lost";
285             }
286             if ($item->{damaged}) {
287                 $status = "Damaged"; 
288             }
289             if (defined $transfertwhen && $transfertwhen ne '') {
290                 $status = 'In transit';
291             }
292             if (defined $reservestatus && $reservestatus eq "Waiting") {
293                 $status = 'Waiting';
294             }
295         } else {
296             $status = "available";
297         }
298         my $homebranch = $item->{homebranch}? xml_escape($branches->{$item->{homebranch}}->{'branchname'}):'';
299         my $holdingbranch = $item->{holdingbranch}? xml_escape($branches->{$item->{holdingbranch}}->{'branchname'}):'';
300         $location = $item->{location}? xml_escape($shelflocations->{$item->{location}}||$item->{location}):'';
301         $ccode = $item->{ccode}? xml_escape($ccodes->{$item->{ccode}}||$item->{ccode}):'';
302         my $itemcallnumber = xml_escape($item->{itemcallnumber});
303         $xml.= "<item><homebranch>$homebranch</homebranch>".
304                 "<holdingbranch>$holdingbranch</holdingbranch>".
305                 "<location>$location</location>".
306                 "<ccode>$ccode</ccode>".
307                 "<status>$status</status>".
308                 "<itemcallnumber>".$itemcallnumber."</itemcallnumber>"
309         . "</item>";
310
311     }
312     $xml = "<items xmlns=\"http://www.koha-community.org/items\">".$xml."</items>";
313     return $xml;
314 }
315
316
317
318 1;
319 __END__
320
321 =head1 NOTES
322
323 =cut
324
325 =head1 AUTHOR
326
327 Joshua Ferraro <jmf@liblime.com>
328
329 =cut