Lines 20-39
package C4::Record;
Link Here
|
20 |
# |
20 |
# |
21 |
# |
21 |
# |
22 |
use strict; |
22 |
use strict; |
|
|
23 |
|
23 |
#use warnings; FIXME - Bug 2505 |
24 |
#use warnings; FIXME - Bug 2505 |
24 |
|
25 |
|
25 |
# please specify in which methods a given module is used |
26 |
# please specify in which methods a given module is used |
26 |
use MARC::Record; # marc2marcxml, marcxml2marc, changeEncoding |
27 |
use MARC::Record; # marc2marcxml, marcxml2marc, changeEncoding |
27 |
use MARC::File::XML; # marc2marcxml, marcxml2marc, changeEncoding |
28 |
use MARC::File::XML; # marc2marcxml, marcxml2marc, changeEncoding |
28 |
use MARC::Crosswalk::DublinCore; # marc2dcxml |
29 |
use MARC::Crosswalk::DublinCore; # marc2dcxml |
29 |
use Biblio::EndnoteStyle; |
30 |
use Biblio::EndnoteStyle; |
30 |
use Unicode::Normalize; # _entity_encode |
31 |
use Unicode::Normalize; # _entity_encode |
31 |
use C4::Biblio; #marc2bibtex |
32 |
use C4::Biblio; #marc2bibtex |
32 |
use C4::Csv; #marc2csv |
33 |
use C4::Csv; #marc2csv |
33 |
use C4::Koha; #marc2csv |
34 |
use C4::Koha; #marc2csv |
34 |
use C4::XSLT (); |
35 |
use C4::XSLT (); |
35 |
use YAML; #marcrecords2csv |
36 |
use YAML; #marcrecords2csv |
36 |
use Text::CSV::Encoded; #marc2csv |
37 |
use Text::CSV::Encoded; #marc2csv |
37 |
use Koha::SimpleMARC qw(read_field); |
38 |
use Koha::SimpleMARC qw(read_field); |
38 |
|
39 |
|
39 |
use vars qw($VERSION @ISA @EXPORT); |
40 |
use vars qw($VERSION @ISA @EXPORT); |
Lines 77-110
Returns an ISO-2709 scalar
Link Here
|
77 |
=cut |
78 |
=cut |
78 |
|
79 |
|
79 |
sub marc2marc { |
80 |
sub marc2marc { |
80 |
my ($marc,$to_flavour,$from_flavour,$encoding) = @_; |
81 |
my ( $marc, $to_flavour, $from_flavour, $encoding ) = @_; |
81 |
my $error; |
82 |
my $error; |
82 |
if ($to_flavour =~ m/marcstd/) { |
83 |
if ( $to_flavour =~ m/marcstd/ ) { |
83 |
my $marc_record_obj; |
84 |
my $marc_record_obj; |
84 |
if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object |
85 |
if ( $marc =~ /^MARC::Record/ ) { # it's already a MARC::Record object |
85 |
$marc_record_obj = $marc; |
86 |
$marc_record_obj = $marc; |
86 |
} else { # it's not a MARC::Record object, make it one |
87 |
} |
|
|
88 |
else { # it's not a MARC::Record object, make it one |
87 |
eval { $marc_record_obj = MARC::Record->new_from_usmarc($marc) }; # handle exceptions |
89 |
eval { $marc_record_obj = MARC::Record->new_from_usmarc($marc) }; # handle exceptions |
88 |
|
90 |
|
89 |
# conversion to MARC::Record object failed, populate $error |
91 |
# conversion to MARC::Record object failed, populate $error |
90 |
if ($@) { $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR }; |
92 |
if ($@) { |
|
|
93 |
$error .= "\nCreation of MARC::Record object failed: " |
94 |
. $MARC::File::ERROR; |
95 |
} |
91 |
} |
96 |
} |
92 |
unless ($error) { |
97 |
unless ($error) { |
93 |
my @privatefields; |
98 |
my @privatefields; |
94 |
foreach my $field ($marc_record_obj->fields()) { |
99 |
foreach my $field ( $marc_record_obj->fields() ) { |
95 |
if ($field->tag() =~ m/9/ && ($field->tag() != '490' || C4::Context->preference("marcflavour") eq 'UNIMARC')) { |
100 |
if ( |
|
|
101 |
$field->tag() =~ m/9/ |
102 |
&& ( $field->tag() != '490' |
103 |
|| C4::Context->preference("marcflavour") eq 'UNIMARC' ) |
104 |
) |
105 |
{ |
96 |
push @privatefields, $field; |
106 |
push @privatefields, $field; |
97 |
} elsif (! ($field->is_control_field())) { |
107 |
} |
98 |
$field->delete_subfield(code => '9') if ($field->subfield('9')); |
108 |
elsif ( !( $field->is_control_field() ) ) { |
|
|
109 |
$field->delete_subfield( code => '9' ) |
110 |
if ( $field->subfield('9') ); |
99 |
} |
111 |
} |
100 |
} |
112 |
} |
101 |
$marc_record_obj->delete_field($_) for @privatefields; |
113 |
$marc_record_obj->delete_field($_) for @privatefields; |
102 |
$marc = $marc_record_obj->as_usmarc(); |
114 |
$marc = $marc_record_obj->as_usmarc(); |
103 |
} |
115 |
} |
104 |
} else { |
116 |
} |
|
|
117 |
else { |
105 |
$error = "Feature not yet implemented\n"; |
118 |
$error = "Feature not yet implemented\n"; |
106 |
} |
119 |
} |
107 |
return ($error,$marc); |
120 |
return ( $error, $marc ); |
108 |
} |
121 |
} |
109 |
|
122 |
|
110 |
=head2 marc2marcxml - Convert from ISO-2709 to MARCXML |
123 |
=head2 marc2marcxml - Convert from ISO-2709 to MARCXML |
Lines 124-188
C<$dont_entity_encode> - a flag that instructs marc2marcxml not to entity encode
Link Here
|
124 |
=cut |
137 |
=cut |
125 |
|
138 |
|
126 |
sub marc2marcxml { |
139 |
sub marc2marcxml { |
127 |
my ($marc,$encoding,$flavour,$dont_entity_encode) = @_; |
140 |
my ( $marc, $encoding, $flavour, $dont_entity_encode ) = @_; |
128 |
my $error; # the error string |
141 |
my $error; # the error string |
129 |
my $marcxml; # the final MARCXML scalar |
142 |
my $marcxml; # the final MARCXML scalar |
130 |
|
143 |
|
131 |
# test if it's already a MARC::Record object, if not, make it one |
144 |
# test if it's already a MARC::Record object, if not, make it one |
132 |
my $marc_record_obj; |
145 |
my $marc_record_obj; |
133 |
if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object |
146 |
if ( $marc =~ /^MARC::Record/ ) { # it's already a MARC::Record object |
134 |
$marc_record_obj = $marc; |
147 |
$marc_record_obj = $marc; |
135 |
} else { # it's not a MARC::Record object, make it one |
148 |
} |
136 |
eval { $marc_record_obj = MARC::Record->new_from_usmarc($marc) }; # handle exceptions |
149 |
else { # it's not a MARC::Record object, make it one |
137 |
|
150 |
eval { $marc_record_obj = MARC::Record->new_from_usmarc($marc) }; # handle exceptions |
138 |
# conversion to MARC::Record object failed, populate $error |
151 |
|
139 |
if ($@) { $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR }; |
152 |
# conversion to MARC::Record object failed, populate $error |
140 |
} |
153 |
if ($@) { |
141 |
# only proceed if no errors so far |
154 |
$error .= |
142 |
unless ($error) { |
155 |
"\nCreation of MARC::Record object failed: " . $MARC::File::ERROR; |
143 |
|
156 |
} |
144 |
# check the record for warnings |
157 |
} |
145 |
my @warnings = $marc_record_obj->warnings(); |
158 |
|
146 |
if (@warnings) { |
159 |
# only proceed if no errors so far |
147 |
warn "\nWarnings encountered while processing ISO-2709 record with title \"".$marc_record_obj->title()."\":\n"; |
160 |
unless ($error) { |
148 |
foreach my $warn (@warnings) { warn "\t".$warn }; |
161 |
|
149 |
} |
162 |
# check the record for warnings |
150 |
unless($encoding) {$encoding = "UTF-8"}; # set default encoding |
163 |
my @warnings = $marc_record_obj->warnings(); |
151 |
unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; # set default MARC flavour |
164 |
if (@warnings) { |
152 |
|
165 |
warn |
153 |
# attempt to convert the record to MARCXML |
166 |
"\nWarnings encountered while processing ISO-2709 record with title \"" |
154 |
eval { $marcxml = $marc_record_obj->as_xml_record($flavour) }; #handle exceptions |
167 |
. $marc_record_obj->title() . "\":\n"; |
155 |
|
168 |
foreach my $warn (@warnings) { warn "\t" . $warn } |
156 |
# record creation failed, populate $error |
169 |
} |
157 |
if ($@) { |
170 |
unless ($encoding) { $encoding = "UTF-8" } |
158 |
$error .= "Creation of MARCXML failed:".$MARC::File::ERROR; |
171 |
; # set default encoding |
159 |
$error .= "Additional information:\n"; |
172 |
unless ($flavour) { $flavour = C4::Context->preference("marcflavour") } |
160 |
my @warnings = $@->warnings(); |
173 |
; # set default MARC flavour |
161 |
foreach my $warn (@warnings) { $error.=$warn."\n" }; |
174 |
|
162 |
|
175 |
# attempt to convert the record to MARCXML |
163 |
# record creation was successful |
176 |
eval { $marcxml = $marc_record_obj->as_xml_record($flavour) }; #handle exceptions |
164 |
} else { |
177 |
|
165 |
|
178 |
# record creation failed, populate $error |
166 |
# check the record for warning flags again (warnings() will be cleared already if there was an error, see above block |
179 |
if ($@) { |
167 |
@warnings = $marc_record_obj->warnings(); |
180 |
$error .= "Creation of MARCXML failed:" . $MARC::File::ERROR; |
168 |
if (@warnings) { |
181 |
$error .= "Additional information:\n"; |
169 |
warn "\nWarnings encountered while processing ISO-2709 record with title \"".$marc_record_obj->title()."\":\n"; |
182 |
my @warnings = $@->warnings(); |
170 |
foreach my $warn (@warnings) { warn "\t".$warn }; |
183 |
foreach my $warn (@warnings) { $error .= $warn . "\n" } |
171 |
} |
184 |
|
172 |
} |
185 |
# record creation was successful |
173 |
|
186 |
} |
174 |
# only proceed if no errors so far |
187 |
else { |
175 |
unless ($error) { |
188 |
|
176 |
|
189 |
# check the record for warning flags again (warnings() will be cleared already if there was an error, see above block |
177 |
# entity encode the XML unless instructed not to |
190 |
@warnings = $marc_record_obj->warnings(); |
178 |
unless ($dont_entity_encode) { |
191 |
if (@warnings) { |
179 |
my ($marcxml_entity_encoded) = _entity_encode($marcxml); |
192 |
warn |
180 |
$marcxml = $marcxml_entity_encoded; |
193 |
"\nWarnings encountered while processing ISO-2709 record with title \"" |
181 |
} |
194 |
. $marc_record_obj->title() . "\":\n"; |
182 |
} |
195 |
foreach my $warn (@warnings) { warn "\t" . $warn } |
183 |
} |
196 |
} |
184 |
# return result to calling program |
197 |
} |
185 |
return ($error,$marcxml); |
198 |
|
|
|
199 |
# only proceed if no errors so far |
200 |
unless ($error) { |
201 |
|
202 |
# entity encode the XML unless instructed not to |
203 |
unless ($dont_entity_encode) { |
204 |
my ($marcxml_entity_encoded) = _entity_encode($marcxml); |
205 |
$marcxml = $marcxml_entity_encoded; |
206 |
} |
207 |
} |
208 |
} |
209 |
|
210 |
# return result to calling program |
211 |
return ( $error, $marcxml ); |
186 |
} |
212 |
} |
187 |
|
213 |
|
188 |
=head2 marcxml2marc - Convert from MARCXML to ISO-2709 |
214 |
=head2 marcxml2marc - Convert from MARCXML to ISO-2709 |
Lines 200-220
C<$flavour> - MARC21 or UNIMARC
Link Here
|
200 |
=cut |
226 |
=cut |
201 |
|
227 |
|
202 |
sub marcxml2marc { |
228 |
sub marcxml2marc { |
203 |
my ($marcxml,$encoding,$flavour) = @_; |
229 |
my ( $marcxml, $encoding, $flavour ) = @_; |
204 |
my $error; # the error string |
230 |
my $error; # the error string |
205 |
my $marc; # the final ISO-2709 scalar |
231 |
my $marc; # the final ISO-2709 scalar |
206 |
unless($encoding) {$encoding = "UTF-8"}; # set the default encoding |
232 |
unless ($encoding) { $encoding = "UTF-8" } |
207 |
unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; # set the default MARC flavour |
233 |
; # set the default encoding |
208 |
|
234 |
unless ($flavour) { $flavour = C4::Context->preference("marcflavour") } |
209 |
# attempt to do the conversion |
235 |
; # set the default MARC flavour |
210 |
eval { $marc = MARC::Record->new_from_xml($marcxml,$encoding,$flavour) }; # handle exceptions |
236 |
|
211 |
|
237 |
# attempt to do the conversion |
212 |
# record creation failed, populate $error |
238 |
eval { $marc = MARC::Record->new_from_xml( $marcxml, $encoding, $flavour ) }; # handle exceptions |
213 |
if ($@) {$error .="\nCreation of MARCXML Record failed: ".$@; |
239 |
|
214 |
$error.=$MARC::File::ERROR if ($MARC::File::ERROR); |
240 |
# record creation failed, populate $error |
215 |
}; |
241 |
if ($@) { |
216 |
# return result to calling program |
242 |
$error .= "\nCreation of MARCXML Record failed: " . $@; |
217 |
return ($error,$marc); |
243 |
$error .= $MARC::File::ERROR if ($MARC::File::ERROR); |
|
|
244 |
} |
245 |
|
246 |
# return result to calling program |
247 |
return ( $error, $marc ); |
218 |
} |
248 |
} |
219 |
|
249 |
|
220 |
=head2 marc2dcxml - Convert from ISO-2709 to Dublin Core |
250 |
=head2 marc2dcxml - Convert from ISO-2709 to Dublin Core |
Lines 232-269
C<$qualified> - specify whether qualified Dublin Core should be used in the inpu
Link Here
|
232 |
=cut |
262 |
=cut |
233 |
|
263 |
|
234 |
sub marc2dcxml { |
264 |
sub marc2dcxml { |
235 |
my ($marc,$qualified) = @_; |
265 |
my ( $marc, $qualified ) = @_; |
236 |
my $error; |
266 |
my $error; |
|
|
267 |
|
237 |
# test if it's already a MARC::Record object, if not, make it one |
268 |
# test if it's already a MARC::Record object, if not, make it one |
238 |
my $marc_record_obj; |
269 |
my $marc_record_obj; |
239 |
if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object |
270 |
if ( $marc =~ /^MARC::Record/ ) { # it's already a MARC::Record object |
240 |
$marc_record_obj = $marc; |
271 |
$marc_record_obj = $marc; |
241 |
} else { # it's not a MARC::Record object, make it one |
272 |
} |
242 |
eval { $marc_record_obj = MARC::Record->new_from_usmarc($marc) }; # handle exceptions |
273 |
else { # it's not a MARC::Record object, make it one |
243 |
|
274 |
eval { $marc_record_obj = MARC::Record->new_from_usmarc($marc) }; # handle exceptions |
244 |
# conversion to MARC::Record object failed, populate $error |
275 |
|
245 |
if ($@) { |
276 |
# conversion to MARC::Record object failed, populate $error |
246 |
$error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR; |
277 |
if ($@) { |
247 |
} |
278 |
$error .= |
248 |
} |
279 |
"\nCreation of MARC::Record object failed: " . $MARC::File::ERROR; |
249 |
my $crosswalk = MARC::Crosswalk::DublinCore->new; |
280 |
} |
250 |
if ($qualified) { |
281 |
} |
251 |
$crosswalk = MARC::Crosswalk::DublinCore->new( qualified => 1 ); |
282 |
my $crosswalk = MARC::Crosswalk::DublinCore->new; |
252 |
} |
283 |
if ($qualified) { |
253 |
my $dcxml = $crosswalk->as_dublincore($marc_record_obj); |
284 |
$crosswalk = MARC::Crosswalk::DublinCore->new( qualified => 1 ); |
254 |
my $dcxmlfinal = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"; |
285 |
} |
255 |
$dcxmlfinal .= "<metadata |
286 |
my $dcxml = $crosswalk->as_dublincore($marc_record_obj); |
|
|
287 |
my $dcxmlfinal = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"; |
288 |
$dcxmlfinal .= "<metadata |
256 |
xmlns=\"http://example.org/myapp/\" |
289 |
xmlns=\"http://example.org/myapp/\" |
257 |
xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" |
290 |
xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" |
258 |
xsi:schemaLocation=\"http://example.org/myapp/ http://example.org/myapp/schema.xsd\" |
291 |
xsi:schemaLocation=\"http://example.org/myapp/ http://example.org/myapp/schema.xsd\" |
259 |
xmlns:dc=\"http://purl.org/dc/elements/1.1/\" |
292 |
xmlns:dc=\"http://purl.org/dc/elements/1.1/\" |
260 |
xmlns:dcterms=\"http://purl.org/dc/terms/\">"; |
293 |
xmlns:dcterms=\"http://purl.org/dc/terms/\">"; |
261 |
|
294 |
|
262 |
foreach my $element ( $dcxml->elements() ) { |
295 |
foreach my $element ( $dcxml->elements() ) { |
263 |
$dcxmlfinal.="<"."dc:".$element->name().">".$element->content()."</"."dc:".$element->name().">\n"; |
296 |
$dcxmlfinal .= |
|
|
297 |
"<" . "dc:" |
298 |
. $element->name() . ">" |
299 |
. $element->content() . "</" . "dc:" |
300 |
. $element->name() . ">\n"; |
264 |
} |
301 |
} |
265 |
$dcxmlfinal .= "\n</metadata>"; |
302 |
$dcxmlfinal .= "\n</metadata>"; |
266 |
return ($error,$dcxmlfinal); |
303 |
return ( $error, $dcxmlfinal ); |
267 |
} |
304 |
} |
268 |
|
305 |
|
269 |
=head2 marc2modsxml - Convert from ISO-2709 to MODS |
306 |
=head2 marc2modsxml - Convert from ISO-2709 to MODS |
Lines 276-282
Returns a MODS scalar
Link Here
|
276 |
|
313 |
|
277 |
sub marc2modsxml { |
314 |
sub marc2modsxml { |
278 |
my ($marc) = @_; |
315 |
my ($marc) = @_; |
279 |
return _transformWithStylesheet($marc, "/prog/en/xslt/MARC21slim2MODS3-1.xsl"); |
316 |
return _transformWithStylesheet( $marc, |
|
|
317 |
"/prog/en/xslt/MARC21slim2MODS3-1.xsl" ); |
280 |
} |
318 |
} |
281 |
|
319 |
|
282 |
=head2 marc2madsxml - Convert from ISO-2709 to MADS |
320 |
=head2 marc2madsxml - Convert from ISO-2709 to MADS |
Lines 289-295
Returns a MADS scalar
Link Here
|
289 |
|
327 |
|
290 |
sub marc2madsxml { |
328 |
sub marc2madsxml { |
291 |
my ($marc) = @_; |
329 |
my ($marc) = @_; |
292 |
return _transformWithStylesheet($marc, "/prog/en/xslt/MARC21slim2MADS.xsl"); |
330 |
return _transformWithStylesheet( $marc, |
|
|
331 |
"/prog/en/xslt/MARC21slim2MADS.xsl" ); |
293 |
} |
332 |
} |
294 |
|
333 |
|
295 |
=head2 _transformWithStylesheet - Transform a MARC record with a stylesheet |
334 |
=head2 _transformWithStylesheet - Transform a MARC record with a stylesheet |
Lines 302-317
contain the path to a stylesheet under intrahtdocs.
Link Here
|
302 |
=cut |
341 |
=cut |
303 |
|
342 |
|
304 |
sub _transformWithStylesheet { |
343 |
sub _transformWithStylesheet { |
305 |
my ($marc, $stylesheet) = @_; |
344 |
my ( $marc, $stylesheet ) = @_; |
|
|
345 |
|
306 |
# grab the XML, run it through our stylesheet, push it out to the browser |
346 |
# grab the XML, run it through our stylesheet, push it out to the browser |
307 |
my $xmlrecord = marc2marcxml($marc); |
347 |
my $xmlrecord = marc2marcxml($marc); |
308 |
my $xslfile = C4::Context->config('intrahtdocs') . $stylesheet; |
348 |
my $xslfile = C4::Context->config('intrahtdocs') . $stylesheet; |
309 |
return C4::XSLT::engine->transform($xmlrecord, $xslfile); |
349 |
return C4::XSLT::engine->transform( $xmlrecord, $xslfile ); |
310 |
} |
350 |
} |
311 |
|
351 |
|
312 |
sub marc2endnote { |
352 |
sub marc2endnote { |
313 |
my ($marc) = @_; |
353 |
my ($marc) = @_; |
314 |
my $marc_rec_obj = MARC::Record->new_from_usmarc($marc); |
354 |
my $marc_rec_obj = MARC::Record->new_from_usmarc($marc); |
315 |
my ( $abstract, $f260a, $f710a ); |
355 |
my ( $abstract, $f260a, $f710a ); |
316 |
my $f260 = $marc_rec_obj->field('260'); |
356 |
my $f260 = $marc_rec_obj->field('260'); |
317 |
if ($f260) { |
357 |
if ($f260) { |
Lines 325-351
sub marc2endnote {
Link Here
|
325 |
if ($f500) { |
365 |
if ($f500) { |
326 |
$abstract = $f500->subfield('a'); |
366 |
$abstract = $f500->subfield('a'); |
327 |
} |
367 |
} |
328 |
my $fields = { |
368 |
my $fields = { |
329 |
DB => C4::Context->preference("LibraryName"), |
369 |
DB => C4::Context->preference("LibraryName"), |
330 |
Title => $marc_rec_obj->title(), |
370 |
Title => $marc_rec_obj->title(), |
331 |
Author => $marc_rec_obj->author(), |
371 |
Author => $marc_rec_obj->author(), |
332 |
Publisher => $f710a, |
372 |
Publisher => $f710a, |
333 |
City => $f260a, |
373 |
City => $f260a, |
334 |
Year => $marc_rec_obj->publication_date, |
374 |
Year => $marc_rec_obj->publication_date, |
335 |
Abstract => $abstract, |
375 |
Abstract => $abstract, |
336 |
}; |
376 |
}; |
337 |
my $endnote; |
377 |
my $endnote; |
338 |
my $style = new Biblio::EndnoteStyle(); |
378 |
my $style = new Biblio::EndnoteStyle(); |
339 |
my $template; |
379 |
my $template; |
340 |
$template.= "DB - DB\n" if C4::Context->preference("LibraryName"); |
380 |
$template .= "DB - DB\n" if C4::Context->preference("LibraryName"); |
341 |
$template.="T1 - Title\n" if $marc_rec_obj->title(); |
381 |
$template .= "T1 - Title\n" if $marc_rec_obj->title(); |
342 |
$template.="A1 - Author\n" if $marc_rec_obj->author(); |
382 |
$template .= "A1 - Author\n" if $marc_rec_obj->author(); |
343 |
$template.="PB - Publisher\n" if $f710a; |
383 |
$template .= "PB - Publisher\n" if $f710a; |
344 |
$template.="CY - City\n" if $f260a; |
384 |
$template .= "CY - City\n" if $f260a; |
345 |
$template.="Y1 - Year\n" if $marc_rec_obj->publication_date; |
385 |
$template .= "Y1 - Year\n" if $marc_rec_obj->publication_date; |
346 |
$template.="AB - Abstract\n" if $abstract; |
386 |
$template .= "AB - Abstract\n" if $abstract; |
347 |
my ($text, $errmsg) = $style->format($template, $fields); |
387 |
my ( $text, $errmsg ) = $style->format( $template, $fields ); |
348 |
return ($text); |
388 |
return ($text); |
349 |
|
389 |
|
350 |
} |
390 |
} |
351 |
|
391 |
|
Lines 366-396
C<$itemnumbers> - a list of itemnumbers to export
Link Here
|
366 |
=cut |
406 |
=cut |
367 |
|
407 |
|
368 |
sub marc2csv { |
408 |
sub marc2csv { |
369 |
my ($biblios, $id, $itemnumbers) = @_; |
409 |
my ( $biblios, $id, $itemnumbers ) = @_; |
370 |
$itemnumbers ||= []; |
410 |
$itemnumbers ||= []; |
371 |
my $output; |
411 |
my $output; |
372 |
my $csv = Text::CSV::Encoded->new(); |
412 |
my $csv = Text::CSV::Encoded->new(); |
373 |
|
413 |
|
374 |
# Getting yaml file |
414 |
# Getting yaml file |
375 |
my $configfile = "../tools/csv-profiles/$id.yaml"; |
415 |
my $configfile = "../tools/csv-profiles/$id.yaml"; |
376 |
my ($preprocess, $postprocess, $fieldprocessing); |
416 |
my ( $preprocess, $postprocess, $fieldprocessing ); |
377 |
if (-e $configfile){ |
417 |
if ( -e $configfile ) { |
378 |
($preprocess,$postprocess, $fieldprocessing) = YAML::LoadFile($configfile); |
418 |
( $preprocess, $postprocess, $fieldprocessing ) = |
|
|
419 |
YAML::LoadFile($configfile); |
379 |
} |
420 |
} |
380 |
|
421 |
|
381 |
# Preprocessing |
422 |
# Preprocessing |
382 |
eval $preprocess if ($preprocess); |
423 |
eval $preprocess if ($preprocess); |
383 |
|
424 |
|
384 |
my $firstpass = 1; |
425 |
my $firstpass = 1; |
385 |
if ( @$itemnumbers ) { |
426 |
if (@$itemnumbers) { |
386 |
for my $itemnumber ( @$itemnumbers) { |
427 |
for my $itemnumber (@$itemnumbers) { |
387 |
my $biblionumber = GetBiblionumberFromItemnumber $itemnumber; |
428 |
my $biblionumber = GetBiblionumberFromItemnumber $itemnumber; |
388 |
$output .= marcrecord2csv( $biblionumber, $id, $firstpass, $csv, $fieldprocessing, [$itemnumber] ); |
429 |
$output .= marcrecord2csv( $biblionumber, $id, $firstpass, $csv, |
|
|
430 |
$fieldprocessing, [$itemnumber] ); |
389 |
$firstpass = 0; |
431 |
$firstpass = 0; |
390 |
} |
432 |
} |
391 |
} else { |
433 |
} |
|
|
434 |
else { |
392 |
foreach my $biblio (@$biblios) { |
435 |
foreach my $biblio (@$biblios) { |
393 |
$output .= marcrecord2csv( $biblio, $id, $firstpass, $csv, $fieldprocessing ); |
436 |
$output .= marcrecord2csv( $biblio, $id, $firstpass, $csv, |
|
|
437 |
$fieldprocessing ); |
394 |
$firstpass = 0; |
438 |
$firstpass = 0; |
395 |
} |
439 |
} |
396 |
} |
440 |
} |
Lines 421-435
C<$itemnumbers> a list of itemnumbers to export
Link Here
|
421 |
|
465 |
|
422 |
=cut |
466 |
=cut |
423 |
|
467 |
|
424 |
|
|
|
425 |
sub marcrecord2csv { |
468 |
sub marcrecord2csv { |
426 |
my ($biblio, $id, $header, $csv, $fieldprocessing, $itemnumbers) = @_; |
469 |
my ( $biblio, $id, $header, $csv, $fieldprocessing, $itemnumbers ) = @_; |
427 |
my $output; |
470 |
my $output; |
428 |
|
471 |
|
429 |
# Getting the record |
472 |
# Getting the record |
430 |
my $record = GetMarcBiblio($biblio); |
473 |
my $record = GetMarcBiblio($biblio); |
431 |
next unless $record; |
474 |
next unless $record; |
432 |
C4::Biblio::EmbedItemsInMarcBiblio( $record, $biblio, $itemnumbers ); |
475 |
C4::Biblio::EmbedItemsInMarcBiblio( $record, $biblio, $itemnumbers ); |
|
|
476 |
|
433 |
# Getting the framework |
477 |
# Getting the framework |
434 |
my $frameworkcode = GetFrameworkCode($biblio); |
478 |
my $frameworkcode = GetFrameworkCode($biblio); |
435 |
|
479 |
|
Lines 437-566
sub marcrecord2csv {
Link Here
|
437 |
my $profile = GetCsvProfile($id); |
481 |
my $profile = GetCsvProfile($id); |
438 |
|
482 |
|
439 |
# Getting output encoding |
483 |
# Getting output encoding |
440 |
my $encoding = $profile->{encoding} || 'utf8'; |
484 |
my $encoding = $profile->{encoding} || 'utf8'; |
|
|
485 |
|
441 |
# Getting separators |
486 |
# Getting separators |
442 |
my $csvseparator = $profile->{csv_separator} || ','; |
487 |
my $csvseparator = $profile->{csv_separator} || ','; |
443 |
my $fieldseparator = $profile->{field_separator} || '#'; |
488 |
my $fieldseparator = $profile->{field_separator} || '#'; |
444 |
my $subfieldseparator = $profile->{subfield_separator} || '|'; |
489 |
my $subfieldseparator = $profile->{subfield_separator} || '|'; |
445 |
|
490 |
|
446 |
# TODO: Be more generic (in case we have to handle other protected chars or more separators) |
491 |
# TODO: Be more generic (in case we have to handle other protected chars or more separators) |
447 |
if ($csvseparator eq '\t') { $csvseparator = "\t" } |
492 |
if ( $csvseparator eq '\t' ) { $csvseparator = "\t" } |
448 |
if ($fieldseparator eq '\t') { $fieldseparator = "\t" } |
493 |
if ( $fieldseparator eq '\t' ) { $fieldseparator = "\t" } |
449 |
if ($subfieldseparator eq '\t') { $subfieldseparator = "\t" } |
494 |
if ( $subfieldseparator eq '\t' ) { $subfieldseparator = "\t" } |
450 |
if ($csvseparator eq '\n') { $csvseparator = "\n" } |
495 |
if ( $csvseparator eq '\n' ) { $csvseparator = "\n" } |
451 |
if ($fieldseparator eq '\n') { $fieldseparator = "\n" } |
496 |
if ( $fieldseparator eq '\n' ) { $fieldseparator = "\n" } |
452 |
if ($subfieldseparator eq '\n') { $subfieldseparator = "\n" } |
497 |
if ( $subfieldseparator eq '\n' ) { $subfieldseparator = "\n" } |
453 |
|
498 |
|
454 |
$csv = $csv->encoding_out($encoding) ; |
499 |
$csv = $csv->encoding_out($encoding); |
455 |
$csv->sep_char($csvseparator); |
500 |
$csv->sep_char($csvseparator); |
456 |
|
501 |
|
457 |
# Getting the marcfields |
502 |
# Getting the marcfields |
458 |
my $marcfieldslist = $profile->{content}; |
503 |
my $marcfieldslist = $profile->{content}; |
459 |
|
504 |
|
460 |
# Getting the marcfields as an array |
505 |
# Getting the marcfields as an array |
461 |
my @marcfieldsarray = split('\|', $marcfieldslist); |
506 |
my @marcfieldsarray = split( '\|', $marcfieldslist ); |
462 |
|
507 |
|
463 |
# Separating the marcfields from the user-supplied headers |
508 |
# Separating the marcfields from the user-supplied headers |
464 |
my @marcfields; |
509 |
my @marcfields; |
465 |
foreach (@marcfieldsarray) { |
510 |
foreach (@marcfieldsarray) { |
466 |
my @result = split('=', $_); |
511 |
my @result = split( '=', $_ ); |
467 |
if (scalar(@result) == 2) { |
512 |
if ( scalar(@result) == 2 ) { |
468 |
push @marcfields, { header => $result[0], field => $result[1] }; |
513 |
push @marcfields, { header => $result[0], field => $result[1] }; |
469 |
} else { |
514 |
} |
470 |
push @marcfields, { field => $result[0] } |
515 |
else { |
|
|
516 |
push @marcfields, { field => $result[0] }; |
471 |
} |
517 |
} |
472 |
} |
518 |
} |
473 |
|
519 |
|
474 |
# If we have to insert the headers |
520 |
# If we have to insert the headers |
475 |
if ($header) { |
521 |
if ($header) { |
476 |
my @marcfieldsheaders; |
522 |
my @marcfieldsheaders; |
477 |
my $dbh = C4::Context->dbh; |
523 |
my $dbh = C4::Context->dbh; |
478 |
|
524 |
|
479 |
# For each field or subfield |
525 |
# For each field or subfield |
480 |
foreach (@marcfields) { |
526 |
foreach (@marcfields) { |
481 |
|
527 |
|
482 |
my $field = $_->{field}; |
528 |
my $field = $_->{field}; |
483 |
# Remove any blank char that might have unintentionally insered into the tag name |
529 |
|
484 |
$field =~ s/\s+//g; |
530 |
# Remove any blank char that might have unintentionally insered into the tag name |
485 |
|
531 |
$field =~ s/\s+//g; |
486 |
# If we have a user-supplied header, we use it |
532 |
|
487 |
if (exists $_->{header}) { |
533 |
# If we have a user-supplied header, we use it |
488 |
push @marcfieldsheaders, $_->{header}; |
534 |
if ( exists $_->{header} ) { |
489 |
} else { |
535 |
push @marcfieldsheaders, $_->{header}; |
490 |
# If not, we get the matching tag name from koha |
536 |
} |
491 |
if (index($field, '$') > 0) { |
537 |
else { |
492 |
my ($fieldtag, $subfieldtag) = split('\$', $field); |
538 |
# If not, we get the matching tag name from koha |
493 |
my $query = "SELECT liblibrarian FROM marc_subfield_structure WHERE tagfield=? AND tagsubfield=?"; |
539 |
if ( index( $field, '$' ) > 0 ) { |
494 |
my $sth = $dbh->prepare($query); |
540 |
my ( $fieldtag, $subfieldtag ) = split( '\$', $field ); |
495 |
$sth->execute($fieldtag, $subfieldtag); |
541 |
my $query = |
496 |
my @results = $sth->fetchrow_array(); |
542 |
"SELECT liblibrarian FROM marc_subfield_structure WHERE tagfield=? AND tagsubfield=?"; |
497 |
push @marcfieldsheaders, $results[0]; |
543 |
my $sth = $dbh->prepare($query); |
498 |
} else { |
544 |
$sth->execute( $fieldtag, $subfieldtag ); |
499 |
my $query = "SELECT liblibrarian FROM marc_tag_structure WHERE tagfield=?"; |
545 |
my @results = $sth->fetchrow_array(); |
500 |
my $sth = $dbh->prepare($query); |
546 |
push @marcfieldsheaders, $results[0]; |
501 |
$sth->execute($field); |
547 |
} |
502 |
my @results = $sth->fetchrow_array(); |
548 |
else { |
503 |
push @marcfieldsheaders, $results[0]; |
549 |
my $query = |
504 |
} |
550 |
"SELECT liblibrarian FROM marc_tag_structure WHERE tagfield=?"; |
505 |
} |
551 |
my $sth = $dbh->prepare($query); |
506 |
} |
552 |
$sth->execute($field); |
507 |
$csv->combine(@marcfieldsheaders); |
553 |
my @results = $sth->fetchrow_array(); |
508 |
$output = $csv->string() . "\n"; |
554 |
push @marcfieldsheaders, $results[0]; |
|
|
555 |
} |
556 |
} |
557 |
} |
558 |
$csv->combine(@marcfieldsheaders); |
559 |
$output = $csv->string() . "\n"; |
509 |
} |
560 |
} |
510 |
|
561 |
|
511 |
# For each marcfield to export |
562 |
# For each marcfield to export |
512 |
my @fieldstab; |
563 |
my @fieldstab; |
513 |
foreach (@marcfields) { |
564 |
foreach (@marcfields) { |
514 |
my $marcfield = $_->{field}; |
565 |
my $marcfield = $_->{field}; |
515 |
# If it is a subfield |
566 |
|
516 |
if (index($marcfield, '$') > 0) { |
567 |
# If it is a subfield |
517 |
my ($fieldtag, $subfieldtag) = split('\$', $marcfield); |
568 |
if ( index( $marcfield, '$' ) > 0 ) { |
518 |
my @fields = $record->field($fieldtag); |
569 |
my ( $fieldtag, $subfieldtag ) = split( '\$', $marcfield ); |
519 |
my @tmpfields; |
570 |
my @fields = $record->field($fieldtag); |
520 |
|
571 |
my @tmpfields; |
521 |
# For each field |
572 |
|
522 |
foreach my $field (@fields) { |
573 |
# For each field |
523 |
|
574 |
foreach my $field (@fields) { |
524 |
# We take every matching subfield |
575 |
|
525 |
my @subfields = $field->subfield($subfieldtag); |
576 |
# We take every matching subfield |
526 |
foreach my $subfield (@subfields) { |
577 |
my @subfields = $field->subfield($subfieldtag); |
527 |
|
|
|
528 |
# Getting authorised value |
529 |
my $authvalues = GetKohaAuthorisedValuesFromField($fieldtag, $subfieldtag, $frameworkcode, undef); |
530 |
push @tmpfields, (defined $authvalues->{$subfield}) ? $authvalues->{$subfield} : $subfield; |
531 |
} |
532 |
} |
533 |
push (@fieldstab, join($subfieldseparator, @tmpfields)); |
534 |
# Or a field |
535 |
} else { |
536 |
my @fields = ($record->field($marcfield)); |
537 |
my $authvalues = GetKohaAuthorisedValuesFromField($marcfield, undef, $frameworkcode, undef); |
538 |
|
539 |
my @valuesarray; |
540 |
foreach (@fields) { |
541 |
my $value; |
542 |
|
543 |
# If it is a control field |
544 |
if ($_->is_control_field) { |
545 |
$value = defined $authvalues->{$_->as_string} ? $authvalues->{$_->as_string} : $_->as_string; |
546 |
} else { |
547 |
# If it is a field, we gather all subfields, joined by the subfield separator |
548 |
my @subvaluesarray; |
549 |
my @subfields = $_->subfields; |
550 |
foreach my $subfield (@subfields) { |
578 |
foreach my $subfield (@subfields) { |
551 |
push (@subvaluesarray, defined $authvalues->{$subfield->[1]} ? $authvalues->{$subfield->[1]} : $subfield->[1]); |
579 |
|
|
|
580 |
# Getting authorised value |
581 |
my $authvalues = |
582 |
GetKohaAuthorisedValuesFromField( $fieldtag, |
583 |
$subfieldtag, $frameworkcode, undef ); |
584 |
push @tmpfields, |
585 |
( defined $authvalues->{$subfield} ) |
586 |
? $authvalues->{$subfield} |
587 |
: $subfield; |
552 |
} |
588 |
} |
553 |
$value = join ($subfieldseparator, @subvaluesarray); |
|
|
554 |
} |
589 |
} |
|
|
590 |
push( @fieldstab, join( $subfieldseparator, @tmpfields ) ); |
591 |
|
592 |
# Or a field |
593 |
} |
594 |
else { |
595 |
my @fields = ( $record->field($marcfield) ); |
596 |
my $authvalues = |
597 |
GetKohaAuthorisedValuesFromField( $marcfield, undef, |
598 |
$frameworkcode, undef ); |
599 |
|
600 |
my @valuesarray; |
601 |
foreach (@fields) { |
602 |
my $value; |
603 |
|
604 |
# If it is a control field |
605 |
if ( $_->is_control_field ) { |
606 |
$value = |
607 |
defined $authvalues->{ $_->as_string } |
608 |
? $authvalues->{ $_->as_string } |
609 |
: $_->as_string; |
610 |
} |
611 |
else { |
612 |
# If it is a field, we gather all subfields, joined by the subfield separator |
613 |
my @subvaluesarray; |
614 |
my @subfields = $_->subfields; |
615 |
foreach my $subfield (@subfields) { |
616 |
push( @subvaluesarray, |
617 |
defined $authvalues->{ $subfield->[1] } |
618 |
? $authvalues->{ $subfield->[1] } |
619 |
: $subfield->[1] ); |
620 |
} |
621 |
$value = join( $subfieldseparator, @subvaluesarray ); |
622 |
} |
555 |
|
623 |
|
556 |
# Field processing |
624 |
# Field processing |
557 |
eval $fieldprocessing if ($fieldprocessing); |
625 |
eval $fieldprocessing if ($fieldprocessing); |
558 |
|
626 |
|
559 |
push @valuesarray, $value; |
627 |
push @valuesarray, $value; |
|
|
628 |
} |
629 |
push( @fieldstab, join( $fieldseparator, @valuesarray ) ); |
560 |
} |
630 |
} |
561 |
push (@fieldstab, join($fieldseparator, @valuesarray)); |
631 |
} |
562 |
} |
|
|
563 |
}; |
564 |
|
632 |
|
565 |
$csv->combine(@fieldstab); |
633 |
$csv->combine(@fieldstab); |
566 |
$output .= $csv->string() . "\n"; |
634 |
$output .= $csv->string() . "\n"; |
Lines 569-575
sub marcrecord2csv {
Link Here
|
569 |
|
637 |
|
570 |
} |
638 |
} |
571 |
|
639 |
|
572 |
|
|
|
573 |
=head2 changeEncoding - Change the encoding of a record |
640 |
=head2 changeEncoding - Change the encoding of a record |
574 |
|
641 |
|
575 |
my ($error, $newrecord) = changeEncoding($record,$format,$flavour,$to_encoding,$from_encoding); |
642 |
my ($error, $newrecord) = changeEncoding($record,$format,$flavour,$to_encoding,$from_encoding); |
Lines 595-628
FIXME: shouldn't have to convert to and from xml/marc just to change encoding so
Link Here
|
595 |
=cut |
662 |
=cut |
596 |
|
663 |
|
597 |
sub changeEncoding { |
664 |
sub changeEncoding { |
598 |
my ($record,$format,$flavour,$to_encoding,$from_encoding) = @_; |
665 |
my ( $record, $format, $flavour, $to_encoding, $from_encoding ) = @_; |
599 |
my $newrecord; |
666 |
my $newrecord; |
600 |
my $error; |
667 |
my $error; |
601 |
unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; |
668 |
unless ($flavour) { $flavour = C4::Context->preference("marcflavour") } |
602 |
unless($to_encoding) {$to_encoding = "UTF-8"}; |
669 |
unless ($to_encoding) { $to_encoding = "UTF-8" } |
603 |
|
670 |
|
604 |
# ISO-2709 Record (MARC21 or UNIMARC) |
671 |
# ISO-2709 Record (MARC21 or UNIMARC) |
605 |
if (lc($format) =~ /^marc$/o) { |
672 |
if ( lc($format) =~ /^marc$/o ) { |
606 |
# if we're converting encoding of an ISO2709 file, we need to roundtrip through XML |
673 |
|
607 |
# because MARC::Record doesn't directly provide us with an encoding method |
674 |
# if we're converting encoding of an ISO2709 file, we need to roundtrip through XML |
608 |
# It's definitely less than idea and should be fixed eventually - kados |
675 |
# because MARC::Record doesn't directly provide us with an encoding method |
609 |
my $marcxml; # temporary storage of MARCXML scalar |
676 |
# It's definitely less than idea and should be fixed eventually - kados |
610 |
($error,$marcxml) = marc2marcxml($record,$to_encoding,$flavour); |
677 |
my $marcxml; # temporary storage of MARCXML scalar |
611 |
unless ($error) { |
678 |
( $error, $marcxml ) = marc2marcxml( $record, $to_encoding, $flavour ); |
612 |
($error,$newrecord) = marcxml2marc($marcxml,$to_encoding,$flavour); |
679 |
unless ($error) { |
613 |
} |
680 |
( $error, $newrecord ) = |
614 |
|
681 |
marcxml2marc( $marcxml, $to_encoding, $flavour ); |
615 |
# MARCXML Record |
682 |
} |
616 |
} elsif (lc($format) =~ /^marcxml$/o) { # MARCXML Record |
683 |
|
617 |
my $marc; |
684 |
# MARCXML Record |
618 |
($error,$marc) = marcxml2marc($record,$to_encoding,$flavour); |
685 |
} |
619 |
unless ($error) { |
686 |
elsif ( lc($format) =~ /^marcxml$/o ) { # MARCXML Record |
620 |
($error,$newrecord) = marc2marcxml($record,$to_encoding,$flavour); |
687 |
my $marc; |
621 |
} |
688 |
( $error, $marc ) = marcxml2marc( $record, $to_encoding, $flavour ); |
622 |
} else { |
689 |
unless ($error) { |
623 |
$error.="Unsupported record format:".$format; |
690 |
( $error, $newrecord ) = |
624 |
} |
691 |
marc2marcxml( $record, $to_encoding, $flavour ); |
625 |
return ($error,$newrecord); |
692 |
} |
|
|
693 |
} |
694 |
else { |
695 |
$error .= "Unsupported record format:" . $format; |
696 |
} |
697 |
return ( $error, $newrecord ); |
626 |
} |
698 |
} |
627 |
|
699 |
|
628 |
=head2 marc2bibtex - Convert from MARC21 and UNIMARC to BibTex |
700 |
=head2 marc2bibtex - Convert from MARC21 and UNIMARC to BibTex |
Lines 637-664
C<$id> - an id for the BibTex record (might be the biblionumber)
Link Here
|
637 |
|
709 |
|
638 |
=cut |
710 |
=cut |
639 |
|
711 |
|
640 |
|
|
|
641 |
sub marc2bibtex { |
712 |
sub marc2bibtex { |
642 |
my ($record, $id) = @_; |
713 |
my ( $record, $id ) = @_; |
643 |
my $tex; |
714 |
my $tex; |
644 |
my $marcflavour = C4::Context->preference("marcflavour"); |
715 |
my $marcflavour = C4::Context->preference("marcflavour"); |
645 |
|
716 |
|
646 |
# Authors |
717 |
# Authors |
647 |
my $author; |
718 |
my $author; |
648 |
my @texauthors; |
719 |
my @texauthors; |
649 |
my @authorFields = ('100','110','111','700','710','711'); |
720 |
my @authorFields = ( '100', '110', '111', '700', '710', '711' ); |
650 |
@authorFields = ('700','701','702','710','711','721') if ( $marcflavour eq "UNIMARC" ); |
721 |
@authorFields = ( '700', '701', '702', '710', '711', '721' ) |
|
|
722 |
if ( $marcflavour eq "UNIMARC" ); |
723 |
|
724 |
foreach my $field (@authorFields) { |
651 |
|
725 |
|
652 |
foreach my $field ( @authorFields ) { |
|
|
653 |
# author formatted surname, firstname |
726 |
# author formatted surname, firstname |
654 |
my $texauthor = ''; |
727 |
my $texauthor = ''; |
655 |
if ( $marcflavour eq "UNIMARC" ) { |
728 |
if ( $marcflavour eq "UNIMARC" ) { |
656 |
$texauthor = join ', ', |
729 |
$texauthor = join ', ', |
657 |
( $record->subfield($field,"a"), $record->subfield($field,"b") ); |
730 |
( |
658 |
} else { |
731 |
$record->subfield( $field, "a" ), |
659 |
$texauthor = $record->subfield($field,"a"); |
732 |
$record->subfield( $field, "b" ) |
660 |
} |
733 |
); |
661 |
push @texauthors, $texauthor if $texauthor; |
734 |
} |
|
|
735 |
else { |
736 |
$texauthor = $record->subfield( $field, "a" ); |
737 |
} |
738 |
push @texauthors, $texauthor if $texauthor; |
662 |
} |
739 |
} |
663 |
$author = join ' and ', @texauthors; |
740 |
$author = join ' and ', @texauthors; |
664 |
|
741 |
|
Lines 674-719
sub marc2bibtex {
Link Here
|
674 |
|
751 |
|
675 |
# Mandatory |
752 |
# Mandatory |
676 |
author => $author, |
753 |
author => $author, |
677 |
title => $record->subfield("200", "a") || "", |
754 |
title => $record->subfield( "200", "a" ) || "", |
678 |
editor => $record->subfield("210", "g") || "", |
755 |
editor => $record->subfield( "210", "g" ) || "", |
679 |
publisher => $record->subfield("210", "c") || "", |
756 |
publisher => $record->subfield( "210", "c" ) || "", |
680 |
year => $record->subfield("210", "d") || $record->subfield("210", "h") || "", |
757 |
year => $record->subfield( "210", "d" ) |
|
|
758 |
|| $record->subfield( "210", "h" ) |
759 |
|| "", |
681 |
|
760 |
|
682 |
# Optional |
761 |
# Optional |
683 |
volume => $record->subfield("200", "v") || "", |
762 |
volume => $record->subfield( "200", "v" ) || "", |
684 |
series => $record->subfield("225", "a") || "", |
763 |
series => $record->subfield( "225", "a" ) || "", |
685 |
address => $record->subfield("210", "a") || "", |
764 |
address => $record->subfield( "210", "a" ) || "", |
686 |
edition => $record->subfield("205", "a") || "", |
765 |
edition => $record->subfield( "205", "a" ) || "", |
687 |
note => $record->subfield("300", "a") || "", |
766 |
note => $record->subfield( "300", "a" ) || "", |
688 |
url => $record->subfield("856", "u") || "" |
767 |
url => $record->subfield( "856", "u" ) || "" |
689 |
); |
768 |
); |
690 |
} else { |
769 |
} |
|
|
770 |
else { |
691 |
|
771 |
|
692 |
# Marc21 to bibtex array |
772 |
# Marc21 to bibtex array |
693 |
@bh = ( |
773 |
@bh = ( |
694 |
|
774 |
|
695 |
# Mandatory |
775 |
# Mandatory |
696 |
author => $author, |
776 |
author => $author, |
697 |
title => $record->subfield("245", "a") || "", |
777 |
title => $record->subfield( "245", "a" ) |
698 |
editor => $record->subfield("260", "f") || "", |
778 |
|| "", |
699 |
publisher => $record->subfield("264", "b") || $record->subfield("260", "b") || "", |
779 |
editor => $record->subfield( "260", "f" ) |
700 |
year => $record->subfield("264", "c") || $record->subfield("260", "c") || $record->subfield("260", "g") || "", |
780 |
|| "", |
701 |
|
781 |
publisher => $record->subfield( "264", "b" ) |
702 |
# Optional |
782 |
|| $record->subfield( "260", "b" ) |
703 |
# unimarc to marc21 specification says not to convert 200$v to marc21 |
783 |
|| "", |
704 |
series => $record->subfield("490", "a") || "", |
784 |
year => $record->subfield( "264", "c" ) |
705 |
address => $record->subfield("264", "a") || $record->subfield("260", "a") || "", |
785 |
|| $record->subfield( "260", "c" ) |
706 |
edition => $record->subfield("250", "a") || "", |
786 |
|| $record->subfield( "260", "g" ) |
707 |
note => $record->subfield("500", "a") || "", |
787 |
|| "", |
708 |
url => $record->subfield("856", "u") || "" |
788 |
|
|
|
789 |
# Optional |
790 |
# unimarc to marc21 specification says not to convert 200$v to marc21 |
791 |
series => $record->subfield( "490", "a" ) || "", |
792 |
address => $record->subfield( "264", "a" ) |
793 |
|| $record->subfield( "260", "a" ) |
794 |
|| "", |
795 |
edition => $record->subfield( "250", "a" ) || "", |
796 |
note => $record->subfield( "500", "a" ) || "", |
797 |
url => $record->subfield( "856", "u" ) || "" |
709 |
); |
798 |
); |
710 |
} |
799 |
} |
711 |
|
800 |
|
712 |
my $BibtexExportAdditionalFields = C4::Context->preference('BibtexExportAdditionalFields'); |
801 |
my $BibtexExportAdditionalFields = |
|
|
802 |
C4::Context->preference('BibtexExportAdditionalFields'); |
713 |
my $additional_fields; |
803 |
my $additional_fields; |
714 |
if ($BibtexExportAdditionalFields) { |
804 |
if ($BibtexExportAdditionalFields) { |
715 |
$BibtexExportAdditionalFields = "$BibtexExportAdditionalFields\n\n"; |
805 |
$BibtexExportAdditionalFields = "$BibtexExportAdditionalFields\n\n"; |
716 |
$additional_fields = eval { YAML::Load($BibtexExportAdditionalFields); }; |
806 |
$additional_fields = |
|
|
807 |
eval { YAML::Load($BibtexExportAdditionalFields); }; |
717 |
if ($@) { |
808 |
if ($@) { |
718 |
warn "Unable to parse BibtexExportAdditionalFields : $@"; |
809 |
warn "Unable to parse BibtexExportAdditionalFields : $@"; |
719 |
$additional_fields = undef; |
810 |
$additional_fields = undef; |
Lines 722-728
sub marc2bibtex {
Link Here
|
722 |
|
813 |
|
723 |
if ( $additional_fields && $additional_fields->{'@'} ) { |
814 |
if ( $additional_fields && $additional_fields->{'@'} ) { |
724 |
my ( $f, $sf ) = split( /\$/, $additional_fields->{'@'} ); |
815 |
my ( $f, $sf ) = split( /\$/, $additional_fields->{'@'} ); |
725 |
my ( $type ) = read_field( { record => $record, field => $f, subfield => $sf, field_numbers => [1] } ); |
816 |
my ($type) = read_field( |
|
|
817 |
{ |
818 |
record => $record, |
819 |
field => $f, |
820 |
subfield => $sf, |
821 |
field_numbers => [1] |
822 |
} |
823 |
); |
726 |
|
824 |
|
727 |
if ($type) { |
825 |
if ($type) { |
728 |
$tex .= '@' . $type . '{'; |
826 |
$tex .= '@' . $type . '{'; |
Lines 736-746
sub marc2bibtex {
Link Here
|
736 |
} |
834 |
} |
737 |
|
835 |
|
738 |
my @elt; |
836 |
my @elt; |
739 |
for ( my $i = 0 ; $i < scalar( @bh ) ; $i = $i + 2 ) { |
837 |
for ( my $i = 0 ; $i < scalar(@bh) ; $i = $i + 2 ) { |
740 |
next unless $bh[$i+1]; |
838 |
next unless $bh[ $i + 1 ]; |
741 |
push @elt, qq|\t$bh[$i] = {$bh[$i+1]}|; |
839 |
push @elt, qq|\t$bh[$i] = {$bh[$i+1]}|; |
742 |
} |
840 |
} |
743 |
$tex .= join(",\n", $id, @elt); |
841 |
$tex .= join( ",\n", $id, @elt ); |
744 |
$tex .= "\n"; |
842 |
$tex .= "\n"; |
745 |
|
843 |
|
746 |
if ($additional_fields) { |
844 |
if ($additional_fields) { |
Lines 754-760
sub marc2bibtex {
Link Here
|
754 |
|
852 |
|
755 |
for my $tag (@fields) { |
853 |
for my $tag (@fields) { |
756 |
my ( $f, $sf ) = split( /\$/, $tag ); |
854 |
my ( $f, $sf ) = split( /\$/, $tag ); |
757 |
my @values = read_field( { record => $record, field => $f, subfield => $sf } ); |
855 |
my @values = read_field( |
|
|
856 |
{ record => $record, field => $f, subfield => $sf } ); |
758 |
foreach my $v (@values) { |
857 |
foreach my $v (@values) { |
759 |
$tex .= qq(\t$bibtex_tag = {$v}\n); |
858 |
$tex .= qq(\t$bibtex_tag = {$v}\n); |
760 |
} |
859 |
} |
Lines 767-773
sub marc2bibtex {
Link Here
|
767 |
return $tex; |
866 |
return $tex; |
768 |
} |
867 |
} |
769 |
|
868 |
|
770 |
|
|
|
771 |
=head1 INTERNAL FUNCTIONS |
869 |
=head1 INTERNAL FUNCTIONS |
772 |
|
870 |
|
773 |
=head2 _entity_encode - Entity-encode an array of strings |
871 |
=head2 _entity_encode - Entity-encode an array of strings |
Lines 783-799
Entity-encode an array of strings
Link Here
|
783 |
=cut |
881 |
=cut |
784 |
|
882 |
|
785 |
sub _entity_encode { |
883 |
sub _entity_encode { |
786 |
my @strings = @_; |
884 |
my @strings = @_; |
787 |
my @strings_entity_encoded; |
885 |
my @strings_entity_encoded; |
788 |
foreach my $string (@strings) { |
886 |
foreach my $string (@strings) { |
789 |
my $nfc_string = NFC($string); |
887 |
my $nfc_string = NFC($string); |
790 |
$nfc_string =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe; |
888 |
$nfc_string =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe; |
791 |
push @strings_entity_encoded, $nfc_string; |
889 |
push @strings_entity_encoded, $nfc_string; |
792 |
} |
890 |
} |
793 |
return @strings_entity_encoded; |
891 |
return @strings_entity_encoded; |
794 |
} |
892 |
} |
795 |
|
893 |
|
796 |
END { } # module clean-up code here (global destructor) |
894 |
END { } # module clean-up code here (global destructor) |
797 |
1; |
895 |
1; |
798 |
__END__ |
896 |
__END__ |
799 |
|
897 |
|
800 |
- |
|
|