Bug 14790 - Add Opac view link to search results
[koha.git] / C4 / Record.pm
blobd24d631d66c57fd162de1d3c7154b247fa456917
1 package C4::Record;
3 # Copyright 2006 (C) LibLime
4 # Parts copyright 2010 BibLibre
5 # Part copyright 2015 Universidad de El Salvador
7 # This file is part of Koha.
9 # Koha is free software; you can redistribute it and/or modify it
10 # under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 3 of the License, or
12 # (at your option) any later version.
14 # Koha is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 # GNU General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23 use strict;
24 #use warnings; FIXME - Bug 2505
26 # please specify in which methods a given module is used
27 use MARC::Record; # marc2marcxml, marcxml2marc, changeEncoding
28 use MARC::File::XML; # marc2marcxml, marcxml2marc, changeEncoding
29 use Biblio::EndnoteStyle;
30 use Unicode::Normalize; # _entity_encode
31 use C4::Biblio; #marc2bibtex
32 use C4::Csv; #marc2csv
33 use C4::Koha; #marc2csv
34 use C4::XSLT ();
35 use YAML; #marcrecords2csv
36 use Template;
37 use Text::CSV::Encoded; #marc2csv
38 use Koha::SimpleMARC qw(read_field);
39 use Koha::XSLT_Handler;
40 use Carp;
42 use vars qw(@ISA @EXPORT);
45 @ISA = qw(Exporter);
47 # only export API methods
49 @EXPORT = qw(
50 &marc2endnote
51 &marc2marc
52 &marc2marcxml
53 &marcxml2marc
54 &marc2dcxml
55 &marc2modsxml
56 &marc2madsxml
57 &marc2bibtex
58 &marc2csv
59 &changeEncoding
62 =head1 NAME
64 C4::Record - MARC, MARCXML, DC, MODS, XML, etc. Record Management Functions and API
66 =head1 SYNOPSIS
68 New in Koha 3.x. This module handles all record-related management functions.
70 =head1 API (EXPORTED FUNCTIONS)
72 =head2 marc2marc - Convert from one flavour of ISO-2709 to another
74 my ($error,$newmarc) = marc2marc($marc,$to_flavour,$from_flavour,$encoding);
76 Returns an ISO-2709 scalar
78 =cut
80 sub marc2marc {
81 my ($marc,$to_flavour,$from_flavour,$encoding) = @_;
82 my $error;
83 if ($to_flavour =~ m/marcstd/) {
84 my $marc_record_obj;
85 if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object
86 $marc_record_obj = $marc;
87 } else { # it's not a MARC::Record object, make it one
88 eval { $marc_record_obj = MARC::Record->new_from_usmarc($marc) }; # handle exceptions
90 # conversion to MARC::Record object failed, populate $error
91 if ($@) { $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR };
93 unless ($error) {
94 my @privatefields;
95 foreach my $field ($marc_record_obj->fields()) {
96 if ($field->tag() =~ m/9/ && ($field->tag() != '490' || C4::Context->preference("marcflavour") eq 'UNIMARC')) {
97 push @privatefields, $field;
98 } elsif (! ($field->is_control_field())) {
99 $field->delete_subfield(code => '9') if ($field->subfield('9'));
102 $marc_record_obj->delete_field($_) for @privatefields;
103 $marc = $marc_record_obj->as_usmarc();
105 } else {
106 $error = "Feature not yet implemented\n";
108 return ($error,$marc);
111 =head2 marc2marcxml - Convert from ISO-2709 to MARCXML
113 my ($error,$marcxml) = marc2marcxml($marc,$encoding,$flavour);
115 Returns a MARCXML scalar
117 C<$marc> - an ISO-2709 scalar or MARC::Record object
119 C<$encoding> - UTF-8 or MARC-8 [UTF-8]
121 C<$flavour> - MARC21 or UNIMARC
123 C<$dont_entity_encode> - a flag that instructs marc2marcxml not to entity encode the xml before returning (optional)
125 =cut
127 sub marc2marcxml {
128 my ($marc,$encoding,$flavour,$dont_entity_encode) = @_;
129 my $error; # the error string
130 my $marcxml; # the final MARCXML scalar
132 # test if it's already a MARC::Record object, if not, make it one
133 my $marc_record_obj;
134 if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object
135 $marc_record_obj = $marc;
136 } else { # it's not a MARC::Record object, make it one
137 eval { $marc_record_obj = MARC::Record->new_from_usmarc($marc) }; # handle exceptions
139 # conversion to MARC::Record object failed, populate $error
140 if ($@) { $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR };
142 # only proceed if no errors so far
143 unless ($error) {
145 # check the record for warnings
146 my @warnings = $marc_record_obj->warnings();
147 if (@warnings) {
148 warn "\nWarnings encountered while processing ISO-2709 record with title \"".$marc_record_obj->title()."\":\n";
149 foreach my $warn (@warnings) { warn "\t".$warn };
151 unless($encoding) {$encoding = "UTF-8"}; # set default encoding
152 unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; # set default MARC flavour
154 # attempt to convert the record to MARCXML
155 eval { $marcxml = $marc_record_obj->as_xml_record($flavour) }; #handle exceptions
157 # record creation failed, populate $error
158 if ($@) {
159 $error .= "Creation of MARCXML failed:".$MARC::File::ERROR;
160 $error .= "Additional information:\n";
161 my @warnings = $@->warnings();
162 foreach my $warn (@warnings) { $error.=$warn."\n" };
164 # record creation was successful
165 } else {
167 # check the record for warning flags again (warnings() will be cleared already if there was an error, see above block
168 @warnings = $marc_record_obj->warnings();
169 if (@warnings) {
170 warn "\nWarnings encountered while processing ISO-2709 record with title \"".$marc_record_obj->title()."\":\n";
171 foreach my $warn (@warnings) { warn "\t".$warn };
175 # only proceed if no errors so far
176 unless ($error) {
178 # entity encode the XML unless instructed not to
179 unless ($dont_entity_encode) {
180 my ($marcxml_entity_encoded) = _entity_encode($marcxml);
181 $marcxml = $marcxml_entity_encoded;
185 # return result to calling program
186 return ($error,$marcxml);
189 =head2 marcxml2marc - Convert from MARCXML to ISO-2709
191 my ($error,$marc) = marcxml2marc($marcxml,$encoding,$flavour);
193 Returns an ISO-2709 scalar
195 C<$marcxml> - a MARCXML record
197 C<$encoding> - UTF-8 or MARC-8 [UTF-8]
199 C<$flavour> - MARC21 or UNIMARC
201 =cut
203 sub marcxml2marc {
204 my ($marcxml,$encoding,$flavour) = @_;
205 my $error; # the error string
206 my $marc; # the final ISO-2709 scalar
207 unless($encoding) {$encoding = "UTF-8"}; # set the default encoding
208 unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; # set the default MARC flavour
210 # attempt to do the conversion
211 eval { $marc = MARC::Record->new_from_xml($marcxml,$encoding,$flavour) }; # handle exceptions
213 # record creation failed, populate $error
214 if ($@) {$error .="\nCreation of MARCXML Record failed: ".$@;
215 $error.=$MARC::File::ERROR if ($MARC::File::ERROR);
217 # return result to calling program
218 return ($error,$marc);
221 =head2 marc2dcxml - Convert from ISO-2709 to Dublin Core
223 my dcxml = marc2dcxml ($marc, $xml, $biblionumber, $format);
225 EXAMPLE
227 my dcxml = marc2dcxml (undef, undef, 1, "oaidc");
229 Convert MARC or MARCXML to Dublin Core metadata (XSLT Transformation),
230 optionally can get an XML directly from database (biblioitems.marcxml)
231 without item information. This method take into consideration the syspref
232 'marcflavour' (UNIMARC, MARC21 and NORMARC).
233 Return an XML file with the format defined in C<$format>
235 C<$marc> - an ISO-2709 scalar or MARC::Record object
237 C<$xml> - a MARCXML file
239 C<$biblionumber> - obtain the record directly from database (biblioitems.marcxml)
241 C<$format> - accept three type of DC formats (oaidc, srwdc, and rdfdc )
243 =cut
245 sub marc2dcxml {
246 my ( $marc, $xml, $biblionumber, $format ) = @_;
248 # global variables
249 my ( $marcxml, $record, $output );
251 # set the default path for intranet xslts
252 # differents xslts to process (OAIDC, SRWDC and RDFDC)
253 my $xsl = C4::Context->config('intrahtdocs') . '/prog/en/xslt/' .
254 C4::Context->preference('marcflavour') . 'slim2' . uc ( $format ) . '.xsl';
256 if ( defined $marc ) {
257 # no need to catch errors or warnings marc2marcxml do it instead
258 $marcxml = C4::Record::marc2marcxml( $marc );
259 } elsif ( not defined $xml and defined $biblionumber ) {
260 # get MARCXML biblio directly from biblioitems.marcxml without item information
261 $marcxml = C4::Biblio::GetXmlBiblio( $biblionumber );
262 } else {
263 $marcxml = $xml;
266 # only proceed if MARC21 or UNIMARC; else clause is executed if marcflavour set it to NORMARC
267 # generate MARC::Record object to see if not a marcxml record
268 unless ( C4::Context->preference('marcflavour') eq 'NORMARC' ) {
269 eval { $record = MARC::Record->new_from_xml(
270 $marcxml,
271 'UTF-8',
272 C4::Context->preference('marcflavour')
275 } else {
276 eval { $record = MARC::Record->new_from_xml(
277 $marcxml,
278 'UTF-8',
279 'MARC21'
284 # conversion to MARC::Record object failed
285 if ( $@ ) {
286 croak "Creation of MARC::Record object failed.";
287 } elsif ( $record->warnings() ) {
288 carp "Warnings encountered while processing ISO-2709 record.\n";
289 my @warnings = $record->warnings();
290 foreach my $warn (@warnings) {
291 carp "\t". $warn;
293 } elsif ( $record =~ /^MARC::Record/ ) { # if OK makes xslt transformation
294 my $xslt_engine = Koha::XSLT_Handler->new;
295 if ( $format =~ /oaidc|srwdc|rdfdc/ ) {
296 $output = $xslt_engine->transform( $marcxml, $xsl );
297 } else {
298 croak "The format argument ($format) not accepted.\n" .
299 "Please pass a valid format (oaidc, srwdc, or rdfdc)\n";
301 my $err = $xslt_engine->err; # error number
302 my $errstr = $xslt_engine->errstr; # error message
303 if ( $err ) {
304 croak "Error when processing $errstr Error number: $err\n";
305 } else {
306 return $output;
311 =head2 marc2modsxml - Convert from ISO-2709 to MODS
313 my $modsxml = marc2modsxml($marc);
315 Returns a MODS scalar
317 =cut
319 sub marc2modsxml {
320 my ($marc) = @_;
321 return _transformWithStylesheet($marc, "/prog/en/xslt/MARC21slim2MODS3-1.xsl");
324 =head2 marc2madsxml - Convert from ISO-2709 to MADS
326 my $madsxml = marc2madsxml($marc);
328 Returns a MADS scalar
330 =cut
332 sub marc2madsxml {
333 my ($marc) = @_;
334 return _transformWithStylesheet($marc, "/prog/en/xslt/MARC21slim2MADS.xsl");
337 =head2 _transformWithStylesheet - Transform a MARC record with a stylesheet
339 my $xml = _transformWithStylesheet($marc, $stylesheet)
341 Returns the XML scalar result of the transformation. $stylesheet should
342 contain the path to a stylesheet under intrahtdocs.
344 =cut
346 sub _transformWithStylesheet {
347 my ($marc, $stylesheet) = @_;
348 # grab the XML, run it through our stylesheet, push it out to the browser
349 my $xmlrecord = marc2marcxml($marc);
350 my $xslfile = C4::Context->config('intrahtdocs') . $stylesheet;
351 return C4::XSLT::engine->transform($xmlrecord, $xslfile);
354 sub marc2endnote {
355 my ($marc) = @_;
356 my $marc_rec_obj = MARC::Record->new_from_usmarc($marc);
357 my ( $abstract, $f260a, $f710a );
358 my $f260 = $marc_rec_obj->field('260');
359 if ($f260) {
360 $f260a = $f260->subfield('a') if $f260;
362 my $f710 = $marc_rec_obj->field('710');
363 if ($f710) {
364 $f710a = $f710->subfield('a');
366 my $f500 = $marc_rec_obj->field('500');
367 if ($f500) {
368 $abstract = $f500->subfield('a');
370 my $fields = {
371 DB => C4::Context->preference("LibraryName"),
372 Title => $marc_rec_obj->title(),
373 Author => $marc_rec_obj->author(),
374 Publisher => $f710a,
375 City => $f260a,
376 Year => $marc_rec_obj->publication_date,
377 Abstract => $abstract,
379 my $endnote;
380 my $style = new Biblio::EndnoteStyle();
381 my $template;
382 $template.= "DB - DB\n" if C4::Context->preference("LibraryName");
383 $template.="T1 - Title\n" if $marc_rec_obj->title();
384 $template.="A1 - Author\n" if $marc_rec_obj->author();
385 $template.="PB - Publisher\n" if $f710a;
386 $template.="CY - City\n" if $f260a;
387 $template.="Y1 - Year\n" if $marc_rec_obj->publication_date;
388 $template.="AB - Abstract\n" if $abstract;
389 my ($text, $errmsg) = $style->format($template, $fields);
390 return ($text);
394 =head2 marc2csv - Convert several records from UNIMARC to CSV
396 my ($csv) = marc2csv($biblios, $csvprofileid, $itemnumbers);
398 Pre and postprocessing can be done through a YAML file
400 Returns a CSV scalar
402 C<$biblio> - a list of biblionumbers
404 C<$csvprofileid> - the id of the CSV profile to use for the export (see export_format.export_format_id and the GetCsvProfiles function in C4::Csv)
406 C<$itemnumbers> - a list of itemnumbers to export
408 =cut
410 sub marc2csv {
411 my ($biblios, $id, $itemnumbers) = @_;
412 $itemnumbers ||= [];
413 my $output;
414 my $csv = Text::CSV::Encoded->new();
416 # Getting yaml file
417 my $configfile = "../tools/csv-profiles/$id.yaml";
418 my ($preprocess, $postprocess, $fieldprocessing);
419 if (-e $configfile){
420 ($preprocess,$postprocess, $fieldprocessing) = YAML::LoadFile($configfile);
423 # Preprocessing
424 eval $preprocess if ($preprocess);
426 my $firstpass = 1;
427 if ( @$itemnumbers ) {
428 for my $itemnumber ( @$itemnumbers) {
429 my $biblionumber = GetBiblionumberFromItemnumber $itemnumber;
430 $output .= marcrecord2csv( $biblionumber, $id, $firstpass, $csv, $fieldprocessing, [$itemnumber] );
431 $firstpass = 0;
433 } else {
434 foreach my $biblio (@$biblios) {
435 $output .= marcrecord2csv( $biblio, $id, $firstpass, $csv, $fieldprocessing );
436 $firstpass = 0;
440 # Postprocessing
441 eval $postprocess if ($postprocess);
443 return $output;
446 =head2 marcrecord2csv - Convert a single record from UNIMARC to CSV
448 my ($csv) = marcrecord2csv($biblio, $csvprofileid, $header);
450 Returns a CSV scalar
452 C<$biblio> - a biblionumber
454 C<$csvprofileid> - the id of the CSV profile to use for the export (see export_format.export_format_id and the GetCsvProfiles function in C4::Csv)
456 C<$header> - true if the headers are to be printed (typically at first pass)
458 C<$csv> - an already initialised Text::CSV object
460 C<$fieldprocessing>
462 C<$itemnumbers> a list of itemnumbers to export
464 =cut
466 sub marcrecord2csv {
467 my ($biblio, $id, $header, $csv, $fieldprocessing, $itemnumbers) = @_;
468 my $output;
470 # Getting the record
471 my $record = GetMarcBiblio($biblio);
472 return unless $record;
473 C4::Biblio::EmbedItemsInMarcBiblio( $record, $biblio, $itemnumbers );
474 # Getting the framework
475 my $frameworkcode = GetFrameworkCode($biblio);
477 # Getting information about the csv profile
478 my $profile = GetCsvProfile($id);
480 # Getting output encoding
481 my $encoding = $profile->{encoding} || 'utf8';
482 # Getting separators
483 my $csvseparator = $profile->{csv_separator} || ',';
484 my $fieldseparator = $profile->{field_separator} || '#';
485 my $subfieldseparator = $profile->{subfield_separator} || '|';
487 # TODO: Be more generic (in case we have to handle other protected chars or more separators)
488 if ($csvseparator eq '\t') { $csvseparator = "\t" }
489 if ($fieldseparator eq '\t') { $fieldseparator = "\t" }
490 if ($subfieldseparator eq '\t') { $subfieldseparator = "\t" }
491 if ($csvseparator eq '\n') { $csvseparator = "\n" }
492 if ($fieldseparator eq '\n') { $fieldseparator = "\n" }
493 if ($subfieldseparator eq '\n') { $subfieldseparator = "\n" }
495 $csv = $csv->encoding_out($encoding) ;
496 $csv->sep_char($csvseparator);
498 # Getting the marcfields
499 my $marcfieldslist = $profile->{content};
501 # Getting the marcfields as an array
502 my @marcfieldsarray = split('\|', $marcfieldslist);
504 # Separating the marcfields from the user-supplied headers
505 my @csv_structures;
506 foreach (@marcfieldsarray) {
507 my @result = split('=', $_, 2);
508 my $content = ( @result == 2 )
509 ? $result[1]
510 : $result[0];
511 my @fields;
512 while ( $content =~ m|(\d{3})\$?(.)?|g ) {
513 my $fieldtag = $1;
514 my $subfieldtag = $2 || undef;
515 push @fields, { fieldtag => $fieldtag, subfieldtag => $subfieldtag };
517 if ( @result == 2) {
518 push @csv_structures, { header => $result[0], content => $content, fields => \@fields };
519 } else {
520 push @csv_structures, { content => $content, fields => \@fields }
524 my ( @marcfieldsheaders, @csv_rows );
525 my $dbh = C4::Context->dbh;
527 my $field_list;
528 for my $field ( $record->fields ) {
529 my $fieldtag = $field->tag;
530 my $values;
531 if ( $field->is_control_field ) {
532 $values = $field->data();
533 } else {
534 $values->{indicator}{1} = $field->indicator(1);
535 $values->{indicator}{2} = $field->indicator(2);
536 for my $subfield ( $field->subfields ) {
537 my $subfieldtag = $subfield->[0];
538 my $value = $subfield->[1];
539 push @{ $values->{$subfieldtag} }, $value;
542 # We force the key as an integer (trick for 00X and OXX fields)
543 push @{ $field_list->{fields}{0+$fieldtag} }, $values;
546 # For each field or subfield
547 foreach my $csv_structure (@csv_structures) {
548 my @field_values;
549 my $tags = $csv_structure->{fields};
550 my $content = $csv_structure->{content};
552 if ( $header ) {
553 # If we have a user-supplied header, we use it
554 if ( exists $csv_structure->{header} ) {
555 push @marcfieldsheaders, $csv_structure->{header};
556 } else {
557 # If not, we get the matching tag name from koha
558 my $tag = $tags->[0];
559 if ( $tag->{subfieldtag} ) {
560 my $query = "SELECT liblibrarian FROM marc_subfield_structure WHERE tagfield=? AND tagsubfield=?";
561 my @results = $dbh->selectrow_array( $query, {}, $tag->{fieldtag}, $tag->{subfieldtag} );
562 push @marcfieldsheaders, $results[0];
563 } else {
564 my $query = "SELECT liblibrarian FROM marc_tag_structure WHERE tagfield=?";
565 my @results = $dbh->selectrow_array( $query, {}, $tag->{fieldtag} );
566 push @marcfieldsheaders, $results[0];
571 # TT tags exist
572 if ( $content =~ m|\[\%.*\%\]| ) {
573 my $tt = Template->new();
574 my $template = $content;
575 my $vars;
576 # Replace 00X and 0XX with X or XX
577 $content =~ s|fields.00(\d)|fields.$1|g;
578 $content =~ s|fields.0(\d{2})|fields.$1|g;
579 my $tt_output;
580 $tt->process( \$content, $field_list, \$tt_output );
581 push @csv_rows, $tt_output;
582 } else {
583 for my $tag ( @$tags ) {
584 my @fields = $record->field( $tag->{fieldtag} );
585 # If it is a subfield
586 my @loop_values;
587 if ( $tag->{subfieldtag} ) {
588 # For each field
589 foreach my $field (@fields) {
590 my @subfields = $field->subfield( $tag->{subfieldtag} );
591 foreach my $subfield (@subfields) {
592 my $authvalues = GetKohaAuthorisedValuesFromField( $tag->{fieldtag}, $tag->{subfieldtag}, $frameworkcode, undef);
593 push @loop_values, (defined $authvalues->{$subfield}) ? $authvalues->{$subfield} : $subfield;
597 # Or a field
598 } else {
599 my $authvalues = GetKohaAuthorisedValuesFromField( $tag->{fieldtag}, undef, $frameworkcode, undef);
601 foreach my $field ( @fields ) {
602 my $value;
604 # If it is a control field
605 if ($field->is_control_field) {
606 $value = defined $authvalues->{$field->as_string} ? $authvalues->{$field->as_string} : $field->as_string;
607 } else {
608 # If it is a field, we gather all subfields, joined by the subfield separator
609 my @subvaluesarray;
610 my @subfields = $field->subfields;
611 foreach my $subfield (@subfields) {
612 push (@subvaluesarray, defined $authvalues->{$subfield->[1]} ? $authvalues->{$subfield->[1]} : $subfield->[1]);
614 $value = join ($subfieldseparator, @subvaluesarray);
617 # Field processing
618 my $marcfield = $tag->{fieldtag}; # This line fixes a retrocompatibility concern
619 # The "processing" could be based on the $marcfield variable.
620 eval $fieldprocessing if ($fieldprocessing);
622 push @loop_values, $value;
626 push @field_values, {
627 fieldtag => $tag->{fieldtag},
628 subfieldtag => $tag->{subfieldtag},
629 values => \@loop_values,
632 for my $field_value ( @field_values ) {
633 if ( $field_value->{subfieldtag} ) {
634 push @csv_rows, join( $subfieldseparator, @{ $field_value->{values} } );
635 } else {
636 push @csv_rows, join( $fieldseparator, @{ $field_value->{values} } );
643 if ( $header ) {
644 $csv->combine(@marcfieldsheaders);
645 $output = $csv->string() . "\n";
647 $csv->combine(@csv_rows);
648 $output .= $csv->string() . "\n";
650 return $output;
655 =head2 changeEncoding - Change the encoding of a record
657 my ($error, $newrecord) = changeEncoding($record,$format,$flavour,$to_encoding,$from_encoding);
659 Changes the encoding of a record
661 C<$record> - the record itself can be in ISO-2709, a MARC::Record object, or MARCXML for now (required)
663 C<$format> - MARC or MARCXML (required)
665 C<$flavour> - MARC21 or UNIMARC, if MARC21, it will change the leader (optional) [defaults to Koha system preference]
667 C<$to_encoding> - the encoding you want the record to end up in (optional) [UTF-8]
669 C<$from_encoding> - the encoding the record is currently in (optional, it will probably be able to tell unless there's a problem with the record)
671 FIXME: the from_encoding doesn't work yet
673 FIXME: better handling for UNIMARC, it should allow management of 100 field
675 FIXME: shouldn't have to convert to and from xml/marc just to change encoding someone needs to re-write MARC::Record's 'encoding' method to actually alter the encoding rather than just changing the leader
677 =cut
679 sub changeEncoding {
680 my ($record,$format,$flavour,$to_encoding,$from_encoding) = @_;
681 my $newrecord;
682 my $error;
683 unless($flavour) {$flavour = C4::Context->preference("marcflavour")};
684 unless($to_encoding) {$to_encoding = "UTF-8"};
686 # ISO-2709 Record (MARC21 or UNIMARC)
687 if (lc($format) =~ /^marc$/o) {
688 # if we're converting encoding of an ISO2709 file, we need to roundtrip through XML
689 # because MARC::Record doesn't directly provide us with an encoding method
690 # It's definitely less than idea and should be fixed eventually - kados
691 my $marcxml; # temporary storage of MARCXML scalar
692 ($error,$marcxml) = marc2marcxml($record,$to_encoding,$flavour);
693 unless ($error) {
694 ($error,$newrecord) = marcxml2marc($marcxml,$to_encoding,$flavour);
697 # MARCXML Record
698 } elsif (lc($format) =~ /^marcxml$/o) { # MARCXML Record
699 my $marc;
700 ($error,$marc) = marcxml2marc($record,$to_encoding,$flavour);
701 unless ($error) {
702 ($error,$newrecord) = marc2marcxml($record,$to_encoding,$flavour);
704 } else {
705 $error.="Unsupported record format:".$format;
707 return ($error,$newrecord);
710 =head2 marc2bibtex - Convert from MARC21 and UNIMARC to BibTex
712 my ($bibtex) = marc2bibtex($record, $id);
714 Returns a BibTex scalar
716 C<$record> - a MARC::Record object
718 C<$id> - an id for the BibTex record (might be the biblionumber)
720 =cut
723 sub marc2bibtex {
724 my ($record, $id) = @_;
725 my $tex;
726 my $marcflavour = C4::Context->preference("marcflavour");
728 # Authors
729 my $author;
730 my @texauthors;
731 my @authorFields = ('100','110','111','700','710','711');
732 @authorFields = ('700','701','702','710','711','721') if ( $marcflavour eq "UNIMARC" );
734 foreach my $field ( @authorFields ) {
735 # author formatted surname, firstname
736 my $texauthor = '';
737 if ( $marcflavour eq "UNIMARC" ) {
738 $texauthor = join ', ',
739 ( $record->subfield($field,"a"), $record->subfield($field,"b") );
740 } else {
741 $texauthor = $record->subfield($field,"a");
743 push @texauthors, $texauthor if $texauthor;
745 $author = join ' and ', @texauthors;
747 # Defining the conversion array according to the marcflavour
748 my @bh;
749 if ( $marcflavour eq "UNIMARC" ) {
751 # FIXME, TODO : handle repeatable fields
752 # TODO : handle more types of documents
754 # Unimarc to bibtex array
755 @bh = (
757 # Mandatory
758 author => $author,
759 title => $record->subfield("200", "a") || "",
760 editor => $record->subfield("210", "g") || "",
761 publisher => $record->subfield("210", "c") || "",
762 year => $record->subfield("210", "d") || $record->subfield("210", "h") || "",
764 # Optional
765 volume => $record->subfield("200", "v") || "",
766 series => $record->subfield("225", "a") || "",
767 address => $record->subfield("210", "a") || "",
768 edition => $record->subfield("205", "a") || "",
769 note => $record->subfield("300", "a") || "",
770 url => $record->subfield("856", "u") || ""
772 } else {
774 # Marc21 to bibtex array
775 @bh = (
777 # Mandatory
778 author => $author,
779 title => $record->subfield("245", "a") || "",
780 editor => $record->subfield("260", "f") || "",
781 publisher => $record->subfield("264", "b") || $record->subfield("260", "b") || "",
782 year => $record->subfield("264", "c") || $record->subfield("260", "c") || $record->subfield("260", "g") || "",
784 # Optional
785 # unimarc to marc21 specification says not to convert 200$v to marc21
786 series => $record->subfield("490", "a") || "",
787 address => $record->subfield("264", "a") || $record->subfield("260", "a") || "",
788 edition => $record->subfield("250", "a") || "",
789 note => $record->subfield("500", "a") || "",
790 url => $record->subfield("856", "u") || ""
794 my $BibtexExportAdditionalFields = C4::Context->preference('BibtexExportAdditionalFields');
795 my $additional_fields;
796 if ($BibtexExportAdditionalFields) {
797 $BibtexExportAdditionalFields = "$BibtexExportAdditionalFields\n\n";
798 $additional_fields = eval { YAML::Load($BibtexExportAdditionalFields); };
799 if ($@) {
800 warn "Unable to parse BibtexExportAdditionalFields : $@";
801 $additional_fields = undef;
805 if ( $additional_fields && $additional_fields->{'@'} ) {
806 my ( $f, $sf ) = split( /\$/, $additional_fields->{'@'} );
807 my ( $type ) = read_field( { record => $record, field => $f, subfield => $sf, field_numbers => [1] } );
809 if ($type) {
810 $tex .= '@' . $type . '{';
812 else {
813 $tex .= "\@book{";
816 else {
817 $tex .= "\@book{";
820 my @elt;
821 for ( my $i = 0 ; $i < scalar( @bh ) ; $i = $i + 2 ) {
822 next unless $bh[$i+1];
823 push @elt, qq|\t$bh[$i] = {$bh[$i+1]}|;
825 $tex .= join(",\n", $id, @elt);
827 if ($additional_fields) {
828 $tex .= ",\n";
829 foreach my $bibtex_tag ( keys %$additional_fields ) {
830 next if $bibtex_tag eq '@';
832 my @fields =
833 ref( $additional_fields->{$bibtex_tag} ) eq 'ARRAY'
834 ? @{ $additional_fields->{$bibtex_tag} }
835 : $additional_fields->{$bibtex_tag};
837 for my $tag (@fields) {
838 my ( $f, $sf ) = split( /\$/, $tag );
839 my @values = read_field( { record => $record, field => $f, subfield => $sf } );
840 foreach my $v (@values) {
841 $tex .= qq(\t$bibtex_tag = {$v}\n);
846 else {
847 $tex .= "\n";
850 $tex .= "}\n";
852 return $tex;
856 =head1 INTERNAL FUNCTIONS
858 =head2 _entity_encode - Entity-encode an array of strings
860 my ($entity_encoded_string) = _entity_encode($string);
864 my (@entity_encoded_strings) = _entity_encode(@strings);
866 Entity-encode an array of strings
868 =cut
870 sub _entity_encode {
871 my @strings = @_;
872 my @strings_entity_encoded;
873 foreach my $string (@strings) {
874 my $nfc_string = NFC($string);
875 $nfc_string =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
876 push @strings_entity_encoded, $nfc_string;
878 return @strings_entity_encoded;
881 END { } # module clean-up code here (global destructor)
883 __END__
885 =head1 AUTHOR
887 Joshua Ferraro <jmf@liblime.com>
889 =head1 MODIFICATIONS
892 =cut