|
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 |
- |
|
|