]> git.koha-community.org Git - koha.git/blob - C4/XSLT.pm
Merge remote-tracking branch 'origin/new/bug_6488'
[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 #
7 # This file is part of Koha.
8 #
9 # Koha is free software; you can redistribute it and/or modify it under the
10 # terms of the GNU General Public License as published by the Free Software
11 # Foundation; either version 2 of the License, or (at your option) any later
12 # version.
13 #
14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
17 #
18 # You should have received a copy of the GNU General Public License along
19 # with Koha; if not, write to the Free Software Foundation, Inc.,
20 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21
22 use strict;
23 use warnings;
24
25 use C4::Context;
26 use C4::Branch;
27 use C4::Items;
28 use C4::Koha;
29 use C4::Biblio;
30 use C4::Circulation;
31 use C4::Reserves;
32 use Encode;
33 use XML::LibXML;
34 use XML::LibXSLT;
35
36 use vars qw($VERSION @ISA @EXPORT);
37
38 BEGIN {
39     require Exporter;
40     $VERSION = 0.03;
41     @ISA = qw(Exporter);
42     @EXPORT = qw(
43         &XSLTParse4Display
44     );
45 }
46
47 =head1 NAME
48
49 C4::XSLT - Functions for displaying XSLT-generated content
50
51 =head1 FUNCTIONS
52
53 =head2 transformMARCXML4XSLT
54
55 Replaces codes with authorized values in a MARC::Record object
56
57 =cut
58
59 sub transformMARCXML4XSLT {
60     my ($biblionumber, $record) = @_;
61     my $frameworkcode = GetFrameworkCode($biblionumber) || '';
62     my $tagslib = &GetMarcStructure(1,$frameworkcode);
63     my @fields;
64     # FIXME: wish there was a better way to handle exceptions
65     eval {
66         @fields = $record->fields();
67     };
68     if ($@) { warn "PROBLEM WITH RECORD"; next; }
69     my $av = getAuthorisedValues4MARCSubfields($frameworkcode);
70     foreach my $tag ( keys %$av ) {
71         foreach my $field ( $record->field( $tag ) ) {
72             if ( $av->{ $tag } ) {
73                 my @new_subfields = ();
74                 for my $subfield ( $field->subfields() ) {
75                     my ( $letter, $value ) = @$subfield;
76                     $value = GetAuthorisedValueDesc( $tag, $letter, $value, '', $tagslib )
77                         if $av->{ $tag }->{ $letter };
78                     push( @new_subfields, $letter, $value );
79                 } 
80                 $field ->replace_with( MARC::Field->new(
81                     $tag,
82                     $field->indicator(1),
83                     $field->indicator(2),
84                     @new_subfields
85                 ) );
86             }
87         }
88     }
89     return $record;
90 }
91
92 =head2 getAuthorisedValues4MARCSubfields
93
94 Returns a ref of hash of ref of hash for tag -> letter controled by authorised values
95
96 =cut
97
98 # Cache for tagfield-tagsubfield to decode per framework.
99 # Should be preferably be placed in Koha-core...
100 my %authval_per_framework;
101
102 sub getAuthorisedValues4MARCSubfields {
103     my ($frameworkcode) = @_;
104     unless ( $authval_per_framework{ $frameworkcode } ) {
105         my $dbh = C4::Context->dbh;
106         my $sth = $dbh->prepare("SELECT DISTINCT tagfield, tagsubfield
107                                  FROM marc_subfield_structure
108                                  WHERE authorised_value IS NOT NULL
109                                    AND authorised_value!=''
110                                    AND frameworkcode=?");
111         $sth->execute( $frameworkcode );
112         my $av = { };
113         while ( my ( $tag, $letter ) = $sth->fetchrow() ) {
114             $av->{ $tag }->{ $letter } = 1;
115         }
116         $authval_per_framework{ $frameworkcode } = $av;
117     }
118     return $authval_per_framework{ $frameworkcode };
119 }
120
121 my $stylesheet;
122
123 sub XSLTParse4Display {
124     my ( $biblionumber, $orig_record, $xsl_suffix, $interface, $fixamps, $hidden_items ) = @_;
125     $interface = 'opac' unless $interface;
126     # grab the XML, run it through our stylesheet, push it out to the browser
127     my $record = transformMARCXML4XSLT($biblionumber, $orig_record);
128     #return $record->as_formatted();
129     my $itemsxml  = buildKohaItemsNamespace($biblionumber, $hidden_items);
130     my $xmlrecord = $record->as_xml(C4::Context->preference('marcflavour'));
131     my $sysxml = "<sysprefs>\n";
132     foreach my $syspref ( qw/ hidelostitems OPACURLOpenInNewWindow
133                               DisplayOPACiconsXSLT URLLinkText viewISBD
134                               OPACBaseURL TraceCompleteSubfields
135                               UseAuthoritiesForTracings TraceSubjectSubdivisions
136                               Display856uAsImage OPACDisplay856uAsImage 
137                               UseControlNumber
138                               AlternateHoldingsField AlternateHoldingsSeparator / )
139     {
140         my $sp = C4::Context->preference( $syspref );
141         next unless defined($sp);
142         $sysxml .= "<syspref name=\"$syspref\">$sp</syspref>\n";
143     }
144     $sysxml .= "</sysprefs>\n";
145     $xmlrecord =~ s/\<\/record\>/$itemsxml$sysxml\<\/record\>/;
146     if ($fixamps) { # We need to correct the ampersand entities that Zebra outputs
147         $xmlrecord =~ s/\&amp;amp;/\&amp;/g;
148     }
149     $xmlrecord =~ s/\& /\&amp\; /;
150     $xmlrecord =~ s/\&amp\;amp\; /\&amp\; /;
151
152     my $parser = XML::LibXML->new();
153     # don't die when you find &, >, etc
154     $parser->recover_silently(0);
155     my $source = $parser->parse_string($xmlrecord);
156     unless ( $stylesheet ) {
157         my $xslt = XML::LibXSLT->new();
158         my $xslfile;
159         if ($interface eq 'intranet') {
160             $xslfile = C4::Context->config('intrahtdocs') . 
161                       '/' . C4::Context->preference("template") . 
162                       '/' . C4::Templates::_current_language() .
163                       '/xslt/' .
164                       C4::Context->preference('marcflavour') .
165                       "slim2intranet$xsl_suffix.xsl";
166         } else {
167             $xslfile = C4::Context->config('opachtdocs') . 
168                       '/' . C4::Context->preference("opacthemes") . 
169                       '/' . C4::Templates::_current_language() .
170                       '/xslt/' .
171                       C4::Context->preference('marcflavour') .
172                       "slim2OPAC$xsl_suffix.xsl";
173         }
174         my $style_doc = $parser->parse_file($xslfile);
175         $stylesheet = $xslt->parse_stylesheet($style_doc);
176     }
177     my $results = $stylesheet->transform($source);
178     my $newxmlrecord = $stylesheet->output_string($results);
179     return $newxmlrecord;
180 }
181
182 sub buildKohaItemsNamespace {
183     my ($biblionumber, $hidden_items) = @_;
184
185     my @items = C4::Items::GetItemsInfo($biblionumber);
186     if ($hidden_items && @$hidden_items) {
187         my %hi = map {$_ => 1} @$hidden_items;
188         @items = grep { !$hi{$_->{itemnumber}} } @items;
189     }
190     my $branches = GetBranches();
191     my $itemtypes = GetItemTypes();
192     my $xml = '';
193     for my $item (@items) {
194         my $status;
195
196         my ( $transfertwhen, $transfertfrom, $transfertto ) = C4::Circulation::GetTransfers($item->{itemnumber});
197
198         my ( $reservestatus, $reserveitem, undef ) = C4::Reserves::CheckReserves($item->{itemnumber});
199
200         if ( $itemtypes->{ $item->{itype} }->{notforloan} || $item->{notforloan} || $item->{onloan} || $item->{wthdrawn} || $item->{itemlost} || $item->{damaged} || 
201              (defined $transfertwhen && $transfertwhen ne '') || $item->{itemnotforloan} || (defined $reservestatus && $reservestatus eq "Waiting") ){ 
202             if ( $item->{notforloan} < 0) {
203                 $status = "On order";
204             } 
205             if ( $item->{itemnotforloan} > 0 || $item->{notforloan} > 0 || $itemtypes->{ $item->{itype} }->{notforloan} == 1 ) {
206                 $status = "reference";
207             }
208             if ($item->{onloan}) {
209                 $status = "Checked out";
210             }
211             if ( $item->{wthdrawn}) {
212                 $status = "Withdrawn";
213             }
214             if ($item->{itemlost}) {
215                 $status = "Lost";
216             }
217             if ($item->{damaged}) {
218                 $status = "Damaged"; 
219             }
220             if (defined $transfertwhen && $transfertwhen ne '') {
221                 $status = 'In transit';
222             }
223             if (defined $reservestatus && $reservestatus eq "Waiting") {
224                 $status = 'Waiting';
225             }
226         } else {
227             $status = "available";
228         }
229         my $homebranch = $item->{homebranch}? xml_escape($branches->{$item->{homebranch}}->{'branchname'}):'';
230             my $itemcallnumber = xml_escape($item->{itemcallnumber});
231         $xml.= "<item><homebranch>$homebranch</homebranch>".
232                 "<status>$status</status>".
233                 "<itemcallnumber>".$itemcallnumber."</itemcallnumber>"
234         . "</item>";
235
236     }
237     $xml = "<items xmlns=\"http://www.koha-community.org/items\">".$xml."</items>";
238     return $xml;
239 }
240
241
242
243 1;
244 __END__
245
246 =head1 NOTES
247
248 =cut
249
250 =head1 AUTHOR
251
252 Joshua Ferraro <jmf@liblime.com>
253
254 =cut