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