X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FRecord.pm;h=cde523f015ada6574614f94d0cb47c9a43ff0f10;hb=4ccbae8879a386a1846bb48c18b3722f936dc983;hp=cecb6ed266aca1913e63d6a317ff357437fbca9f;hpb=c0234dd9b9649063acf2617fecf5c6efda38a532;p=koha.git diff --git a/C4/Record.pm b/C4/Record.pm index cecb6ed266..cde523f015 100644 --- a/C4/Record.pm +++ b/C4/Record.pm @@ -2,21 +2,22 @@ package C4::Record; # # Copyright 2006 (C) LibLime # Parts copyright 2010 BibLibre +# Part copyright 2015 Universidad de El Salvador # # This file is part of Koha. # -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. # -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. # -# You should have received a copy of the GNU General Public License along -# with Koha; if not, write to the Free Software Foundation, Inc., -# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . # # use strict; @@ -25,21 +26,23 @@ use strict; # please specify in which methods a given module is used use MARC::Record; # marc2marcxml, marcxml2marc, changeEncoding use MARC::File::XML; # marc2marcxml, marcxml2marc, changeEncoding -use MARC::Crosswalk::DublinCore; # marc2dcxml use Biblio::EndnoteStyle; use Unicode::Normalize; # _entity_encode -use XML::LibXSLT; -use XML::LibXML; use C4::Biblio; #marc2bibtex -use C4::Csv; #marc2csv use C4::Koha; #marc2csv +use C4::XSLT (); use YAML; #marcrecords2csv +use Template; use Text::CSV::Encoded; #marc2csv +use Koha::Items; +use Koha::SimpleMARC qw(read_field); +use Koha::XSLT_Handler; +use Koha::CsvProfiles; +use Koha::AuthorisedValues; +use Carp; -use vars qw($VERSION @ISA @EXPORT); +use vars qw(@ISA @EXPORT); -# set the version for version checking -$VERSION = 3.00; @ISA = qw(Exporter); @@ -52,6 +55,7 @@ $VERSION = 3.00; &marcxml2marc &marc2dcxml &marc2modsxml + &marc2madsxml &marc2bibtex &marc2csv &changeEncoding @@ -77,7 +81,32 @@ Returns an ISO-2709 scalar sub marc2marc { my ($marc,$to_flavour,$from_flavour,$encoding) = @_; - my $error = "Feature not yet implemented\n"; + my $error; + if ($to_flavour =~ m/marcstd/) { + my $marc_record_obj; + if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object + $marc_record_obj = $marc; + } else { # it's not a MARC::Record object, make it one + eval { $marc_record_obj = MARC::Record->new_from_usmarc($marc) }; # handle exceptions + +# conversion to MARC::Record object failed, populate $error + if ($@) { $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR }; + } + unless ($error) { + my @privatefields; + foreach my $field ($marc_record_obj->fields()) { + if ($field->tag() =~ m/9/ && ($field->tag() != '490' || C4::Context->preference("marcflavour") eq 'UNIMARC')) { + push @privatefields, $field; + } elsif (! ($field->is_control_field())) { + $field->delete_subfield(code => '9') if ($field->subfield('9')); + } + } + $marc_record_obj->delete_field($_) for @privatefields; + $marc = $marc_record_obj->as_usmarc(); + } + } else { + $error = "Feature not yet implemented\n"; + } return ($error,$marc); } @@ -193,74 +222,134 @@ sub marcxml2marc { =head2 marc2dcxml - Convert from ISO-2709 to Dublin Core - my ($error,$dcxml) = marc2dcxml($marc,$qualified); + my dcxml = marc2dcxml ($marc, $xml, $biblionumber, $format); + +EXAMPLE -Returns a DublinCore::Record object, will eventually return a Dublin Core scalar + my dcxml = marc2dcxml (undef, undef, 1, "oaidc"); -FIXME: should return actual XML, not just an object +Convert MARC or MARCXML to Dublin Core metadata (XSLT Transformation), +optionally can get an XML directly from biblio_metadata +without item information. This method take into consideration the syspref +'marcflavour' (UNIMARC, MARC21 and NORMARC). +Return an XML file with the format defined in C<$format> C<$marc> - an ISO-2709 scalar or MARC::Record object -C<$qualified> - specify whether qualified Dublin Core should be used in the input or output [0] +C<$xml> - a MARCXML file + +C<$biblionumber> - biblionumber for database access + +C<$format> - accept three type of DC formats (oaidc, srwdc, and rdfdc ) =cut sub marc2dcxml { - my ($marc,$qualified) = @_; - my $error; - # test if it's already a MARC::Record object, if not, make it one - my $marc_record_obj; - if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object - $marc_record_obj = $marc; - } else { # it's not a MARC::Record object, make it one - eval { $marc_record_obj = MARC::Record->new_from_usmarc($marc) }; # handle exceptions + my ( $marc, $xml, $biblionumber, $format ) = @_; + + # global variables + my ( $marcxml, $record, $output ); + + # set the default path for intranet xslts + # differents xslts to process (OAIDC, SRWDC and RDFDC) + my $xsl = C4::Context->config('intrahtdocs') . '/prog/en/xslt/' . + C4::Context->preference('marcflavour') . 'slim2' . uc ( $format ) . '.xsl'; + + if ( defined $marc ) { + # no need to catch errors or warnings marc2marcxml do it instead + $marcxml = C4::Record::marc2marcxml( $marc ); + } elsif ( not defined $xml and defined $biblionumber ) { + # get MARCXML biblio directly without item information + $marcxml = C4::Biblio::GetXmlBiblio( $biblionumber ); + } else { + $marcxml = $xml; + } - # conversion to MARC::Record object failed, populate $error - if ($@) { - $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR; - } - } - my $crosswalk = MARC::Crosswalk::DublinCore->new; - if ($qualified) { - $crosswalk = MARC::Crosswalk::DublinCore->new( qualified => 1 ); - } - my $dcxml = $crosswalk->as_dublincore($marc_record_obj); - my $dcxmlfinal = "\n"; - $dcxmlfinal .= ""; - - foreach my $element ( $dcxml->elements() ) { - $dcxmlfinal.="<"."dc:".$element->name().">".$element->content()."name().">\n"; + # only proceed if MARC21 or UNIMARC; else clause is executed if marcflavour set it to NORMARC + # generate MARC::Record object to see if not a marcxml record + unless ( C4::Context->preference('marcflavour') eq 'NORMARC' ) { + eval { $record = MARC::Record->new_from_xml( + $marcxml, + 'UTF-8', + C4::Context->preference('marcflavour') + ); + }; + } else { + eval { $record = MARC::Record->new_from_xml( + $marcxml, + 'UTF-8', + 'MARC21' + ); + }; + } + + # conversion to MARC::Record object failed + if ( $@ ) { + croak "Creation of MARC::Record object failed."; + } elsif ( $record->warnings() ) { + carp "Warnings encountered while processing ISO-2709 record.\n"; + my @warnings = $record->warnings(); + foreach my $warn (@warnings) { + carp "\t". $warn; + }; + } elsif ( $record =~ /^MARC::Record/ ) { # if OK makes xslt transformation + my $xslt_engine = Koha::XSLT_Handler->new; + if ( $format =~ /^(dc|oaidc|srwdc|rdfdc)$/i ) { + $output = $xslt_engine->transform( $marcxml, $xsl ); + } else { + croak "The format argument ($format) not accepted.\n" . + "Please pass a valid format (oaidc, srwdc, or rdfdc)\n"; + } + my $err = $xslt_engine->err; # error code + if ( $err ) { + croak "Error $err while processing\n"; + } else { + return $output; + } } - $dcxmlfinal .= "\n"; - return ($error,$dcxmlfinal); } =head2 marc2modsxml - Convert from ISO-2709 to MODS - my ($error,$modsxml) = marc2modsxml($marc); + my $modsxml = marc2modsxml($marc); Returns a MODS scalar =cut sub marc2modsxml { - my ($marc) = @_; - # grab the XML, run it through our stylesheet, push it out to the browser - my $xmlrecord = marc2marcxml($marc); - my $xslfile = C4::Context->config('intrahtdocs')."/prog/en/xslt/MARC21slim2MODS3-1.xsl"; - my $parser = XML::LibXML->new(); - my $xslt = XML::LibXSLT->new(); - my $source = $parser->parse_string($xmlrecord); - my $style_doc = $parser->parse_file($xslfile); - my $stylesheet = $xslt->parse_stylesheet($style_doc); - my $results = $stylesheet->transform($source); - my $newxmlrecord = $stylesheet->output_string($results); - return ($newxmlrecord); + my ($marc) = @_; + return _transformWithStylesheet($marc, "/prog/en/xslt/MARC21slim2MODS3-1.xsl"); +} + +=head2 marc2madsxml - Convert from ISO-2709 to MADS + + my $madsxml = marc2madsxml($marc); + +Returns a MADS scalar + +=cut + +sub marc2madsxml { + my ($marc) = @_; + return _transformWithStylesheet($marc, "/prog/en/xslt/MARC21slim2MADS.xsl"); +} + +=head2 _transformWithStylesheet - Transform a MARC record with a stylesheet + + my $xml = _transformWithStylesheet($marc, $stylesheet) + +Returns the XML scalar result of the transformation. $stylesheet should +contain the path to a stylesheet under intrahtdocs. + +=cut + +sub _transformWithStylesheet { + my ($marc, $stylesheet) = @_; + # grab the XML, run it through our stylesheet, push it out to the browser + my $xmlrecord = marc2marcxml($marc); + my $xslfile = C4::Context->config('intrahtdocs') . $stylesheet; + return C4::XSLT::engine->transform($xmlrecord, $xslfile); } sub marc2endnote { @@ -279,33 +368,33 @@ sub marc2endnote { if ($f500) { $abstract = $f500->subfield('a'); } - my $fields = { - DB => C4::Context->preference("LibraryName"), - Title => $marc_rec_obj->title(), - Author => $marc_rec_obj->author(), - Publisher => $f710a, - City => $f260a, - Year => $marc_rec_obj->publication_date, - Abstract => $abstract, - }; - my $endnote; - my $style = new Biblio::EndnoteStyle(); - my $template; - $template.= "DB - DB\n" if C4::Context->preference("LibraryName"); - $template.="T1 - Title\n" if $marc_rec_obj->title(); - $template.="A1 - Author\n" if $marc_rec_obj->author(); - $template.="PB - Publisher\n" if $f710a; - $template.="CY - City\n" if $f260a; - $template.="Y1 - Year\n" if $marc_rec_obj->publication_date; - $template.="AB - Abstract\n" if $abstract; - my ($text, $errmsg) = $style->format($template, $fields); - return ($text); - + my $fields = { + DB => C4::Context->preference("LibraryName"), + Title => $marc_rec_obj->title(), + Author => $marc_rec_obj->author(), + Publisher => $f710a, + City => $f260a, + Year => $marc_rec_obj->publication_date, + Abstract => $abstract, + }; + my $endnote; + my $style = new Biblio::EndnoteStyle(); + my $template; + $template.= "DB - DB\n" if C4::Context->preference("LibraryName"); + $template.="T1 - Title\n" if $marc_rec_obj->title(); + $template.="A1 - Author\n" if $marc_rec_obj->author(); + $template.="PB - Publisher\n" if $f710a; + $template.="CY - City\n" if $f260a; + $template.="Y1 - Year\n" if $marc_rec_obj->publication_date; + $template.="AB - Abstract\n" if $abstract; + my ($text, $errmsg) = $style->format($template, $fields); + return ($text); + } =head2 marc2csv - Convert several records from UNIMARC to CSV - my ($csv) = marc2csv($biblios, $csvprofileid); + my ($csv) = marc2csv($biblios, $csvprofileid, $itemnumbers); Pre and postprocessing can be done through a YAML file @@ -313,12 +402,15 @@ Returns a CSV scalar C<$biblio> - a list of biblionumbers -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) +C<$csvprofileid> - the id of the CSV profile to use for the export (see export_format.export_format_id) + +C<$itemnumbers> - a list of itemnumbers to export =cut sub marc2csv { - my ($biblios, $id) = @_; + my ($biblios, $id, $itemnumbers) = @_; + $itemnumbers ||= []; my $output; my $csv = Text::CSV::Encoded->new(); @@ -333,9 +425,18 @@ sub marc2csv { eval $preprocess if ($preprocess); my $firstpass = 1; - foreach my $biblio (@$biblios) { - $output .= marcrecord2csv($biblio, $id, $firstpass, $csv, $fieldprocessing) ; - $firstpass = 0; + if ( @$itemnumbers ) { + for my $itemnumber ( @$itemnumbers) { + my $item = Koha::Items->find( $itemnumber ); + my $biblionumber = $item->biblio->biblionumber; + $output .= marcrecord2csv( $biblionumber, $id, $firstpass, $csv, $fieldprocessing, [$itemnumber] ); + $firstpass = 0; + } + } else { + foreach my $biblio (@$biblios) { + $output .= marcrecord2csv( $biblio, $id, $firstpass, $csv, $fieldprocessing ); + $firstpass = 0; + } } # Postprocessing @@ -352,34 +453,41 @@ Returns a CSV scalar C<$biblio> - a biblionumber -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) +C<$csvprofileid> - the id of the CSV profile to use for the export (see export_format.export_format_id) C<$header> - true if the headers are to be printed (typically at first pass) C<$csv> - an already initialised Text::CSV object -=cut +C<$fieldprocessing> +C<$itemnumbers> a list of itemnumbers to export + +=cut sub marcrecord2csv { - my ($biblio, $id, $header, $csv, $fieldprocessing) = @_; + my ($biblio, $id, $header, $csv, $fieldprocessing, $itemnumbers) = @_; my $output; # Getting the record - my $record = GetMarcBiblio($biblio, 1); - next unless $record; + my $record = GetMarcBiblio({ biblionumber => $biblio }); + return unless $record; + C4::Biblio::EmbedItemsInMarcBiblio({ + marc_record => $record, + biblionumber => $biblio, + item_numbers => $itemnumbers }); # Getting the framework my $frameworkcode = GetFrameworkCode($biblio); # Getting information about the csv profile - my $profile = GetCsvProfile($id); + my $profile = Koha::CsvProfiles->find($id); # Getting output encoding - my $encoding = $profile->{encoding} || 'utf8'; + my $encoding = $profile->encoding || 'utf8'; # Getting separators - my $csvseparator = $profile->{csv_separator} || ','; - my $fieldseparator = $profile->{field_separator} || '#'; - my $subfieldseparator = $profile->{subfield_separator} || '|'; + my $csvseparator = $profile->csv_separator || ','; + my $fieldseparator = $profile->field_separator || '#'; + my $subfieldseparator = $profile->subfield_separator || '|'; # TODO: Be more generic (in case we have to handle other protected chars or more separators) if ($csvseparator eq '\t') { $csvseparator = "\t" } @@ -393,104 +501,159 @@ sub marcrecord2csv { $csv->sep_char($csvseparator); # Getting the marcfields - my $marcfieldslist = $profile->{marcfields}; + my $marcfieldslist = $profile->content; # Getting the marcfields as an array my @marcfieldsarray = split('\|', $marcfieldslist); - # Separating the marcfields from the the user-supplied headers - my @marcfields; + # Separating the marcfields from the user-supplied headers + my @csv_structures; foreach (@marcfieldsarray) { - my @result = split('=', $_); - if (scalar(@result) == 2) { - push @marcfields, { header => $result[0], field => $result[1] }; + my @result = split('=', $_, 2); + my $content = ( @result == 2 ) + ? $result[1] + : $result[0]; + my @fields; + while ( $content =~ m|(\d{3})\$?(.)?|g ) { + my $fieldtag = $1; + my $subfieldtag = $2 || undef; + push @fields, { fieldtag => $fieldtag, subfieldtag => $subfieldtag }; + } + if ( @result == 2) { + push @csv_structures, { header => $result[0], content => $content, fields => \@fields }; } else { - push @marcfields, { field => $result[0] } + push @csv_structures, { content => $content, fields => \@fields } } } - # If we have to insert the headers - if ($header) { - my @marcfieldsheaders; - my $dbh = C4::Context->dbh; - - # For each field or subfield - foreach (@marcfields) { - - my $field = $_->{field}; - # Remove any blank char that might have unintentionally insered into the tag name - $field =~ s/\s+//g; - - # If we have a user-supplied header, we use it - if (exists $_->{header}) { - push @marcfieldsheaders, $_->{header}; - } else { - # If not, we get the matching tag name from koha - if (index($field, '$') > 0) { - my ($fieldtag, $subfieldtag) = split('\$', $field); - my $query = "SELECT liblibrarian FROM marc_subfield_structure WHERE tagfield=? AND tagsubfield=?"; - my $sth = $dbh->prepare($query); - $sth->execute($fieldtag, $subfieldtag); - my @results = $sth->fetchrow_array(); - push @marcfieldsheaders, $results[0]; - } else { - my $query = "SELECT liblibrarian FROM marc_tag_structure WHERE tagfield=?"; - my $sth = $dbh->prepare($query); - $sth->execute($field); - my @results = $sth->fetchrow_array(); - push @marcfieldsheaders, $results[0]; - } - } - } - $csv->combine(@marcfieldsheaders); - $output = $csv->string() . "\n"; - } + my ( @marcfieldsheaders, @csv_rows ); + my $dbh = C4::Context->dbh; - # For each marcfield to export - my @fieldstab; - foreach (@marcfields) { - my $marcfield = $_->{field}; - # If it is a subfield - if (index($marcfield, '$') > 0) { - my ($fieldtag, $subfieldtag) = split('\$', $marcfield); - my @fields = $record->field($fieldtag); - my @tmpfields; - - # For each field - foreach my $field (@fields) { - - # We take every matching subfield - my @subfields = $field->subfield($subfieldtag); - foreach my $subfield (@subfields) { - - # Getting authorised value - my $authvalues = GetKohaAuthorisedValuesFromField($fieldtag, $subfieldtag, $frameworkcode, undef); - push @tmpfields, (defined $authvalues->{$subfield}) ? $authvalues->{$subfield} : $subfield; - } - } - push (@fieldstab, join($subfieldseparator, @tmpfields)); - # Or a field - } else { - my @fields = ($record->field($marcfield)); - my $authvalues = GetKohaAuthorisedValuesFromField($marcfield, undef, $frameworkcode, undef); - - my @valuesarray; - foreach (@fields) { - my $value; + my $field_list; + for my $field ( $record->fields ) { + my $fieldtag = $field->tag; + my $values; + if ( $field->is_control_field ) { + $values = $field->data(); + } else { + $values->{indicator}{1} = $field->indicator(1); + $values->{indicator}{2} = $field->indicator(2); + for my $subfield ( $field->subfields ) { + my $subfieldtag = $subfield->[0]; + my $value = $subfield->[1]; + push @{ $values->{$subfieldtag} }, $value; + } + } + # We force the key as an integer (trick for 00X and OXX fields) + push @{ $field_list->{fields}{0+$fieldtag} }, $values; + } - # Getting authorised value - $value = defined $authvalues->{$_->as_string} ? $authvalues->{$_->as_string} : $_->as_string; + # For each field or subfield + foreach my $csv_structure (@csv_structures) { + my @field_values; + my $tags = $csv_structure->{fields}; + my $content = $csv_structure->{content}; + + if ( $header ) { + # If we have a user-supplied header, we use it + if ( exists $csv_structure->{header} ) { + push @marcfieldsheaders, $csv_structure->{header}; + } else { + # If not, we get the matching tag name from koha + my $tag = $tags->[0]; + if ( $tag->{subfieldtag} ) { + my $query = "SELECT liblibrarian FROM marc_subfield_structure WHERE tagfield=? AND tagsubfield=?"; + my @results = $dbh->selectrow_array( $query, {}, $tag->{fieldtag}, $tag->{subfieldtag} ); + push @marcfieldsheaders, $results[0]; + } else { + my $query = "SELECT liblibrarian FROM marc_tag_structure WHERE tagfield=?"; + my @results = $dbh->selectrow_array( $query, {}, $tag->{fieldtag} ); + push @marcfieldsheaders, $results[0]; + } + } + } - # Field processing - eval $fieldprocessing if ($fieldprocessing); + # TT tags exist + if ( $content =~ m|\[\%.*\%\]| ) { + my $tt = Template->new(); + my $template = $content; + my $vars; + # Replace 00X and 0XX with X or XX + $content =~ s|fields.00(\d)|fields.$1|g; + $content =~ s|fields.0(\d{2})|fields.$1|g; + my $tt_output; + $tt->process( \$content, $field_list, \$tt_output ); + push @csv_rows, $tt_output; + } else { + for my $tag ( @$tags ) { + my @fields = $record->field( $tag->{fieldtag} ); + # If it is a subfield + my @loop_values; + if ( $tag->{subfieldtag} ) { + my $av = Koha::AuthorisedValues->search_by_marc_field({ frameworkcode => $frameworkcode, tagfield => $tag->{fieldtag}, tagsubfield => $tag->{subfieldtag}, }); + $av = $av->count ? $av->unblessed : []; + my $av_description_mapping = { map { ( $_->{authorised_value} => $_->{lib} ) } @$av }; + # For each field + foreach my $field (@fields) { + my @subfields = $field->subfield( $tag->{subfieldtag} ); + foreach my $subfield (@subfields) { + push @loop_values, (defined $av_description_mapping->{$subfield}) ? $av_description_mapping->{$subfield} : $subfield; + } + } + + # Or a field + } else { + my $av = Koha::AuthorisedValues->search_by_marc_field({ frameworkcode => $frameworkcode, tagfield => $tag->{fieldtag}, }); + $av = $av->count ? $av->unblessed : []; + my $authvalues = { map { ( $_->{authorised_value} => $_->{lib} ) } @$av }; + + foreach my $field ( @fields ) { + my $value; + + # If it is a control field + if ($field->is_control_field) { + $value = defined $authvalues->{$field->as_string} ? $authvalues->{$field->as_string} : $field->as_string; + } else { + # If it is a field, we gather all subfields, joined by the subfield separator + my @subvaluesarray; + my @subfields = $field->subfields; + foreach my $subfield (@subfields) { + push (@subvaluesarray, defined $authvalues->{$subfield->[1]} ? $authvalues->{$subfield->[1]} : $subfield->[1]); + } + $value = join ($subfieldseparator, @subvaluesarray); + } + + # Field processing + my $marcfield = $tag->{fieldtag}; # This line fixes a retrocompatibility concern + # The "processing" could be based on the $marcfield variable. + eval $fieldprocessing if ($fieldprocessing); + + push @loop_values, $value; + } + + } + push @field_values, { + fieldtag => $tag->{fieldtag}, + subfieldtag => $tag->{subfieldtag}, + values => \@loop_values, + }; + } + for my $field_value ( @field_values ) { + if ( $field_value->{subfieldtag} ) { + push @csv_rows, join( $subfieldseparator, @{ $field_value->{values} } ); + } else { + push @csv_rows, join( $fieldseparator, @{ $field_value->{values} } ); + } + } + } + } - push @valuesarray, $value; - } - push (@fieldstab, join($fieldseparator, @valuesarray)); - } - }; - $csv->combine(@fieldstab); + if ( $header ) { + $csv->combine(@marcfieldsheaders); + $output = $csv->string() . "\n"; + } + $csv->combine(@csv_rows); $output .= $csv->string() . "\n"; return $output; @@ -528,7 +691,7 @@ sub changeEncoding { my $error; unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; unless($to_encoding) {$to_encoding = "UTF-8"}; - + # ISO-2709 Record (MARC21 or UNIMARC) if (lc($format) =~ /^marc$/o) { # if we're converting encoding of an ISO2709 file, we need to roundtrip through XML @@ -539,7 +702,7 @@ sub changeEncoding { unless ($error) { ($error,$newrecord) = marcxml2marc($marcxml,$to_encoding,$flavour); } - + # MARCXML Record } elsif (lc($format) =~ /^marcxml$/o) { # MARCXML Record my $marc; @@ -569,65 +732,131 @@ C<$id> - an id for the BibTex record (might be the biblionumber) sub marc2bibtex { my ($record, $id) = @_; my $tex; + my $marcflavour = C4::Context->preference("marcflavour"); # Authors - my $marcauthors = GetMarcAuthors($record,C4::Context->preference("marcflavour")); my $author; - for my $authors ( map { map { @$_ } values %$_ } @$marcauthors ) { - $author .= " and " if ($author && $$authors{value}); - $author .= $$authors{value} if ($$authors{value}); + my @texauthors; + my @authorFields = ('100','110','111','700','710','711'); + @authorFields = ('700','701','702','710','711','721') if ( $marcflavour eq "UNIMARC" ); + + foreach my $field ( @authorFields ) { + # author formatted surname, firstname + my $texauthor = ''; + if ( $marcflavour eq "UNIMARC" ) { + $texauthor = join ', ', + ( $record->subfield($field,"a"), $record->subfield($field,"b") ); + } else { + $texauthor = $record->subfield($field,"a"); + } + push @texauthors, $texauthor if $texauthor; } - - # Defining the conversion hash according to the marcflavour - my %bh; - if (C4::Context->preference("marcflavour") eq "UNIMARC") { - - # FIXME, TODO : handle repeatable fields - # TODO : handle more types of documents - - # Unimarc to bibtex hash - %bh = ( - - # Mandatory - author => $author, - title => $record->subfield("200", "a") || "", - editor => $record->subfield("210", "g") || "", - publisher => $record->subfield("210", "c") || "", - year => $record->subfield("210", "d") || $record->subfield("210", "h") || "", - - # Optional - volume => $record->subfield("200", "v") || "", - series => $record->subfield("225", "a") || "", - address => $record->subfield("210", "a") || "", - edition => $record->subfield("205", "a") || "", - note => $record->subfield("300", "a") || "", - url => $record->subfield("856", "u") || "" - ); + $author = join ' and ', @texauthors; + + # Defining the conversion array according to the marcflavour + my @bh; + if ( $marcflavour eq "UNIMARC" ) { + + # FIXME, TODO : handle repeatable fields + # TODO : handle more types of documents + + # Unimarc to bibtex array + @bh = ( + + # Mandatory + author => $author, + title => $record->subfield("200", "a") || "", + editor => $record->subfield("210", "g") || "", + publisher => $record->subfield("210", "c") || "", + year => $record->subfield("210", "d") || $record->subfield("210", "h") || "", + + # Optional + volume => $record->subfield("200", "v") || "", + series => $record->subfield("225", "a") || "", + address => $record->subfield("210", "a") || "", + edition => $record->subfield("205", "a") || "", + note => $record->subfield("300", "a") || "", + url => $record->subfield("856", "u") || "" + ); } else { - # Marc21 to bibtex hash - %bh = ( - - # Mandatory - author => $author, - title => $record->subfield("245", "a") || "", - editor => $record->subfield("260", "f") || "", - publisher => $record->subfield("260", "b") || "", - year => $record->subfield("260", "c") || $record->subfield("260", "g") || "", - - # Optional - # unimarc to marc21 specification says not to convert 200$v to marc21 - series => $record->subfield("490", "a") || "", - address => $record->subfield("260", "a") || "", - edition => $record->subfield("250", "a") || "", - note => $record->subfield("500", "a") || "", - url => $record->subfield("856", "u") || "" - ); + # Marc21 to bibtex array + @bh = ( + + # Mandatory + author => $author, + title => $record->subfield("245", "a") || "", + editor => $record->subfield("260", "f") || "", + publisher => $record->subfield("264", "b") || $record->subfield("260", "b") || "", + year => $record->subfield("264", "c") || $record->subfield("260", "c") || $record->subfield("260", "g") || "", + + # Optional + # unimarc to marc21 specification says not to convert 200$v to marc21 + series => $record->subfield("490", "a") || "", + address => $record->subfield("264", "a") || $record->subfield("260", "a") || "", + edition => $record->subfield("250", "a") || "", + note => $record->subfield("500", "a") || "", + url => $record->subfield("856", "u") || "" + ); + } + + my $BibtexExportAdditionalFields = C4::Context->preference('BibtexExportAdditionalFields'); + my $additional_fields; + if ($BibtexExportAdditionalFields) { + $BibtexExportAdditionalFields = "$BibtexExportAdditionalFields\n\n"; + $additional_fields = eval { YAML::Load($BibtexExportAdditionalFields); }; + if ($@) { + warn "Unable to parse BibtexExportAdditionalFields : $@"; + $additional_fields = undef; + } + } + + if ( $additional_fields && $additional_fields->{'@'} ) { + my ( $f, $sf ) = split( /\$/, $additional_fields->{'@'} ); + my ( $type ) = read_field( { record => $record, field => $f, subfield => $sf, field_numbers => [1] } ); + + if ($type) { + $tex .= '@' . $type . '{'; + } + else { + $tex .= "\@book{"; + } + } + else { + $tex .= "\@book{"; + } + + my @elt; + for ( my $i = 0 ; $i < scalar( @bh ) ; $i = $i + 2 ) { + next unless $bh[$i+1]; + push @elt, qq|\t$bh[$i] = {$bh[$i+1]}|; + } + $tex .= join(",\n", $id, @elt); + + if ($additional_fields) { + $tex .= ",\n"; + foreach my $bibtex_tag ( keys %$additional_fields ) { + next if $bibtex_tag eq '@'; + + my @fields = + ref( $additional_fields->{$bibtex_tag} ) eq 'ARRAY' + ? @{ $additional_fields->{$bibtex_tag} } + : $additional_fields->{$bibtex_tag}; + + for my $tag (@fields) { + my ( $f, $sf ) = split( /\$/, $tag ); + my @values = read_field( { record => $record, field => $f, subfield => $sf } ); + foreach my $v (@values) { + $tex .= qq(\t$bibtex_tag = {$v}\n); + } + } + } + } + else { + $tex .= "\n"; } - $tex .= "\@book{"; - $tex .= join(",\n", $id, map { $bh{$_} ? qq(\t$_ = "$bh{$_}") : () } keys %bh); - $tex .= "\n}\n"; + $tex .= "}\n"; return $tex; }