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($VERSION @ISA @EXPORT);
44 # set the version for version checking
45 $VERSION = 3.07.00.049;
49 # only export API methods
66 C4::Record - MARC, MARCXML, DC, MODS, XML, etc. Record Management Functions and API
70 New in Koha 3.x. This module handles all record-related management functions.
72 =head1 API (EXPORTED FUNCTIONS)
74 =head2 marc2marc - Convert from one flavour of ISO-2709 to another
76 my ($error,$newmarc) = marc2marc($marc,$to_flavour,$from_flavour,$encoding);
78 Returns an ISO-2709 scalar
83 my ($marc,$to_flavour,$from_flavour,$encoding) = @_;
85 if ($to_flavour =~ m/marcstd/) {
87 if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object
88 $marc_record_obj = $marc;
89 } else { # it's not a MARC::Record object, make it one
90 eval { $marc_record_obj = MARC
::Record
->new_from_usmarc($marc) }; # handle exceptions
92 # conversion to MARC::Record object failed, populate $error
93 if ($@
) { $error .="\nCreation of MARC::Record object failed: ".$MARC::File
::ERROR
};
97 foreach my $field ($marc_record_obj->fields()) {
98 if ($field->tag() =~ m/9/ && ($field->tag() != '490' || C4
::Context
->preference("marcflavour") eq 'UNIMARC')) {
99 push @privatefields, $field;
100 } elsif (! ($field->is_control_field())) {
101 $field->delete_subfield(code
=> '9') if ($field->subfield('9'));
104 $marc_record_obj->delete_field($_) for @privatefields;
105 $marc = $marc_record_obj->as_usmarc();
108 $error = "Feature not yet implemented\n";
110 return ($error,$marc);
113 =head2 marc2marcxml - Convert from ISO-2709 to MARCXML
115 my ($error,$marcxml) = marc2marcxml($marc,$encoding,$flavour);
117 Returns a MARCXML scalar
119 C<$marc> - an ISO-2709 scalar or MARC::Record object
121 C<$encoding> - UTF-8 or MARC-8 [UTF-8]
123 C<$flavour> - MARC21 or UNIMARC
125 C<$dont_entity_encode> - a flag that instructs marc2marcxml not to entity encode the xml before returning (optional)
130 my ($marc,$encoding,$flavour,$dont_entity_encode) = @_;
131 my $error; # the error string
132 my $marcxml; # the final MARCXML scalar
134 # test if it's already a MARC::Record object, if not, make it one
136 if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object
137 $marc_record_obj = $marc;
138 } else { # it's not a MARC::Record object, make it one
139 eval { $marc_record_obj = MARC
::Record
->new_from_usmarc($marc) }; # handle exceptions
141 # conversion to MARC::Record object failed, populate $error
142 if ($@
) { $error .="\nCreation of MARC::Record object failed: ".$MARC::File
::ERROR
};
144 # only proceed if no errors so far
147 # check the record for warnings
148 my @warnings = $marc_record_obj->warnings();
150 warn "\nWarnings encountered while processing ISO-2709 record with title \"".$marc_record_obj->title()."\":\n";
151 foreach my $warn (@warnings) { warn "\t".$warn };
153 unless($encoding) {$encoding = "UTF-8"}; # set default encoding
154 unless($flavour) {$flavour = C4
::Context
->preference("marcflavour")}; # set default MARC flavour
156 # attempt to convert the record to MARCXML
157 eval { $marcxml = $marc_record_obj->as_xml_record($flavour) }; #handle exceptions
159 # record creation failed, populate $error
161 $error .= "Creation of MARCXML failed:".$MARC::File
::ERROR
;
162 $error .= "Additional information:\n";
163 my @warnings = $@
->warnings();
164 foreach my $warn (@warnings) { $error.=$warn."\n" };
166 # record creation was successful
169 # check the record for warning flags again (warnings() will be cleared already if there was an error, see above block
170 @warnings = $marc_record_obj->warnings();
172 warn "\nWarnings encountered while processing ISO-2709 record with title \"".$marc_record_obj->title()."\":\n";
173 foreach my $warn (@warnings) { warn "\t".$warn };
177 # only proceed if no errors so far
180 # entity encode the XML unless instructed not to
181 unless ($dont_entity_encode) {
182 my ($marcxml_entity_encoded) = _entity_encode
($marcxml);
183 $marcxml = $marcxml_entity_encoded;
187 # return result to calling program
188 return ($error,$marcxml);
191 =head2 marcxml2marc - Convert from MARCXML to ISO-2709
193 my ($error,$marc) = marcxml2marc($marcxml,$encoding,$flavour);
195 Returns an ISO-2709 scalar
197 C<$marcxml> - a MARCXML record
199 C<$encoding> - UTF-8 or MARC-8 [UTF-8]
201 C<$flavour> - MARC21 or UNIMARC
206 my ($marcxml,$encoding,$flavour) = @_;
207 my $error; # the error string
208 my $marc; # the final ISO-2709 scalar
209 unless($encoding) {$encoding = "UTF-8"}; # set the default encoding
210 unless($flavour) {$flavour = C4
::Context
->preference("marcflavour")}; # set the default MARC flavour
212 # attempt to do the conversion
213 eval { $marc = MARC
::Record
->new_from_xml($marcxml,$encoding,$flavour) }; # handle exceptions
215 # record creation failed, populate $error
216 if ($@
) {$error .="\nCreation of MARCXML Record failed: ".$@
;
217 $error.=$MARC::File
::ERROR
if ($MARC::File
::ERROR
);
219 # return result to calling program
220 return ($error,$marc);
223 =head2 marc2dcxml - Convert from ISO-2709 to Dublin Core
225 my dcxml = marc2dcxml ($marc, $xml, $biblionumber, $format);
229 my dcxml = marc2dcxml (undef, undef, 1, "oaidc");
231 Convert MARC or MARCXML to Dublin Core metadata (XSLT Transformation),
232 optionally can get an XML directly from database (biblioitems.marcxml)
233 without item information. This method take into consideration the syspref
234 'marcflavour' (UNIMARC, MARC21 and NORMARC).
235 Return an XML file with the format defined in C<$format>
237 C<$marc> - an ISO-2709 scalar or MARC::Record object
239 C<$xml> - a MARCXML file
241 C<$biblionumber> - obtain the record directly from database (biblioitems.marcxml)
243 C<$format> - accept three type of DC formats (oaidc, srwdc, and rdfdc )
248 my ( $marc, $xml, $biblionumber, $format ) = @_;
251 my ( $marcxml, $record, $output );
253 # set the default path for intranet xslts
254 # differents xslts to process (OAIDC, SRWDC and RDFDC)
255 my $xsl = C4
::Context
->config('intrahtdocs') . '/prog/en/xslt/' .
256 C4
::Context
->preference('marcflavour') . 'slim2' . uc ( $format ) . '.xsl';
258 if ( defined $marc ) {
259 # no need to catch errors or warnings marc2marcxml do it instead
260 $marcxml = C4
::Record
::marc2marcxml
( $marc );
261 } elsif ( not defined $xml and defined $biblionumber ) {
262 # get MARCXML biblio directly from biblioitems.marcxml without item information
263 $marcxml = C4
::Biblio
::GetXmlBiblio
( $biblionumber );
268 # only proceed if MARC21 or UNIMARC; else clause is executed if marcflavour set it to NORMARC
269 # generate MARC::Record object to see if not a marcxml record
270 unless ( C4
::Context
->preference('marcflavour') eq 'NORMARC' ) {
271 eval { $record = MARC
::Record
->new_from_xml(
274 C4
::Context
->preference('marcflavour')
278 eval { $record = MARC
::Record
->new_from_xml(
286 # conversion to MARC::Record object failed
288 croak
"Creation of MARC::Record object failed.";
289 } elsif ( $record->warnings() ) {
290 carp
"Warnings encountered while processing ISO-2709 record.\n";
291 my @warnings = $record->warnings();
292 foreach my $warn (@warnings) {
295 } elsif ( $record =~ /^MARC::Record/ ) { # if OK makes xslt transformation
296 my $xslt_engine = Koha
::XSLT_Handler
->new;
297 if ( $format =~ /oaidc|srwdc|rdfdc/ ) {
298 $output = $xslt_engine->transform( $marcxml, $xsl );
300 croak
"The format argument ($format) not accepted.\n" .
301 "Please pass a valid format (oaidc, srwdc, or rdfdc)\n";
303 my $err = $xslt_engine->err; # error number
304 my $errstr = $xslt_engine->errstr; # error message
306 croak
"Error when processing $errstr Error number: $err\n";
313 =head2 marc2modsxml - Convert from ISO-2709 to MODS
315 my $modsxml = marc2modsxml($marc);
317 Returns a MODS scalar
323 return _transformWithStylesheet
($marc, "/prog/en/xslt/MARC21slim2MODS3-1.xsl");
326 =head2 marc2madsxml - Convert from ISO-2709 to MADS
328 my $madsxml = marc2madsxml($marc);
330 Returns a MADS scalar
336 return _transformWithStylesheet
($marc, "/prog/en/xslt/MARC21slim2MADS.xsl");
339 =head2 _transformWithStylesheet - Transform a MARC record with a stylesheet
341 my $xml = _transformWithStylesheet($marc, $stylesheet)
343 Returns the XML scalar result of the transformation. $stylesheet should
344 contain the path to a stylesheet under intrahtdocs.
348 sub _transformWithStylesheet
{
349 my ($marc, $stylesheet) = @_;
350 # grab the XML, run it through our stylesheet, push it out to the browser
351 my $xmlrecord = marc2marcxml
($marc);
352 my $xslfile = C4
::Context
->config('intrahtdocs') . $stylesheet;
353 return C4
::XSLT
::engine
->transform($xmlrecord, $xslfile);
358 my $marc_rec_obj = MARC
::Record
->new_from_usmarc($marc);
359 my ( $abstract, $f260a, $f710a );
360 my $f260 = $marc_rec_obj->field('260');
362 $f260a = $f260->subfield('a') if $f260;
364 my $f710 = $marc_rec_obj->field('710');
366 $f710a = $f710->subfield('a');
368 my $f500 = $marc_rec_obj->field('500');
370 $abstract = $f500->subfield('a');
373 DB
=> C4
::Context
->preference("LibraryName"),
374 Title
=> $marc_rec_obj->title(),
375 Author
=> $marc_rec_obj->author(),
378 Year
=> $marc_rec_obj->publication_date,
379 Abstract
=> $abstract,
382 my $style = new Biblio
::EndnoteStyle
();
384 $template.= "DB - DB\n" if C4
::Context
->preference("LibraryName");
385 $template.="T1 - Title\n" if $marc_rec_obj->title();
386 $template.="A1 - Author\n" if $marc_rec_obj->author();
387 $template.="PB - Publisher\n" if $f710a;
388 $template.="CY - City\n" if $f260a;
389 $template.="Y1 - Year\n" if $marc_rec_obj->publication_date;
390 $template.="AB - Abstract\n" if $abstract;
391 my ($text, $errmsg) = $style->format($template, $fields);
396 =head2 marc2csv - Convert several records from UNIMARC to CSV
398 my ($csv) = marc2csv($biblios, $csvprofileid, $itemnumbers);
400 Pre and postprocessing can be done through a YAML file
404 C<$biblio> - a list of biblionumbers
406 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)
408 C<$itemnumbers> - a list of itemnumbers to export
413 my ($biblios, $id, $itemnumbers) = @_;
416 my $csv = Text
::CSV
::Encoded
->new();
419 my $configfile = "../tools/csv-profiles/$id.yaml";
420 my ($preprocess, $postprocess, $fieldprocessing);
422 ($preprocess,$postprocess, $fieldprocessing) = YAML
::LoadFile
($configfile);
426 eval $preprocess if ($preprocess);
429 if ( @
$itemnumbers ) {
430 for my $itemnumber ( @
$itemnumbers) {
431 my $biblionumber = GetBiblionumberFromItemnumber
$itemnumber;
432 $output .= marcrecord2csv
( $biblionumber, $id, $firstpass, $csv, $fieldprocessing, [$itemnumber] );
436 foreach my $biblio (@
$biblios) {
437 $output .= marcrecord2csv
( $biblio, $id, $firstpass, $csv, $fieldprocessing );
443 eval $postprocess if ($postprocess);
448 =head2 marcrecord2csv - Convert a single record from UNIMARC to CSV
450 my ($csv) = marcrecord2csv($biblio, $csvprofileid, $header);
454 C<$biblio> - a biblionumber
456 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)
458 C<$header> - true if the headers are to be printed (typically at first pass)
460 C<$csv> - an already initialised Text::CSV object
464 C<$itemnumbers> a list of itemnumbers to export
469 my ($biblio, $id, $header, $csv, $fieldprocessing, $itemnumbers) = @_;
473 my $record = GetMarcBiblio
($biblio);
474 return unless $record;
475 C4
::Biblio
::EmbedItemsInMarcBiblio
( $record, $biblio, $itemnumbers );
476 # Getting the framework
477 my $frameworkcode = GetFrameworkCode
($biblio);
479 # Getting information about the csv profile
480 my $profile = GetCsvProfile
($id);
482 # Getting output encoding
483 my $encoding = $profile->{encoding
} || 'utf8';
485 my $csvseparator = $profile->{csv_separator
} || ',';
486 my $fieldseparator = $profile->{field_separator
} || '#';
487 my $subfieldseparator = $profile->{subfield_separator
} || '|';
489 # TODO: Be more generic (in case we have to handle other protected chars or more separators)
490 if ($csvseparator eq '\t') { $csvseparator = "\t" }
491 if ($fieldseparator eq '\t') { $fieldseparator = "\t" }
492 if ($subfieldseparator eq '\t') { $subfieldseparator = "\t" }
493 if ($csvseparator eq '\n') { $csvseparator = "\n" }
494 if ($fieldseparator eq '\n') { $fieldseparator = "\n" }
495 if ($subfieldseparator eq '\n') { $subfieldseparator = "\n" }
497 $csv = $csv->encoding_out($encoding) ;
498 $csv->sep_char($csvseparator);
500 # Getting the marcfields
501 my $marcfieldslist = $profile->{content
};
503 # Getting the marcfields as an array
504 my @marcfieldsarray = split('\|', $marcfieldslist);
506 # Separating the marcfields from the user-supplied headers
508 foreach (@marcfieldsarray) {
509 my @result = split('=', $_, 2);
510 my $content = ( @result == 2 )
514 while ( $content =~ m
|(\d
{3})\
$?
(.)?
|g
) {
516 my $subfieldtag = $2 || undef;
517 push @fields, { fieldtag
=> $fieldtag, subfieldtag
=> $subfieldtag };
520 push @csv_structures, { header
=> $result[0], content
=> $content, fields
=> \
@fields };
522 push @csv_structures, { content
=> $content, fields
=> \
@fields }
526 my ( @marcfieldsheaders, @csv_rows );
527 my $dbh = C4
::Context
->dbh;
530 for my $field ( $record->fields ) {
531 my $fieldtag = $field->tag;
533 if ( $field->is_control_field ) {
534 $values = $field->data();
536 $values->{indicator
}{1} = $field->indicator(1);
537 $values->{indicator
}{2} = $field->indicator(2);
538 for my $subfield ( $field->subfields ) {
539 my $subfieldtag = $subfield->[0];
540 my $value = $subfield->[1];
541 push @
{ $values->{$subfieldtag} }, $value;
544 # We force the key as an integer (trick for 00X and OXX fields)
545 push @
{ $field_list->{fields
}{0+$fieldtag} }, $values;
548 # For each field or subfield
549 foreach my $csv_structure (@csv_structures) {
551 my $tags = $csv_structure->{fields
};
552 my $content = $csv_structure->{content
};
555 # If we have a user-supplied header, we use it
556 if ( exists $csv_structure->{header
} ) {
557 push @marcfieldsheaders, $csv_structure->{header
};
559 # If not, we get the matching tag name from koha
560 my $tag = $tags->[0];
561 if ( $tag->{subfieldtag
} ) {
562 my $query = "SELECT liblibrarian FROM marc_subfield_structure WHERE tagfield=? AND tagsubfield=?";
563 my @results = $dbh->selectrow_array( $query, {}, $tag->{fieldtag
}, $tag->{subfieldtag
} );
564 push @marcfieldsheaders, $results[0];
566 my $query = "SELECT liblibrarian FROM marc_tag_structure WHERE tagfield=?";
567 my @results = $dbh->selectrow_array( $query, {}, $tag->{fieldtag
} );
568 push @marcfieldsheaders, $results[0];
574 if ( $content =~ m
|\
[\
%.*\
%\
]| ) {
575 my $tt = Template
->new();
576 my $template = $content;
578 # Replace 00X and 0XX with X or XX
579 $content =~ s
|fields
.00(\d
)|fields
.$1|g
;
580 $content =~ s
|fields
.0(\d
{2})|fields
.$1|g
;
582 $tt->process( \
$content, $field_list, \
$tt_output );
583 push @csv_rows, $tt_output;
585 for my $tag ( @
$tags ) {
586 my @fields = $record->field( $tag->{fieldtag
} );
587 # If it is a subfield
589 if ( $tag->{subfieldtag
} ) {
591 foreach my $field (@fields) {
592 my @subfields = $field->subfield( $tag->{subfieldtag
} );
593 foreach my $subfield (@subfields) {
594 my $authvalues = GetKohaAuthorisedValuesFromField
( $tag->{fieldtag
}, $tag->{subfieldtag
}, $frameworkcode, undef);
595 push @loop_values, (defined $authvalues->{$subfield}) ?
$authvalues->{$subfield} : $subfield;
601 my $authvalues = GetKohaAuthorisedValuesFromField
( $tag->{fieldtag
}, undef, $frameworkcode, undef);
603 foreach my $field ( @fields ) {
606 # If it is a control field
607 if ($field->is_control_field) {
608 $value = defined $authvalues->{$field->as_string} ?
$authvalues->{$field->as_string} : $field->as_string;
610 # If it is a field, we gather all subfields, joined by the subfield separator
612 my @subfields = $field->subfields;
613 foreach my $subfield (@subfields) {
614 push (@subvaluesarray, defined $authvalues->{$subfield->[1]} ?
$authvalues->{$subfield->[1]} : $subfield->[1]);
616 $value = join ($subfieldseparator, @subvaluesarray);
620 my $marcfield = $tag->{fieldtag
}; # This line fixes a retrocompatibility concern
621 # The "processing" could be based on the $marcfield variable.
622 eval $fieldprocessing if ($fieldprocessing);
624 push @loop_values, $value;
628 push @field_values, {
629 fieldtag
=> $tag->{fieldtag
},
630 subfieldtag
=> $tag->{subfieldtag
},
631 values => \
@loop_values,
634 for my $field_value ( @field_values ) {
635 if ( $field_value->{subfieldtag
} ) {
636 push @csv_rows, join( $subfieldseparator, @
{ $field_value->{values} } );
638 push @csv_rows, join( $fieldseparator, @
{ $field_value->{values} } );
646 $csv->combine(@marcfieldsheaders);
647 $output = $csv->string() . "\n";
649 $csv->combine(@csv_rows);
650 $output .= $csv->string() . "\n";
657 =head2 changeEncoding - Change the encoding of a record
659 my ($error, $newrecord) = changeEncoding($record,$format,$flavour,$to_encoding,$from_encoding);
661 Changes the encoding of a record
663 C<$record> - the record itself can be in ISO-2709, a MARC::Record object, or MARCXML for now (required)
665 C<$format> - MARC or MARCXML (required)
667 C<$flavour> - MARC21 or UNIMARC, if MARC21, it will change the leader (optional) [defaults to Koha system preference]
669 C<$to_encoding> - the encoding you want the record to end up in (optional) [UTF-8]
671 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)
673 FIXME: the from_encoding doesn't work yet
675 FIXME: better handling for UNIMARC, it should allow management of 100 field
677 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
682 my ($record,$format,$flavour,$to_encoding,$from_encoding) = @_;
685 unless($flavour) {$flavour = C4
::Context
->preference("marcflavour")};
686 unless($to_encoding) {$to_encoding = "UTF-8"};
688 # ISO-2709 Record (MARC21 or UNIMARC)
689 if (lc($format) =~ /^marc$/o) {
690 # if we're converting encoding of an ISO2709 file, we need to roundtrip through XML
691 # because MARC::Record doesn't directly provide us with an encoding method
692 # It's definitely less than idea and should be fixed eventually - kados
693 my $marcxml; # temporary storage of MARCXML scalar
694 ($error,$marcxml) = marc2marcxml
($record,$to_encoding,$flavour);
696 ($error,$newrecord) = marcxml2marc
($marcxml,$to_encoding,$flavour);
700 } elsif (lc($format) =~ /^marcxml$/o) { # MARCXML Record
702 ($error,$marc) = marcxml2marc
($record,$to_encoding,$flavour);
704 ($error,$newrecord) = marc2marcxml
($record,$to_encoding,$flavour);
707 $error.="Unsupported record format:".$format;
709 return ($error,$newrecord);
712 =head2 marc2bibtex - Convert from MARC21 and UNIMARC to BibTex
714 my ($bibtex) = marc2bibtex($record, $id);
716 Returns a BibTex scalar
718 C<$record> - a MARC::Record object
720 C<$id> - an id for the BibTex record (might be the biblionumber)
726 my ($record, $id) = @_;
728 my $marcflavour = C4
::Context
->preference("marcflavour");
733 my @authorFields = ('100','110','111','700','710','711');
734 @authorFields = ('700','701','702','710','711','721') if ( $marcflavour eq "UNIMARC" );
736 foreach my $field ( @authorFields ) {
737 # author formatted surname, firstname
739 if ( $marcflavour eq "UNIMARC" ) {
740 $texauthor = join ', ',
741 ( $record->subfield($field,"a"), $record->subfield($field,"b") );
743 $texauthor = $record->subfield($field,"a");
745 push @texauthors, $texauthor if $texauthor;
747 $author = join ' and ', @texauthors;
749 # Defining the conversion array according to the marcflavour
751 if ( $marcflavour eq "UNIMARC" ) {
753 # FIXME, TODO : handle repeatable fields
754 # TODO : handle more types of documents
756 # Unimarc to bibtex array
761 title
=> $record->subfield("200", "a") || "",
762 editor
=> $record->subfield("210", "g") || "",
763 publisher
=> $record->subfield("210", "c") || "",
764 year
=> $record->subfield("210", "d") || $record->subfield("210", "h") || "",
767 volume
=> $record->subfield("200", "v") || "",
768 series
=> $record->subfield("225", "a") || "",
769 address
=> $record->subfield("210", "a") || "",
770 edition
=> $record->subfield("205", "a") || "",
771 note
=> $record->subfield("300", "a") || "",
772 url
=> $record->subfield("856", "u") || ""
776 # Marc21 to bibtex array
781 title
=> $record->subfield("245", "a") || "",
782 editor
=> $record->subfield("260", "f") || "",
783 publisher
=> $record->subfield("264", "b") || $record->subfield("260", "b") || "",
784 year
=> $record->subfield("264", "c") || $record->subfield("260", "c") || $record->subfield("260", "g") || "",
787 # unimarc to marc21 specification says not to convert 200$v to marc21
788 series
=> $record->subfield("490", "a") || "",
789 address
=> $record->subfield("264", "a") || $record->subfield("260", "a") || "",
790 edition
=> $record->subfield("250", "a") || "",
791 note
=> $record->subfield("500", "a") || "",
792 url
=> $record->subfield("856", "u") || ""
796 my $BibtexExportAdditionalFields = C4
::Context
->preference('BibtexExportAdditionalFields');
797 my $additional_fields;
798 if ($BibtexExportAdditionalFields) {
799 $BibtexExportAdditionalFields = "$BibtexExportAdditionalFields\n\n";
800 $additional_fields = eval { YAML
::Load
($BibtexExportAdditionalFields); };
802 warn "Unable to parse BibtexExportAdditionalFields : $@";
803 $additional_fields = undef;
807 if ( $additional_fields && $additional_fields->{'@'} ) {
808 my ( $f, $sf ) = split( /\$/, $additional_fields->{'@'} );
809 my ( $type ) = read_field
( { record
=> $record, field
=> $f, subfield
=> $sf, field_numbers
=> [1] } );
812 $tex .= '@' . $type . '{';
823 for ( my $i = 0 ; $i < scalar( @bh ) ; $i = $i + 2 ) {
824 next unless $bh[$i+1];
825 push @elt, qq|\t$bh[$i] = {$bh[$i+1]}|;
827 $tex .= join(",\n", $id, @elt);
829 if ($additional_fields) {
831 foreach my $bibtex_tag ( keys %$additional_fields ) {
832 next if $bibtex_tag eq '@';
835 ref( $additional_fields->{$bibtex_tag} ) eq 'ARRAY'
836 ? @
{ $additional_fields->{$bibtex_tag} }
837 : $additional_fields->{$bibtex_tag};
839 for my $tag (@fields) {
840 my ( $f, $sf ) = split( /\$/, $tag );
841 my @values = read_field
( { record
=> $record, field
=> $f, subfield
=> $sf } );
842 foreach my $v (@values) {
843 $tex .= qq(\t$bibtex_tag = {$v}\n);
858 =head1 INTERNAL FUNCTIONS
860 =head2 _entity_encode - Entity-encode an array of strings
862 my ($entity_encoded_string) = _entity_encode($string);
866 my (@entity_encoded_strings) = _entity_encode(@strings);
868 Entity-encode an array of strings
874 my @strings_entity_encoded;
875 foreach my $string (@strings) {
876 my $nfc_string = NFC
($string);
877 $nfc_string =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
878 push @strings_entity_encoded, $nfc_string;
880 return @strings_entity_encoded;
883 END { } # module clean-up code here (global destructor)
889 Joshua Ferraro <jmf@liblime.com>