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>.
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
35 use YAML; #marcrecords2csv
37 use Text::CSV::Encoded; #marc2csv
38 use Koha::SimpleMARC qw(read_field);
39 use Koha::XSLT_Handler;
42 use vars qw(@ISA @EXPORT);
44 # set the version for version checking
48 # only export API methods
65 C4::Record - MARC, MARCXML, DC, MODS, XML, etc. Record Management Functions and API
69 New in Koha 3.x. This module handles all record-related management functions.
71 =head1 API (EXPORTED FUNCTIONS)
73 =head2 marc2marc - Convert from one flavour of ISO-2709 to another
75 my ($error,$newmarc) = marc2marc($marc,$to_flavour,$from_flavour,$encoding);
77 Returns an ISO-2709 scalar
82 my ($marc,$to_flavour,$from_flavour,$encoding) = @_;
84 if ($to_flavour =~ m/marcstd/) {
86 if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object
87 $marc_record_obj = $marc;
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
91 # conversion to MARC::Record object failed, populate $error
92 if ($@) { $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR };
96 foreach my $field ($marc_record_obj->fields()) {
97 if ($field->tag() =~ m/9/ && ($field->tag() != '490' || C4::Context->preference("marcflavour") eq 'UNIMARC')) {
98 push @privatefields, $field;
99 } elsif (! ($field->is_control_field())) {
100 $field->delete_subfield(code => '9') if ($field->subfield('9'));
103 $marc_record_obj->delete_field($_) for @privatefields;
104 $marc = $marc_record_obj->as_usmarc();
107 $error = "Feature not yet implemented\n";
109 return ($error,$marc);
112 =head2 marc2marcxml - Convert from ISO-2709 to MARCXML
114 my ($error,$marcxml) = marc2marcxml($marc,$encoding,$flavour);
116 Returns a MARCXML scalar
118 C<$marc> - an ISO-2709 scalar or MARC::Record object
120 C<$encoding> - UTF-8 or MARC-8 [UTF-8]
122 C<$flavour> - MARC21 or UNIMARC
124 C<$dont_entity_encode> - a flag that instructs marc2marcxml not to entity encode the xml before returning (optional)
129 my ($marc,$encoding,$flavour,$dont_entity_encode) = @_;
130 my $error; # the error string
131 my $marcxml; # the final MARCXML scalar
133 # test if it's already a MARC::Record object, if not, make it one
135 if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object
136 $marc_record_obj = $marc;
137 } else { # it's not a MARC::Record object, make it one
138 eval { $marc_record_obj = MARC::Record->new_from_usmarc($marc) }; # handle exceptions
140 # conversion to MARC::Record object failed, populate $error
141 if ($@) { $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR };
143 # only proceed if no errors so far
146 # check the record for warnings
147 my @warnings = $marc_record_obj->warnings();
149 warn "\nWarnings encountered while processing ISO-2709 record with title \"".$marc_record_obj->title()."\":\n";
150 foreach my $warn (@warnings) { warn "\t".$warn };
152 unless($encoding) {$encoding = "UTF-8"}; # set default encoding
153 unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; # set default MARC flavour
155 # attempt to convert the record to MARCXML
156 eval { $marcxml = $marc_record_obj->as_xml_record($flavour) }; #handle exceptions
158 # record creation failed, populate $error
160 $error .= "Creation of MARCXML failed:".$MARC::File::ERROR;
161 $error .= "Additional information:\n";
162 my @warnings = $@->warnings();
163 foreach my $warn (@warnings) { $error.=$warn."\n" };
165 # record creation was successful
168 # check the record for warning flags again (warnings() will be cleared already if there was an error, see above block
169 @warnings = $marc_record_obj->warnings();
171 warn "\nWarnings encountered while processing ISO-2709 record with title \"".$marc_record_obj->title()."\":\n";
172 foreach my $warn (@warnings) { warn "\t".$warn };
176 # only proceed if no errors so far
179 # entity encode the XML unless instructed not to
180 unless ($dont_entity_encode) {
181 my ($marcxml_entity_encoded) = _entity_encode($marcxml);
182 $marcxml = $marcxml_entity_encoded;
186 # return result to calling program
187 return ($error,$marcxml);
190 =head2 marcxml2marc - Convert from MARCXML to ISO-2709
192 my ($error,$marc) = marcxml2marc($marcxml,$encoding,$flavour);
194 Returns an ISO-2709 scalar
196 C<$marcxml> - a MARCXML record
198 C<$encoding> - UTF-8 or MARC-8 [UTF-8]
200 C<$flavour> - MARC21 or UNIMARC
205 my ($marcxml,$encoding,$flavour) = @_;
206 my $error; # the error string
207 my $marc; # the final ISO-2709 scalar
208 unless($encoding) {$encoding = "UTF-8"}; # set the default encoding
209 unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; # set the default MARC flavour
211 # attempt to do the conversion
212 eval { $marc = MARC::Record->new_from_xml($marcxml,$encoding,$flavour) }; # handle exceptions
214 # record creation failed, populate $error
215 if ($@) {$error .="\nCreation of MARCXML Record failed: ".$@;
216 $error.=$MARC::File::ERROR if ($MARC::File::ERROR);
218 # return result to calling program
219 return ($error,$marc);
222 =head2 marc2dcxml - Convert from ISO-2709 to Dublin Core
224 my dcxml = marc2dcxml ($marc, $xml, $biblionumber, $format);
228 my dcxml = marc2dcxml (undef, undef, 1, "oaidc");
230 Convert MARC or MARCXML to Dublin Core metadata (XSLT Transformation),
231 optionally can get an XML directly from database (biblioitems.marcxml)
232 without item information. This method take into consideration the syspref
233 'marcflavour' (UNIMARC, MARC21 and NORMARC).
234 Return an XML file with the format defined in C<$format>
236 C<$marc> - an ISO-2709 scalar or MARC::Record object
238 C<$xml> - a MARCXML file
240 C<$biblionumber> - obtain the record directly from database (biblioitems.marcxml)
242 C<$format> - accept three type of DC formats (oaidc, srwdc, and rdfdc )
247 my ( $marc, $xml, $biblionumber, $format ) = @_;
250 my ( $marcxml, $record, $output );
252 # set the default path for intranet xslts
253 # differents xslts to process (OAIDC, SRWDC and RDFDC)
254 my $xsl = C4::Context->config('intrahtdocs') . '/prog/en/xslt/' .
255 C4::Context->preference('marcflavour') . 'slim2' . uc ( $format ) . '.xsl';
257 if ( defined $marc ) {
258 # no need to catch errors or warnings marc2marcxml do it instead
259 $marcxml = C4::Record::marc2marcxml( $marc );
260 } elsif ( not defined $xml and defined $biblionumber ) {
261 # get MARCXML biblio directly from biblioitems.marcxml without item information
262 $marcxml = C4::Biblio::GetXmlBiblio( $biblionumber );
267 # only proceed if MARC21 or UNIMARC; else clause is executed if marcflavour set it to NORMARC
268 # generate MARC::Record object to see if not a marcxml record
269 unless ( C4::Context->preference('marcflavour') eq 'NORMARC' ) {
270 eval { $record = MARC::Record->new_from_xml(
273 C4::Context->preference('marcflavour')
277 eval { $record = MARC::Record->new_from_xml(
285 # conversion to MARC::Record object failed
287 croak "Creation of MARC::Record object failed.";
288 } elsif ( $record->warnings() ) {
289 carp "Warnings encountered while processing ISO-2709 record.\n";
290 my @warnings = $record->warnings();
291 foreach my $warn (@warnings) {
294 } elsif ( $record =~ /^MARC::Record/ ) { # if OK makes xslt transformation
295 my $xslt_engine = Koha::XSLT_Handler->new;
296 if ( $format =~ /oaidc|srwdc|rdfdc/ ) {
297 $output = $xslt_engine->transform( $marcxml, $xsl );
299 croak "The format argument ($format) not accepted.\n" .
300 "Please pass a valid format (oaidc, srwdc, or rdfdc)\n";
302 my $err = $xslt_engine->err; # error number
303 my $errstr = $xslt_engine->errstr; # error message
305 croak "Error when processing $errstr Error number: $err\n";
312 =head2 marc2modsxml - Convert from ISO-2709 to MODS
314 my $modsxml = marc2modsxml($marc);
316 Returns a MODS scalar
322 return _transformWithStylesheet($marc, "/prog/en/xslt/MARC21slim2MODS3-1.xsl");
325 =head2 marc2madsxml - Convert from ISO-2709 to MADS
327 my $madsxml = marc2madsxml($marc);
329 Returns a MADS scalar
335 return _transformWithStylesheet($marc, "/prog/en/xslt/MARC21slim2MADS.xsl");
338 =head2 _transformWithStylesheet - Transform a MARC record with a stylesheet
340 my $xml = _transformWithStylesheet($marc, $stylesheet)
342 Returns the XML scalar result of the transformation. $stylesheet should
343 contain the path to a stylesheet under intrahtdocs.
347 sub _transformWithStylesheet {
348 my ($marc, $stylesheet) = @_;
349 # grab the XML, run it through our stylesheet, push it out to the browser
350 my $xmlrecord = marc2marcxml($marc);
351 my $xslfile = C4::Context->config('intrahtdocs') . $stylesheet;
352 return C4::XSLT::engine->transform($xmlrecord, $xslfile);
357 my $marc_rec_obj = MARC::Record->new_from_usmarc($marc);
358 my ( $abstract, $f260a, $f710a );
359 my $f260 = $marc_rec_obj->field('260');
361 $f260a = $f260->subfield('a') if $f260;
363 my $f710 = $marc_rec_obj->field('710');
365 $f710a = $f710->subfield('a');
367 my $f500 = $marc_rec_obj->field('500');
369 $abstract = $f500->subfield('a');
372 DB => C4::Context->preference("LibraryName"),
373 Title => $marc_rec_obj->title(),
374 Author => $marc_rec_obj->author(),
377 Year => $marc_rec_obj->publication_date,
378 Abstract => $abstract,
381 my $style = new Biblio::EndnoteStyle();
383 $template.= "DB - DB\n" if C4::Context->preference("LibraryName");
384 $template.="T1 - Title\n" if $marc_rec_obj->title();
385 $template.="A1 - Author\n" if $marc_rec_obj->author();
386 $template.="PB - Publisher\n" if $f710a;
387 $template.="CY - City\n" if $f260a;
388 $template.="Y1 - Year\n" if $marc_rec_obj->publication_date;
389 $template.="AB - Abstract\n" if $abstract;
390 my ($text, $errmsg) = $style->format($template, $fields);
395 =head2 marc2csv - Convert several records from UNIMARC to CSV
397 my ($csv) = marc2csv($biblios, $csvprofileid, $itemnumbers);
399 Pre and postprocessing can be done through a YAML file
403 C<$biblio> - a list of biblionumbers
405 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)
407 C<$itemnumbers> - a list of itemnumbers to export
412 my ($biblios, $id, $itemnumbers) = @_;
415 my $csv = Text::CSV::Encoded->new();
418 my $configfile = "../tools/csv-profiles/$id.yaml";
419 my ($preprocess, $postprocess, $fieldprocessing);
421 ($preprocess,$postprocess, $fieldprocessing) = YAML::LoadFile($configfile);
425 eval $preprocess if ($preprocess);
428 if ( @$itemnumbers ) {
429 for my $itemnumber ( @$itemnumbers) {
430 my $biblionumber = GetBiblionumberFromItemnumber $itemnumber;
431 $output .= marcrecord2csv( $biblionumber, $id, $firstpass, $csv, $fieldprocessing, [$itemnumber] );
435 foreach my $biblio (@$biblios) {
436 $output .= marcrecord2csv( $biblio, $id, $firstpass, $csv, $fieldprocessing );
442 eval $postprocess if ($postprocess);
447 =head2 marcrecord2csv - Convert a single record from UNIMARC to CSV
449 my ($csv) = marcrecord2csv($biblio, $csvprofileid, $header);
453 C<$biblio> - a biblionumber
455 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)
457 C<$header> - true if the headers are to be printed (typically at first pass)
459 C<$csv> - an already initialised Text::CSV object
463 C<$itemnumbers> a list of itemnumbers to export
468 my ($biblio, $id, $header, $csv, $fieldprocessing, $itemnumbers) = @_;
472 my $record = GetMarcBiblio($biblio);
473 return unless $record;
474 C4::Biblio::EmbedItemsInMarcBiblio( $record, $biblio, $itemnumbers );
475 # Getting the framework
476 my $frameworkcode = GetFrameworkCode($biblio);
478 # Getting information about the csv profile
479 my $profile = GetCsvProfile($id);
481 # Getting output encoding
482 my $encoding = $profile->{encoding} || 'utf8';
484 my $csvseparator = $profile->{csv_separator} || ',';
485 my $fieldseparator = $profile->{field_separator} || '#';
486 my $subfieldseparator = $profile->{subfield_separator} || '|';
488 # TODO: Be more generic (in case we have to handle other protected chars or more separators)
489 if ($csvseparator eq '\t') { $csvseparator = "\t" }
490 if ($fieldseparator eq '\t') { $fieldseparator = "\t" }
491 if ($subfieldseparator eq '\t') { $subfieldseparator = "\t" }
492 if ($csvseparator eq '\n') { $csvseparator = "\n" }
493 if ($fieldseparator eq '\n') { $fieldseparator = "\n" }
494 if ($subfieldseparator eq '\n') { $subfieldseparator = "\n" }
496 $csv = $csv->encoding_out($encoding) ;
497 $csv->sep_char($csvseparator);
499 # Getting the marcfields
500 my $marcfieldslist = $profile->{content};
502 # Getting the marcfields as an array
503 my @marcfieldsarray = split('\|', $marcfieldslist);
505 # Separating the marcfields from the user-supplied headers
507 foreach (@marcfieldsarray) {
508 my @result = split('=', $_, 2);
509 my $content = ( @result == 2 )
513 while ( $content =~ m|(\d{3})\$?(.)?|g ) {
515 my $subfieldtag = $2 || undef;
516 push @fields, { fieldtag => $fieldtag, subfieldtag => $subfieldtag };
519 push @csv_structures, { header => $result[0], content => $content, fields => \@fields };
521 push @csv_structures, { content => $content, fields => \@fields }
525 my ( @marcfieldsheaders, @csv_rows );
526 my $dbh = C4::Context->dbh;
529 for my $field ( $record->fields ) {
530 my $fieldtag = $field->tag;
532 if ( $field->is_control_field ) {
533 $values = $field->data();
535 $values->{indicator}{1} = $field->indicator(1);
536 $values->{indicator}{2} = $field->indicator(2);
537 for my $subfield ( $field->subfields ) {
538 my $subfieldtag = $subfield->[0];
539 my $value = $subfield->[1];
540 push @{ $values->{$subfieldtag} }, $value;
543 # We force the key as an integer (trick for 00X and OXX fields)
544 push @{ $field_list->{fields}{0+$fieldtag} }, $values;
547 # For each field or subfield
548 foreach my $csv_structure (@csv_structures) {
550 my $tags = $csv_structure->{fields};
551 my $content = $csv_structure->{content};
554 # If we have a user-supplied header, we use it
555 if ( exists $csv_structure->{header} ) {
556 push @marcfieldsheaders, $csv_structure->{header};
558 # If not, we get the matching tag name from koha
559 my $tag = $tags->[0];
560 if ( $tag->{subfieldtag} ) {
561 my $query = "SELECT liblibrarian FROM marc_subfield_structure WHERE tagfield=? AND tagsubfield=?";
562 my @results = $dbh->selectrow_array( $query, {}, $tag->{fieldtag}, $tag->{subfieldtag} );
563 push @marcfieldsheaders, $results[0];
565 my $query = "SELECT liblibrarian FROM marc_tag_structure WHERE tagfield=?";
566 my @results = $dbh->selectrow_array( $query, {}, $tag->{fieldtag} );
567 push @marcfieldsheaders, $results[0];
573 if ( $content =~ m|\[\%.*\%\]| ) {
574 my $tt = Template->new();
575 my $template = $content;
577 # Replace 00X and 0XX with X or XX
578 $content =~ s|fields.00(\d)|fields.$1|g;
579 $content =~ s|fields.0(\d{2})|fields.$1|g;
581 $tt->process( \$content, $field_list, \$tt_output );
582 push @csv_rows, $tt_output;
584 for my $tag ( @$tags ) {
585 my @fields = $record->field( $tag->{fieldtag} );
586 # If it is a subfield
588 if ( $tag->{subfieldtag} ) {
590 foreach my $field (@fields) {
591 my @subfields = $field->subfield( $tag->{subfieldtag} );
592 foreach my $subfield (@subfields) {
593 my $authvalues = GetKohaAuthorisedValuesFromField( $tag->{fieldtag}, $tag->{subfieldtag}, $frameworkcode, undef);
594 push @loop_values, (defined $authvalues->{$subfield}) ? $authvalues->{$subfield} : $subfield;
600 my $authvalues = GetKohaAuthorisedValuesFromField( $tag->{fieldtag}, undef, $frameworkcode, undef);
602 foreach my $field ( @fields ) {
605 # If it is a control field
606 if ($field->is_control_field) {
607 $value = defined $authvalues->{$field->as_string} ? $authvalues->{$field->as_string} : $field->as_string;
609 # If it is a field, we gather all subfields, joined by the subfield separator
611 my @subfields = $field->subfields;
612 foreach my $subfield (@subfields) {
613 push (@subvaluesarray, defined $authvalues->{$subfield->[1]} ? $authvalues->{$subfield->[1]} : $subfield->[1]);
615 $value = join ($subfieldseparator, @subvaluesarray);
619 my $marcfield = $tag->{fieldtag}; # This line fixes a retrocompatibility concern
620 # The "processing" could be based on the $marcfield variable.
621 eval $fieldprocessing if ($fieldprocessing);
623 push @loop_values, $value;
627 push @field_values, {
628 fieldtag => $tag->{fieldtag},
629 subfieldtag => $tag->{subfieldtag},
630 values => \@loop_values,
633 for my $field_value ( @field_values ) {
634 if ( $field_value->{subfieldtag} ) {
635 push @csv_rows, join( $subfieldseparator, @{ $field_value->{values} } );
637 push @csv_rows, join( $fieldseparator, @{ $field_value->{values} } );
645 $csv->combine(@marcfieldsheaders);
646 $output = $csv->string() . "\n";
648 $csv->combine(@csv_rows);
649 $output .= $csv->string() . "\n";
656 =head2 changeEncoding - Change the encoding of a record
658 my ($error, $newrecord) = changeEncoding($record,$format,$flavour,$to_encoding,$from_encoding);
660 Changes the encoding of a record
662 C<$record> - the record itself can be in ISO-2709, a MARC::Record object, or MARCXML for now (required)
664 C<$format> - MARC or MARCXML (required)
666 C<$flavour> - MARC21 or UNIMARC, if MARC21, it will change the leader (optional) [defaults to Koha system preference]
668 C<$to_encoding> - the encoding you want the record to end up in (optional) [UTF-8]
670 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)
672 FIXME: the from_encoding doesn't work yet
674 FIXME: better handling for UNIMARC, it should allow management of 100 field
676 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
681 my ($record,$format,$flavour,$to_encoding,$from_encoding) = @_;
684 unless($flavour) {$flavour = C4::Context->preference("marcflavour")};
685 unless($to_encoding) {$to_encoding = "UTF-8"};
687 # ISO-2709 Record (MARC21 or UNIMARC)
688 if (lc($format) =~ /^marc$/o) {
689 # if we're converting encoding of an ISO2709 file, we need to roundtrip through XML
690 # because MARC::Record doesn't directly provide us with an encoding method
691 # It's definitely less than idea and should be fixed eventually - kados
692 my $marcxml; # temporary storage of MARCXML scalar
693 ($error,$marcxml) = marc2marcxml($record,$to_encoding,$flavour);
695 ($error,$newrecord) = marcxml2marc($marcxml,$to_encoding,$flavour);
699 } elsif (lc($format) =~ /^marcxml$/o) { # MARCXML Record
701 ($error,$marc) = marcxml2marc($record,$to_encoding,$flavour);
703 ($error,$newrecord) = marc2marcxml($record,$to_encoding,$flavour);
706 $error.="Unsupported record format:".$format;
708 return ($error,$newrecord);
711 =head2 marc2bibtex - Convert from MARC21 and UNIMARC to BibTex
713 my ($bibtex) = marc2bibtex($record, $id);
715 Returns a BibTex scalar
717 C<$record> - a MARC::Record object
719 C<$id> - an id for the BibTex record (might be the biblionumber)
725 my ($record, $id) = @_;
727 my $marcflavour = C4::Context->preference("marcflavour");
732 my @authorFields = ('100','110','111','700','710','711');
733 @authorFields = ('700','701','702','710','711','721') if ( $marcflavour eq "UNIMARC" );
735 foreach my $field ( @authorFields ) {
736 # author formatted surname, firstname
738 if ( $marcflavour eq "UNIMARC" ) {
739 $texauthor = join ', ',
740 ( $record->subfield($field,"a"), $record->subfield($field,"b") );
742 $texauthor = $record->subfield($field,"a");
744 push @texauthors, $texauthor if $texauthor;
746 $author = join ' and ', @texauthors;
748 # Defining the conversion array according to the marcflavour
750 if ( $marcflavour eq "UNIMARC" ) {
752 # FIXME, TODO : handle repeatable fields
753 # TODO : handle more types of documents
755 # Unimarc to bibtex array
760 title => $record->subfield("200", "a") || "",
761 editor => $record->subfield("210", "g") || "",
762 publisher => $record->subfield("210", "c") || "",
763 year => $record->subfield("210", "d") || $record->subfield("210", "h") || "",
766 volume => $record->subfield("200", "v") || "",
767 series => $record->subfield("225", "a") || "",
768 address => $record->subfield("210", "a") || "",
769 edition => $record->subfield("205", "a") || "",
770 note => $record->subfield("300", "a") || "",
771 url => $record->subfield("856", "u") || ""
775 # Marc21 to bibtex array
780 title => $record->subfield("245", "a") || "",
781 editor => $record->subfield("260", "f") || "",
782 publisher => $record->subfield("264", "b") || $record->subfield("260", "b") || "",
783 year => $record->subfield("264", "c") || $record->subfield("260", "c") || $record->subfield("260", "g") || "",
786 # unimarc to marc21 specification says not to convert 200$v to marc21
787 series => $record->subfield("490", "a") || "",
788 address => $record->subfield("264", "a") || $record->subfield("260", "a") || "",
789 edition => $record->subfield("250", "a") || "",
790 note => $record->subfield("500", "a") || "",
791 url => $record->subfield("856", "u") || ""
795 my $BibtexExportAdditionalFields = C4::Context->preference('BibtexExportAdditionalFields');
796 my $additional_fields;
797 if ($BibtexExportAdditionalFields) {
798 $BibtexExportAdditionalFields = "$BibtexExportAdditionalFields\n\n";
799 $additional_fields = eval { YAML::Load($BibtexExportAdditionalFields); };
801 warn "Unable to parse BibtexExportAdditionalFields : $@";
802 $additional_fields = undef;
806 if ( $additional_fields && $additional_fields->{'@'} ) {
807 my ( $f, $sf ) = split( /\$/, $additional_fields->{'@'} );
808 my ( $type ) = read_field( { record => $record, field => $f, subfield => $sf, field_numbers => [1] } );
811 $tex .= '@' . $type . '{';
822 for ( my $i = 0 ; $i < scalar( @bh ) ; $i = $i + 2 ) {
823 next unless $bh[$i+1];
824 push @elt, qq|\t$bh[$i] = {$bh[$i+1]}|;
826 $tex .= join(",\n", $id, @elt);
828 if ($additional_fields) {
830 foreach my $bibtex_tag ( keys %$additional_fields ) {
831 next if $bibtex_tag eq '@';
834 ref( $additional_fields->{$bibtex_tag} ) eq 'ARRAY'
835 ? @{ $additional_fields->{$bibtex_tag} }
836 : $additional_fields->{$bibtex_tag};
838 for my $tag (@fields) {
839 my ( $f, $sf ) = split( /\$/, $tag );
840 my @values = read_field( { record => $record, field => $f, subfield => $sf } );
841 foreach my $v (@values) {
842 $tex .= qq(\t$bibtex_tag = {$v}\n);
857 =head1 INTERNAL FUNCTIONS
859 =head2 _entity_encode - Entity-encode an array of strings
861 my ($entity_encoded_string) = _entity_encode($string);
865 my (@entity_encoded_strings) = _entity_encode(@strings);
867 Entity-encode an array of strings
873 my @strings_entity_encoded;
874 foreach my $string (@strings) {
875 my $nfc_string = NFC($string);
876 $nfc_string =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
877 push @strings_entity_encoded, $nfc_string;
879 return @strings_entity_encoded;
882 END { } # module clean-up code here (global destructor)
888 Joshua Ferraro <jmf@liblime.com>