2 # Copyright (C) 2006 LibLime
3 # <jmf at liblime dot com>
4 # Parts Copyright Katrin Fischer 2011
5 # Parts Copyright ByWater Solutions 2011
7 # This file is part of Koha.
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
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.
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.
36 use vars
qw($VERSION @ISA @EXPORT);
49 C4::XSLT - Functions for displaying XSLT-generated content
53 =head2 transformMARCXML4XSLT
55 Replaces codes with authorized values in a MARC::Record object
59 sub transformMARCXML4XSLT
{
60 my ($biblionumber, $record) = @_;
61 my $frameworkcode = GetFrameworkCode
($biblionumber);
62 my $tagslib = &GetMarcStructure
(1,$frameworkcode);
64 # FIXME: wish there was a better way to handle exceptions
66 @fields = $record->fields();
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 );
80 $field ->replace_with( MARC
::Field
->new(
92 =head2 getAuthorisedValues4MARCSubfields
94 Returns a ref of hash of ref of hash for tag -> letter controled by authorised values
98 # Cache for tagfield-tagsubfield to decode per framework.
99 # Should be preferably be placed in Koha-core...
100 my %authval_per_framework;
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 );
113 while ( my ( $tag, $letter ) = $sth->fetchrow() ) {
114 $av->{ $tag }->{ $letter } = 1;
116 $authval_per_framework{ $frameworkcode } = $av;
118 return $authval_per_framework{ $frameworkcode };
123 sub XSLTParse4Display
{
124 my ( $biblionumber, $orig_record, $xsl_suffix, $interface, $fixamps ) = @_;
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);
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
138 AlternateHoldingsField AlternateHoldingsSeparator
/ )
140 my $sp = C4
::Context
->preference( $syspref );
141 next unless defined($sp);
142 $sysxml .= "<syspref name=\"$syspref\">$sp</syspref>\n";
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;/\&/g;
149 $xmlrecord =~ s/\& /\&\; /;
150 $xmlrecord =~ s/\&\;amp\; /\&\; /;
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();
159 if ($interface eq 'intranet') {
160 $xslfile = C4
::Context
->config('intrahtdocs') .
161 '/' . C4
::Context
->preference("template") .
162 '/' . C4
::Templates
::_current_language
() .
164 C4
::Context
->preference('marcflavour') .
165 "slim2intranet$xsl_suffix.xsl";
167 $xslfile = C4
::Context
->config('opachtdocs') .
168 '/' . C4
::Context
->preference("opacthemes") .
169 '/' . C4
::Templates
::_current_language
() .
171 C4
::Context
->preference('marcflavour') .
172 "slim2OPAC$xsl_suffix.xsl";
174 my $style_doc = $parser->parse_file($xslfile);
175 $stylesheet = $xslt->parse_stylesheet($style_doc);
177 my $results = $stylesheet->transform($source);
178 my $newxmlrecord = $stylesheet->output_string($results);
179 return $newxmlrecord;
182 sub buildKohaItemsNamespace
{
183 my ($biblionumber) = @_;
184 my @items = C4
::Items
::GetItemsInfo
($biblionumber);
185 my $branches = GetBranches
();
186 my $itemtypes = GetItemTypes
();
188 for my $item (@items) {
191 my ( $transfertwhen, $transfertfrom, $transfertto ) = C4
::Circulation
::GetTransfers
($item->{itemnumber
});
193 my ( $reservestatus, $reserveitem ) = C4
::Reserves
::CheckReserves
($item->{itemnumber
});
195 if ( $itemtypes->{ $item->{itype
} }->{notforloan
} || $item->{notforloan
} || $item->{onloan
} || $item->{wthdrawn
} || $item->{itemlost
} || $item->{damaged
} ||
196 (defined $transfertwhen && $transfertwhen ne '') || $item->{itemnotforloan
} || (defined $reservestatus && $reservestatus eq "Waiting") ){
197 if ( $item->{notforloan
} < 0) {
198 $status = "On order";
200 if ( $item->{itemnotforloan
} > 0 || $item->{notforloan
} > 0 || $itemtypes->{ $item->{itype
} }->{notforloan
} == 1 ) {
201 $status = "reference";
203 if ($item->{onloan
}) {
204 $status = "Checked out";
206 if ( $item->{wthdrawn
}) {
207 $status = "Withdrawn";
209 if ($item->{itemlost
}) {
212 if ($item->{damaged
}) {
215 if (defined $transfertwhen && $transfertwhen ne '') {
216 $status = 'In transit';
218 if (defined $reservestatus && $reservestatus eq "Waiting") {
222 $status = "available";
224 my $homebranch = $item->{homebranch
}? xml_escape
($branches->{$item->{homebranch
}}->{'branchname'}):'';
225 my $itemcallnumber = xml_escape
($item->{itemcallnumber
});
226 $xml.= "<item><homebranch>$homebranch</homebranch>".
227 "<status>$status</status>".
228 "<itemcallnumber>".$itemcallnumber."</itemcallnumber>"
232 $xml = "<items xmlns=\"http://www.koha-community.org/items\">".$xml."</items>";
247 Joshua Ferraro <jmf@liblime.com>