"Fossies" - the Fresh Open Source Software Archive

Member "koha-19.11.15/C4/Record.pm" (23 Feb 2021, 30200 Bytes) of package /linux/misc/koha-19.11.15.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Record.pm" see the Fossies "Dox" file reference documentation and the last Fossies "Diffs" side-by-side code changes report: 20.05.06_vs_20.11.00.

    1 package C4::Record;
    2 #
    3 # Copyright 2006 (C) LibLime
    4 # Parts copyright 2010 BibLibre
    5 # Part copyright 2015 Universidad de El Salvador
    6 #
    7 # This file is part of Koha.
    8 #
    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.
   13 #
   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.
   18 #
   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>.
   21 #
   22 #
   23 use strict;
   24 #use warnings; FIXME - Bug 2505
   25 
   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::Koha; #marc2csv
   33 use C4::XSLT ();
   34 use YAML; #marcrecords2csv
   35 use Template;
   36 use Text::CSV::Encoded; #marc2csv
   37 use Koha::Items;
   38 use Koha::SimpleMARC qw(read_field);
   39 use Koha::XSLT_Handler;
   40 use Koha::CsvProfiles;
   41 use Koha::AuthorisedValues;
   42 use Carp;
   43 
   44 use vars qw(@ISA @EXPORT);
   45 
   46 
   47 @ISA = qw(Exporter);
   48 
   49 # only export API methods
   50 
   51 @EXPORT = qw(
   52   &marc2endnote
   53   &marc2marc
   54   &marc2marcxml
   55   &marcxml2marc
   56   &marc2dcxml
   57   &marc2modsxml
   58   &marc2madsxml
   59   &marc2bibtex
   60   &marc2csv
   61   &changeEncoding
   62 );
   63 
   64 =head1 NAME
   65 
   66 C4::Record - MARC, MARCXML, DC, MODS, XML, etc. Record Management Functions and API
   67 
   68 =head1 SYNOPSIS
   69 
   70 New in Koha 3.x. This module handles all record-related management functions.
   71 
   72 =head1 API (EXPORTED FUNCTIONS)
   73 
   74 =head2 marc2marc - Convert from one flavour of ISO-2709 to another
   75 
   76   my ($error,$newmarc) = marc2marc($marc,$to_flavour,$from_flavour,$encoding);
   77 
   78 Returns an ISO-2709 scalar
   79 
   80 =cut
   81 
   82 sub marc2marc {
   83     my ($marc,$to_flavour,$from_flavour,$encoding) = @_;
   84     my $error;
   85     if ($to_flavour =~ m/marcstd/) {
   86         my $marc_record_obj;
   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
   91 
   92 # conversion to MARC::Record object failed, populate $error
   93                 if ($@) { $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR };
   94         }
   95         unless ($error) {
   96             my @privatefields;
   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'));
  102                 }
  103             }
  104             $marc_record_obj->delete_field($_) for @privatefields;
  105             $marc = $marc_record_obj->as_usmarc();
  106         }
  107     } else {
  108         $error = "Feature not yet implemented\n";
  109     }
  110     return ($error,$marc);
  111 }
  112 
  113 =head2 marc2marcxml - Convert from ISO-2709 to MARCXML
  114 
  115   my ($error,$marcxml) = marc2marcxml($marc,$encoding,$flavour);
  116 
  117 Returns a MARCXML scalar
  118 
  119 C<$marc> - an ISO-2709 scalar or MARC::Record object
  120 
  121 C<$encoding> - UTF-8 or MARC-8 [UTF-8]
  122 
  123 C<$flavour> - MARC21 or UNIMARC
  124 
  125 C<$dont_entity_encode> - a flag that instructs marc2marcxml not to entity encode the xml before returning (optional)
  126 
  127 =cut
  128 
  129 sub marc2marcxml {
  130     my ($marc,$encoding,$flavour,$dont_entity_encode) = @_;
  131     my $error; # the error string
  132     my $marcxml; # the final MARCXML scalar
  133 
  134     # test if it's already a MARC::Record object, if not, make it one
  135     my $marc_record_obj;
  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
  140 
  141         # conversion to MARC::Record object failed, populate $error
  142         if ($@) { $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR };
  143     }
  144     # only proceed if no errors so far
  145     unless ($error) {
  146 
  147         # check the record for warnings
  148         my @warnings = $marc_record_obj->warnings();
  149         if (@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 };
  152         }
  153         unless($encoding) {$encoding = "UTF-8"}; # set default encoding
  154         unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; # set default MARC flavour
  155 
  156         # attempt to convert the record to MARCXML
  157         eval { $marcxml = $marc_record_obj->as_xml_record($flavour) }; #handle exceptions
  158 
  159         # record creation failed, populate $error
  160         if ($@) {
  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" };
  165 
  166         # record creation was successful
  167         } else {
  168 
  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();
  171             if (@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 };
  174             }
  175         }
  176 
  177         # only proceed if no errors so far
  178         unless ($error) {
  179 
  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;
  184             }
  185         }
  186     }
  187     # return result to calling program
  188     return ($error,$marcxml);
  189 }
  190 
  191 =head2 marcxml2marc - Convert from MARCXML to ISO-2709
  192 
  193   my ($error,$marc) = marcxml2marc($marcxml,$encoding,$flavour);
  194 
  195 Returns an ISO-2709 scalar
  196 
  197 C<$marcxml> - a MARCXML record
  198 
  199 C<$encoding> - UTF-8 or MARC-8 [UTF-8]
  200 
  201 C<$flavour> - MARC21 or UNIMARC
  202 
  203 =cut
  204 
  205 sub marcxml2marc {
  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
  211 
  212     # attempt to do the conversion
  213     eval { $marc = MARC::Record->new_from_xml($marcxml,$encoding,$flavour) }; # handle exceptions
  214 
  215     # record creation failed, populate $error
  216     if ($@) {$error .="\nCreation of MARCXML Record failed: ".$@;
  217         $error.=$MARC::File::ERROR if ($MARC::File::ERROR);
  218         };
  219     # return result to calling program
  220     return ($error,$marc);
  221 }
  222 
  223 =head2 marc2dcxml - Convert from ISO-2709 to Dublin Core
  224 
  225     my dcxml = marc2dcxml ($marc, $xml, $biblionumber, $format);
  226 
  227 EXAMPLE
  228 
  229     my dcxml = marc2dcxml (undef, undef, 1, "oaidc");
  230 
  231 Convert MARC or MARCXML to Dublin Core metadata (XSLT Transformation),
  232 optionally can get an XML directly from biblio_metadata
  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>
  236 
  237 C<$marc> - an ISO-2709 scalar or MARC::Record object
  238 
  239 C<$xml> - a MARCXML file
  240 
  241 C<$biblionumber> - biblionumber for database access
  242 
  243 C<$format> - accept three type of DC formats (oaidc, srwdc, and rdfdc )
  244 
  245 =cut
  246 
  247 sub marc2dcxml {
  248     my ( $marc, $xml, $biblionumber, $format ) = @_;
  249 
  250     # global variables
  251     my ( $marcxml, $record, $output );
  252 
  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';
  257 
  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 without item information
  263         $marcxml = C4::Biblio::GetXmlBiblio( $biblionumber );
  264     } else {
  265         $marcxml = $xml;
  266     }
  267 
  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(
  272                          $marcxml,
  273                          'UTF-8',
  274                          C4::Context->preference('marcflavour')
  275                );
  276         };
  277     } else {
  278         eval { $record = MARC::Record->new_from_xml(
  279                          $marcxml,
  280                         'UTF-8',
  281                         'MARC21'
  282                );
  283         };
  284     }
  285 
  286     # conversion to MARC::Record object failed
  287     if ( $@ ) {
  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) {
  293             carp "\t". $warn;
  294         };
  295     } elsif ( $record =~ /^MARC::Record/ ) { # if OK makes xslt transformation
  296         my $xslt_engine = Koha::XSLT_Handler->new;
  297         if ( $format =~ /^(dc|oaidc|srwdc|rdfdc)$/i ) {
  298             $output = $xslt_engine->transform( $marcxml, $xsl );
  299         } else {
  300             croak "The format argument ($format) not accepted.\n" .
  301                   "Please pass a valid format (oaidc, srwdc, or rdfdc)\n";
  302         }
  303         my $err = $xslt_engine->err; # error code
  304         if ( $err ) {
  305             croak "Error $err while processing\n";
  306         } else {
  307             return $output;
  308         }
  309     }
  310 }
  311 
  312 =head2 marc2modsxml - Convert from ISO-2709 to MODS
  313 
  314   my $modsxml = marc2modsxml($marc);
  315 
  316 Returns a MODS scalar
  317 
  318 =cut
  319 
  320 sub marc2modsxml {
  321     my ($marc) = @_;
  322     return _transformWithStylesheet($marc, "/prog/en/xslt/MARC21slim2MODS3-1.xsl");
  323 }
  324 
  325 =head2 marc2madsxml - Convert from ISO-2709 to MADS
  326 
  327   my $madsxml = marc2madsxml($marc);
  328 
  329 Returns a MADS scalar
  330 
  331 =cut
  332 
  333 sub marc2madsxml {
  334     my ($marc) = @_;
  335     return _transformWithStylesheet($marc, "/prog/en/xslt/MARC21slim2MADS.xsl");
  336 }
  337 
  338 =head2 _transformWithStylesheet - Transform a MARC record with a stylesheet
  339 
  340     my $xml = _transformWithStylesheet($marc, $stylesheet)
  341 
  342 Returns the XML scalar result of the transformation. $stylesheet should
  343 contain the path to a stylesheet under intrahtdocs.
  344 
  345 =cut
  346 
  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);
  353 }
  354 
  355 sub marc2endnote {
  356     my ($marc) = @_;
  357     my $marc_rec_obj =  MARC::Record->new_from_usmarc($marc);
  358     my ( $abstract, $f260a, $f710a );
  359     my $f260 = $marc_rec_obj->field('260');
  360     if ($f260) {
  361         $f260a = $f260->subfield('a') if $f260;
  362     }
  363     my $f710 = $marc_rec_obj->field('710');
  364     if ($f710) {
  365         $f710a = $f710->subfield('a');
  366     }
  367     my $f500 = $marc_rec_obj->field('500');
  368     if ($f500) {
  369         $abstract = $f500->subfield('a');
  370     }
  371     my $fields = {
  372         DB => C4::Context->preference("LibraryName"),
  373         Title => $marc_rec_obj->title(),
  374         Author => $marc_rec_obj->author(),
  375         Publisher => $f710a,
  376         City => $f260a,
  377         Year => $marc_rec_obj->publication_date,
  378         Abstract => $abstract,
  379     };
  380     my $endnote;
  381     my $style = new Biblio::EndnoteStyle();
  382     my $template;
  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);
  391     return ($text);
  392 
  393 }
  394 
  395 =head2 marc2csv - Convert several records from UNIMARC to CSV
  396 
  397   my ($csv) = marc2csv($biblios, $csvprofileid, $itemnumbers);
  398 
  399 Pre and postprocessing can be done through a YAML file
  400 
  401 Returns a CSV scalar
  402 
  403 C<$biblio> - a list of biblionumbers
  404 
  405 C<$csvprofileid> - the id of the CSV profile to use for the export (see export_format.export_format_id)
  406 
  407 C<$itemnumbers> - a list of itemnumbers to export
  408 
  409 =cut
  410 
  411 sub marc2csv {
  412     my ($biblios, $id, $itemnumbers) = @_;
  413     $itemnumbers ||= [];
  414     my $output;
  415     my $csv = Text::CSV::Encoded->new();
  416 
  417     # Getting yaml file
  418     my $configfile = "../tools/csv-profiles/$id.yaml";
  419     my ($preprocess, $postprocess, $fieldprocessing);
  420     if (-e $configfile){
  421         ($preprocess,$postprocess, $fieldprocessing) = YAML::LoadFile($configfile);
  422     }
  423 
  424     # Preprocessing
  425     eval $preprocess if ($preprocess);
  426 
  427     my $firstpass = 1;
  428     if ( @$itemnumbers ) {
  429         for my $itemnumber ( @$itemnumbers) {
  430             my $item = Koha::Items->find( $itemnumber );
  431             my $biblionumber = $item->biblio->biblionumber;
  432             $output .= marcrecord2csv( $biblionumber, $id, $firstpass, $csv, $fieldprocessing, [$itemnumber] );
  433             $firstpass = 0;
  434         }
  435     } else {
  436         foreach my $biblio (@$biblios) {
  437             $output .= marcrecord2csv( $biblio, $id, $firstpass, $csv, $fieldprocessing );
  438             $firstpass = 0;
  439         }
  440     }
  441 
  442     # Postprocessing
  443     eval $postprocess if ($postprocess);
  444 
  445     return $output;
  446 }
  447 
  448 =head2 marcrecord2csv - Convert a single record from UNIMARC to CSV
  449 
  450   my ($csv) = marcrecord2csv($biblio, $csvprofileid, $header);
  451 
  452 Returns a CSV scalar
  453 
  454 C<$biblio> - a biblionumber
  455 
  456 C<$csvprofileid> - the id of the CSV profile to use for the export (see export_format.export_format_id)
  457 
  458 C<$header> - true if the headers are to be printed (typically at first pass)
  459 
  460 C<$csv> - an already initialised Text::CSV object
  461 
  462 C<$fieldprocessing>
  463 
  464 C<$itemnumbers> a list of itemnumbers to export
  465 
  466 =cut
  467 
  468 sub marcrecord2csv {
  469     my ($biblio, $id, $header, $csv, $fieldprocessing, $itemnumbers) = @_;
  470     my $output;
  471 
  472     # Getting the record
  473     my $record = GetMarcBiblio({ biblionumber => $biblio });
  474     return unless $record;
  475     C4::Biblio::EmbedItemsInMarcBiblio({
  476         marc_record  => $record,
  477         biblionumber => $biblio,
  478         item_numbers => $itemnumbers });
  479     # Getting the framework
  480     my $frameworkcode = GetFrameworkCode($biblio);
  481 
  482     # Getting information about the csv profile
  483     my $profile = Koha::CsvProfiles->find($id);
  484 
  485     # Getting output encoding
  486     my $encoding          = $profile->encoding || 'utf8';
  487     # Getting separators
  488     my $csvseparator      = $profile->csv_separator      || ',';
  489     my $fieldseparator    = $profile->field_separator    || '#';
  490     my $subfieldseparator = $profile->subfield_separator || '|';
  491 
  492     # TODO: Be more generic (in case we have to handle other protected chars or more separators)
  493     if ($csvseparator eq '\t') { $csvseparator = "\t" }
  494     if ($fieldseparator eq '\t') { $fieldseparator = "\t" }
  495     if ($subfieldseparator eq '\t') { $subfieldseparator = "\t" }
  496     if ($csvseparator eq '\n') { $csvseparator = "\n" }
  497     if ($fieldseparator eq '\n') { $fieldseparator = "\n" }
  498     if ($subfieldseparator eq '\n') { $subfieldseparator = "\n" }
  499 
  500     $csv = $csv->encoding_out($encoding) ;
  501     $csv->sep_char($csvseparator);
  502 
  503     # Getting the marcfields
  504     my $marcfieldslist = $profile->content;
  505 
  506     # Getting the marcfields as an array
  507     my @marcfieldsarray = split('\|', $marcfieldslist);
  508 
  509    # Separating the marcfields from the user-supplied headers
  510     my @csv_structures;
  511     foreach (@marcfieldsarray) {
  512         my @result = split('=', $_, 2);
  513         my $content = ( @result == 2 )
  514             ? $result[1]
  515             : $result[0];
  516         my @fields;
  517         while ( $content =~ m|(\d{3})\$?(.)?|g ) {
  518             my $fieldtag = $1;
  519             my $subfieldtag = $2;
  520             push @fields, { fieldtag => $fieldtag, subfieldtag => $subfieldtag };
  521         }
  522         if ( @result == 2) {
  523            push @csv_structures, { header => $result[0], content => $content, fields => \@fields };
  524         } else {
  525            push @csv_structures, { content => $content, fields => \@fields }
  526         }
  527     }
  528 
  529     my ( @marcfieldsheaders, @csv_rows );
  530     my $dbh = C4::Context->dbh;
  531 
  532     my $field_list;
  533     for my $field ( $record->fields ) {
  534         my $fieldtag = $field->tag;
  535         my $values;
  536         if ( $field->is_control_field ) {
  537             $values = $field->data();
  538         } else {
  539             $values->{indicator}{1} = $field->indicator(1);
  540             $values->{indicator}{2} = $field->indicator(2);
  541             for my $subfield ( $field->subfields ) {
  542                 my $subfieldtag = $subfield->[0];
  543                 my $value = $subfield->[1];
  544                 push @{ $values->{$subfieldtag} }, $value;
  545             }
  546         }
  547         # We force the key as an integer (trick for 00X and OXX fields)
  548         push @{ $field_list->{fields}{0+$fieldtag} }, $values;
  549     }
  550 
  551     # For each field or subfield
  552     foreach my $csv_structure (@csv_structures) {
  553         my @field_values;
  554         my $tags = $csv_structure->{fields};
  555         my $content = $csv_structure->{content};
  556 
  557         if ( $header ) {
  558             # If we have a user-supplied header, we use it
  559             if ( exists $csv_structure->{header} ) {
  560                 push @marcfieldsheaders, $csv_structure->{header};
  561             } else {
  562                 # If not, we get the matching tag name from koha
  563                 my $tag = $tags->[0];
  564                 if (defined $tag->{subfieldtag} ) {
  565                     my $query = "SELECT liblibrarian FROM marc_subfield_structure WHERE tagfield=? AND tagsubfield=?";
  566                     my @results = $dbh->selectrow_array( $query, {}, $tag->{fieldtag}, $tag->{subfieldtag} );
  567                     push @marcfieldsheaders, $results[0];
  568                 } else {
  569                     my $query = "SELECT liblibrarian FROM marc_tag_structure WHERE tagfield=?";
  570                     my @results = $dbh->selectrow_array( $query, {}, $tag->{fieldtag} );
  571                     push @marcfieldsheaders, $results[0];
  572                 }
  573             }
  574         }
  575 
  576         # TT tags exist
  577         if ( $content =~ m|\[\%.*\%\]| ) {
  578             my $tt = Template->new();
  579             my $template = $content;
  580             my $vars;
  581             # Replace 00X and 0XX with X or XX
  582             $content =~ s|fields.00(\d)|fields.$1|g;
  583             $content =~ s|fields.0(\d{2})|fields.$1|g;
  584             my $tt_output;
  585             $tt->process( \$content, $field_list, \$tt_output );
  586             push @csv_rows, $tt_output;
  587         } else {
  588             for my $tag ( @$tags ) {
  589                 my @fields = $record->field( $tag->{fieldtag} );
  590                 # If it is a subfield
  591                 my @loop_values;
  592                 if (defined $tag->{subfieldtag} ) {
  593                     my $av = Koha::AuthorisedValues->search_by_marc_field({ frameworkcode => $frameworkcode, tagfield => $tag->{fieldtag}, tagsubfield => $tag->{subfieldtag}, });
  594                     $av = $av->count ? $av->unblessed : [];
  595                     my $av_description_mapping = { map { ( $_->{authorised_value} => $_->{lib} ) } @$av };
  596                     # For each field
  597                     foreach my $field (@fields) {
  598                         my @subfields = $field->subfield( $tag->{subfieldtag} );
  599                         foreach my $subfield (@subfields) {
  600                             push @loop_values, (defined $av_description_mapping->{$subfield}) ? $av_description_mapping->{$subfield} : $subfield;
  601                         }
  602                     }
  603 
  604                 # Or a field
  605                 } else {
  606                     my $av = Koha::AuthorisedValues->search_by_marc_field({ frameworkcode => $frameworkcode, tagfield => $tag->{fieldtag}, });
  607                     $av = $av->count ? $av->unblessed : [];
  608                     my $authvalues = { map { ( $_->{authorised_value} => $_->{lib} ) } @$av };
  609 
  610                     foreach my $field ( @fields ) {
  611                         my $value;
  612 
  613                         # If it is a control field
  614                         if ($field->is_control_field) {
  615                             $value = defined $authvalues->{$field->as_string} ? $authvalues->{$field->as_string} : $field->as_string;
  616                         } else {
  617                             # If it is a field, we gather all subfields, joined by the subfield separator
  618                             my @subvaluesarray;
  619                             my @subfields = $field->subfields;
  620                             foreach my $subfield (@subfields) {
  621                                 push (@subvaluesarray, defined $authvalues->{$subfield->[1]} ? $authvalues->{$subfield->[1]} : $subfield->[1]);
  622                             }
  623                             $value = join ($subfieldseparator, @subvaluesarray);
  624                         }
  625 
  626                         # Field processing
  627                         my $marcfield = $tag->{fieldtag}; # This line fixes a retrocompatibility concern
  628                                                           # The "processing" could be based on the $marcfield variable.
  629                         eval $fieldprocessing if ($fieldprocessing);
  630 
  631                         push @loop_values, $value;
  632                     }
  633 
  634                 }
  635                 push @field_values, {
  636                     fieldtag => $tag->{fieldtag},
  637                     subfieldtag => $tag->{subfieldtag},
  638                     values => \@loop_values,
  639                 };
  640             }
  641             for my $field_value ( @field_values ) {
  642                 if ( $field_value->{subfieldtag} ) {
  643                     push @csv_rows, join( $subfieldseparator, @{ $field_value->{values} } );
  644                 } else {
  645                     push @csv_rows, join( $fieldseparator, @{ $field_value->{values} } );
  646                 }
  647             }
  648         }
  649     }
  650 
  651 
  652     if ( $header ) {
  653         $csv->combine(@marcfieldsheaders);
  654         $output = $csv->string() . "\n";
  655     }
  656     $csv->combine(@csv_rows);
  657     $output .= $csv->string() . "\n";
  658 
  659     return $output;
  660 
  661 }
  662 
  663 
  664 =head2 changeEncoding - Change the encoding of a record
  665 
  666   my ($error, $newrecord) = changeEncoding($record,$format,$flavour,$to_encoding,$from_encoding);
  667 
  668 Changes the encoding of a record
  669 
  670 C<$record> - the record itself can be in ISO-2709, a MARC::Record object, or MARCXML for now (required)
  671 
  672 C<$format> - MARC or MARCXML (required)
  673 
  674 C<$flavour> - MARC21 or UNIMARC, if MARC21, it will change the leader (optional) [defaults to Koha system preference]
  675 
  676 C<$to_encoding> - the encoding you want the record to end up in (optional) [UTF-8]
  677 
  678 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)
  679 
  680 FIXME: the from_encoding doesn't work yet
  681 
  682 FIXME: better handling for UNIMARC, it should allow management of 100 field
  683 
  684 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
  685 
  686 =cut
  687 
  688 sub changeEncoding {
  689     my ($record,$format,$flavour,$to_encoding,$from_encoding) = @_;
  690     my $newrecord;
  691     my $error;
  692     unless($flavour) {$flavour = C4::Context->preference("marcflavour")};
  693     unless($to_encoding) {$to_encoding = "UTF-8"};
  694 
  695     # ISO-2709 Record (MARC21 or UNIMARC)
  696     if (lc($format) =~ /^marc$/o) {
  697         # if we're converting encoding of an ISO2709 file, we need to roundtrip through XML
  698         #   because MARC::Record doesn't directly provide us with an encoding method
  699         #   It's definitely less than idea and should be fixed eventually - kados
  700         my $marcxml; # temporary storage of MARCXML scalar
  701         ($error,$marcxml) = marc2marcxml($record,$to_encoding,$flavour);
  702         unless ($error) {
  703             ($error,$newrecord) = marcxml2marc($marcxml,$to_encoding,$flavour);
  704         }
  705 
  706     # MARCXML Record
  707     } elsif (lc($format) =~ /^marcxml$/o) { # MARCXML Record
  708         my $marc;
  709         ($error,$marc) = marcxml2marc($record,$to_encoding,$flavour);
  710         unless ($error) {
  711             ($error,$newrecord) = marc2marcxml($record,$to_encoding,$flavour);
  712         }
  713     } else {
  714         $error.="Unsupported record format:".$format;
  715     }
  716     return ($error,$newrecord);
  717 }
  718 
  719 =head2 marc2bibtex - Convert from MARC21 and UNIMARC to BibTex
  720 
  721   my ($bibtex) = marc2bibtex($record, $id);
  722 
  723 Returns a BibTex scalar
  724 
  725 C<$record> - a MARC::Record object
  726 
  727 C<$id> - an id for the BibTex record (might be the biblionumber)
  728 
  729 =cut
  730 
  731 
  732 sub marc2bibtex {
  733     my ($record, $id) = @_;
  734     my $tex;
  735     my $marcflavour = C4::Context->preference("marcflavour");
  736 
  737     # Authors
  738     my $author;
  739     my @texauthors;
  740     my @authorFields = ('100','110','111','700','710','711');
  741     @authorFields = ('700','701','702','710','711','721') if ( $marcflavour eq "UNIMARC" );
  742 
  743     foreach my $field ( @authorFields ) {
  744         # author formatted surname, firstname
  745         my $texauthor = '';
  746         if ( $marcflavour eq "UNIMARC" ) {
  747            $texauthor = join ', ',
  748            ( $record->subfield($field,"a"), $record->subfield($field,"b") );
  749        } else {
  750            $texauthor = $record->subfield($field,"a");
  751        }
  752        push @texauthors, $texauthor if $texauthor;
  753     }
  754     $author = join ' and ', @texauthors;
  755 
  756     # Defining the conversion array according to the marcflavour
  757     my @bh;
  758     if ( $marcflavour eq "UNIMARC" ) {
  759 
  760         # FIXME, TODO : handle repeatable fields
  761         # TODO : handle more types of documents
  762 
  763         # Unimarc to bibtex array
  764         @bh = (
  765 
  766             # Mandatory
  767             author    => $author,
  768             title     => $record->subfield("200", "a") || "",
  769             editor    => $record->subfield("210", "g") || "",
  770             publisher => $record->subfield("210", "c") || "",
  771             year      => $record->subfield("210", "d") || $record->subfield("210", "h") || "",
  772 
  773             # Optional
  774             volume  =>  $record->subfield("200", "v") || "",
  775             series  =>  $record->subfield("225", "a") || "",
  776             address =>  $record->subfield("210", "a") || "",
  777             edition =>  $record->subfield("205", "a") || "",
  778             note    =>  $record->subfield("300", "a") || "",
  779             url     =>  $record->subfield("856", "u") || ""
  780         );
  781     } else {
  782 
  783         # Marc21 to bibtex array
  784         @bh = (
  785 
  786             # Mandatory
  787             author    => $author,
  788             title     => $record->subfield("245", "a") || "",
  789             editor    => $record->subfield("260", "f") || "",
  790             publisher => $record->subfield("264", "b") || $record->subfield("260", "b") || "",
  791             year      => $record->subfield("264", "c") || $record->subfield("260", "c") || $record->subfield("260", "g") || "",
  792 
  793             # Optional
  794             # unimarc to marc21 specification says not to convert 200$v to marc21
  795             series  =>  $record->subfield("490", "a") || "",
  796             address =>  $record->subfield("264", "a") || $record->subfield("260", "a") || "",
  797             edition =>  $record->subfield("250", "a") || "",
  798             note    =>  $record->subfield("500", "a") || "",
  799             url     =>  $record->subfield("856", "u") || ""
  800         );
  801     }
  802 
  803     my $BibtexExportAdditionalFields = C4::Context->preference('BibtexExportAdditionalFields');
  804     my $additional_fields;
  805     if ($BibtexExportAdditionalFields) {
  806         $BibtexExportAdditionalFields = "$BibtexExportAdditionalFields\n\n";
  807         $additional_fields = eval { YAML::Load($BibtexExportAdditionalFields); };
  808         if ($@) {
  809             warn "Unable to parse BibtexExportAdditionalFields : $@";
  810             $additional_fields = undef;
  811         }
  812     }
  813 
  814     if ( $additional_fields && $additional_fields->{'@'} ) {
  815         my ( $f, $sf ) = split( /\$/, $additional_fields->{'@'} );
  816         my ( $type ) = read_field( { record => $record, field => $f, subfield => $sf, field_numbers => [1] } );
  817 
  818         if ($type) {
  819             $tex .= '@' . $type . '{';
  820         }
  821         else {
  822             $tex .= "\@book{";
  823         }
  824     }
  825     else {
  826         $tex .= "\@book{";
  827     }
  828 
  829     my @elt;
  830     for ( my $i = 0 ; $i < scalar( @bh ) ; $i = $i + 2 ) {
  831         next unless $bh[$i+1];
  832         push @elt, qq|\t$bh[$i] = {$bh[$i+1]}|;
  833     }
  834     $tex .= join(",\n", $id, @elt);
  835 
  836     if ($additional_fields) {
  837         $tex .= ",\n";
  838         foreach my $bibtex_tag ( keys %$additional_fields ) {
  839             next if $bibtex_tag eq '@';
  840 
  841             my @fields =
  842               ref( $additional_fields->{$bibtex_tag} ) eq 'ARRAY'
  843               ? @{ $additional_fields->{$bibtex_tag} }
  844               : $additional_fields->{$bibtex_tag};
  845 
  846             for my $tag (@fields) {
  847                 my ( $f, $sf ) = split( /\$/, $tag );
  848                 my @values = read_field( { record => $record, field => $f, subfield => $sf } );
  849                 foreach my $v (@values) {
  850                     $tex .= qq(\t$bibtex_tag = {$v}\n);
  851                 }
  852             }
  853         }
  854     }
  855     else {
  856         $tex .= "\n";
  857     }
  858 
  859     $tex .= "}\n";
  860 
  861     return $tex;
  862 }
  863 
  864 
  865 =head1 INTERNAL FUNCTIONS
  866 
  867 =head2 _entity_encode - Entity-encode an array of strings
  868 
  869   my ($entity_encoded_string) = _entity_encode($string);
  870 
  871 or
  872 
  873   my (@entity_encoded_strings) = _entity_encode(@strings);
  874 
  875 Entity-encode an array of strings
  876 
  877 =cut
  878 
  879 sub _entity_encode {
  880     my @strings = @_;
  881     my @strings_entity_encoded;
  882     foreach my $string (@strings) {
  883         my $nfc_string = NFC($string);
  884         $nfc_string =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
  885         push @strings_entity_encoded, $nfc_string;
  886     }
  887     return @strings_entity_encoded;
  888 }
  889 
  890 END { }       # module clean-up code here (global destructor)
  891 1;
  892 __END__
  893 
  894 =head1 AUTHOR
  895 
  896 Joshua Ferraro <jmf@liblime.com>
  897 
  898 =head1 MODIFICATIONS
  899 
  900 
  901 =cut