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