C4/Record.pm

   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::SimpleMARC qw(read_field);
  38 use Koha::XSLT_Handler;
  39 use Koha::CsvProfiles;
  40 use Koha::AuthorisedValues;
  41 use Carp;
  42
  43 use vars qw(@ISA @EXPORT);
  44
  45
  46 @ISA = qw(Exporter);
  47
  48 # only export API methods
  49
  50 @EXPORT = qw(
  51   &marc2endnote
  52   &marc2marc
  53   &marc2marcxml
  54   &marcxml2marc
  55   &marc2dcxml
  56   &marc2modsxml
  57   &marc2madsxml
  58   &marc2bibtex
  59   &marc2csv
  60   &changeEncoding
  61 );
  62
  63 =head1 NAME
  64
  65 C4::Record - MARC, MARCXML, DC, MODS, XML, etc. Record Management Functions and API
  66
  67 =head1 SYNOPSIS
  68
  69 New in Koha 3.x. This module handles all record-related management functions.
  70
  71 =head1 API (EXPORTED FUNCTIONS)
  72
  73 =head2 marc2marc - Convert from one flavour of ISO-2709 to another
  74
  75   my ($error,$newmarc) = marc2marc($marc,$to_flavour,$from_flavour,$encoding);
  76
  77 Returns an ISO-2709 scalar
  78
  79 =cut
  80
  81 sub marc2marc {
  82         my ($marc,$to_flavour,$from_flavour,$encoding) = @_;
  83         my $error;
  84     if ($to_flavour =~ m/marcstd/) {
  85         my $marc_record_obj;
  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
  90
  91 # conversion to MARC::Record object failed, populate $error
  92                 if ($@) { $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR };
  93         }
  94         unless ($error) {
  95             my @privatefields;
  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'));
 101                 }
 102             }
 103             $marc_record_obj->delete_field($_) for @privatefields;
 104             $marc = $marc_record_obj->as_usmarc();
 105         }
 106     } else {
 107         $error = "Feature not yet implemented\n";
 108     }
 109         return ($error,$marc);
 110 }
 111
 112 =head2 marc2marcxml - Convert from ISO-2709 to MARCXML
 113
 114   my ($error,$marcxml) = marc2marcxml($marc,$encoding,$flavour);
 115
 116 Returns a MARCXML scalar
 117
 118 C<$marc> - an ISO-2709 scalar or MARC::Record object
 119
 120 C<$encoding> - UTF-8 or MARC-8 [UTF-8]
 121
 122 C<$flavour> - MARC21 or UNIMARC
 123
 124 C<$dont_entity_encode> - a flag that instructs marc2marcxml not to entity encode the xml before returning (optional)
 125
 126 =cut
 127
 128 sub marc2marcxml {
 129         my ($marc,$encoding,$flavour,$dont_entity_encode) = @_;
 130         my $error; # the error string
 131         my $marcxml; # the final MARCXML scalar
 132
 133         # test if it's already a MARC::Record object, if not, make it one
 134         my $marc_record_obj;
 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
 139
 140                 # conversion to MARC::Record object failed, populate $error
 141                 if ($@) { $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR };
 142         }
 143         # only proceed if no errors so far
 144         unless ($error) {
 145
 146                 # check the record for warnings
 147                 my @warnings = $marc_record_obj->warnings();
 148                 if (@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 };
 151                 }
 152                 unless($encoding) {$encoding = "UTF-8"}; # set default encoding
 153                 unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; # set default MARC flavour
 154
 155                 # attempt to convert the record to MARCXML
 156                 eval { $marcxml = $marc_record_obj->as_xml_record($flavour) }; #handle exceptions
 157
 158                 # record creation failed, populate $error
 159                 if ($@) {
 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" };
 164
 165                 # record creation was successful
 166         } else {
 167
 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();
 170                         if (@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 };
 173                         }
 174                 }
 175
 176                 # only proceed if no errors so far
 177                 unless ($error) {
 178
 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;
 183                 }
 184                 }
 185         }
 186         # return result to calling program
 187         return ($error,$marcxml);
 188 }
 189
 190 =head2 marcxml2marc - Convert from MARCXML to ISO-2709
 191
 192   my ($error,$marc) = marcxml2marc($marcxml,$encoding,$flavour);
 193
 194 Returns an ISO-2709 scalar
 195
 196 C<$marcxml> - a MARCXML record
 197
 198 C<$encoding> - UTF-8 or MARC-8 [UTF-8]
 199
 200 C<$flavour> - MARC21 or UNIMARC
 201
 202 =cut
 203
 204 sub marcxml2marc {
 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
 210
 211         # attempt to do the conversion
 212         eval { $marc = MARC::Record->new_from_xml($marcxml,$encoding,$flavour) }; # handle exceptions
 213
 214         # record creation failed, populate $error
 215         if ($@) {$error .="\nCreation of MARCXML Record failed: ".$@;
 216                 $error.=$MARC::File::ERROR if ($MARC::File::ERROR);
 217                 };
 218         # return result to calling program
 219         return ($error,$marc);
 220 }
 221
 222 =head2 marc2dcxml - Convert from ISO-2709 to Dublin Core
 223
 224     my dcxml = marc2dcxml ($marc, $xml, $biblionumber, $format);
 225
 226 EXAMPLE
 227
 228     my dcxml = marc2dcxml (undef, undef, 1, "oaidc");
 229
 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>
 235
 236 C<$marc> - an ISO-2709 scalar or MARC::Record object
 237
 238 C<$xml> - a MARCXML file
 239
 240 C<$biblionumber> - obtain the record directly from database (biblioitems.marcxml)
 241
 242 C<$format> - accept three type of DC formats (oaidc, srwdc, and rdfdc )
 243
 244 =cut
 245
 246 sub marc2dcxml {
 247     my ( $marc, $xml, $biblionumber, $format ) = @_;
 248
 249     # global variables
 250     my ( $marcxml, $record, $output );
 251
 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';
 256
 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 );
 263     } else {
 264         $marcxml = $xml;
 265     }
 266
 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(
 271                          $marcxml,
 272                          'UTF-8',
 273                          C4::Context->preference('marcflavour')
 274                );
 275         };
 276     } else {
 277         eval { $record = MARC::Record->new_from_xml(
 278                          $marcxml,
 279                         'UTF-8',
 280                         'MARC21'
 281                );
 282         };
 283     }
 284
 285     # conversion to MARC::Record object failed
 286     if ( $@ ) {
 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) {
 292             carp "\t". $warn;
 293         };
 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 );
 298         } else {
 299             croak "The format argument ($format) not accepted.\n" .
 300                   "Please pass a valid format (oaidc, srwdc, or rdfdc)\n";
 301         }
 302         my $err = $xslt_engine->err; # error number
 303         my $errstr = $xslt_engine->errstr; # error message
 304         if ( $err ) {
 305             croak "Error when processing $errstr Error number: $err\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 $biblionumber = GetBiblionumberFromItemnumber $itemnumber;
 431             $output .= marcrecord2csv( $biblionumber, $id, $firstpass, $csv, $fieldprocessing, [$itemnumber] );
 432             $firstpass = 0;
 433         }
 434     } else {
 435         foreach my $biblio (@$biblios) {
 436             $output .= marcrecord2csv( $biblio, $id, $firstpass, $csv, $fieldprocessing );
 437             $firstpass = 0;
 438         }
 439     }
 440
 441     # Postprocessing
 442     eval $postprocess if ($postprocess);
 443
 444     return $output;
 445 }
 446
 447 =head2 marcrecord2csv - Convert a single record from UNIMARC to CSV
 448
 449   my ($csv) = marcrecord2csv($biblio, $csvprofileid, $header);
 450
 451 Returns a CSV scalar
 452
 453 C<$biblio> - a biblionumber
 454
 455 C<$csvprofileid> - the id of the CSV profile to use for the export (see export_format.export_format_id)
 456
 457 C<$header> - true if the headers are to be printed (typically at first pass)
 458
 459 C<$csv> - an already initialised Text::CSV object
 460
 461 C<$fieldprocessing>
 462
 463 C<$itemnumbers> a list of itemnumbers to export
 464
 465 =cut
 466
 467 sub marcrecord2csv {
 468     my ($biblio, $id, $header, $csv, $fieldprocessing, $itemnumbers) = @_;
 469     my $output;
 470
 471     # Getting the record
 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);
 477
 478     # Getting information about the csv profile
 479     my $profile = Koha::CsvProfiles->find($id);
 480
 481     # Getting output encoding
 482     my $encoding          = $profile->encoding || 'utf8';
 483     # Getting separators
 484     my $csvseparator      = $profile->csv_separator      || ',';
 485     my $fieldseparator    = $profile->field_separator    || '#';
 486     my $subfieldseparator = $profile->subfield_separator || '|';
 487
 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" }
 495
 496     $csv = $csv->encoding_out($encoding) ;
 497     $csv->sep_char($csvseparator);
 498
 499     # Getting the marcfields
 500     my $marcfieldslist = $profile->content;
 501
 502     # Getting the marcfields as an array
 503     my @marcfieldsarray = split('\|', $marcfieldslist);
 504
 505    # Separating the marcfields from the user-supplied headers
 506     my @csv_structures;
 507     foreach (@marcfieldsarray) {
 508         my @result = split('=', $_, 2);
 509         my $content = ( @result == 2 )
 510             ? $result[1]
 511             : $result[0];
 512         my @fields;
 513         while ( $content =~ m|(\d{3})\$?(.)?|g ) {
 514             my $fieldtag = $1;
 515             my $subfieldtag = $2 || undef;
 516             push @fields, { fieldtag => $fieldtag, subfieldtag => $subfieldtag };
 517         }
 518         if ( @result == 2) {
 519            push @csv_structures, { header => $result[0], content => $content, fields => \@fields };
 520         } else {
 521            push @csv_structures, { content => $content, fields => \@fields }
 522         }
 523     }
 524
 525     my ( @marcfieldsheaders, @csv_rows );
 526     my $dbh = C4::Context->dbh;
 527
 528     my $field_list;
 529     for my $field ( $record->fields ) {
 530         my $fieldtag = $field->tag;
 531         my $values;
 532         if ( $field->is_control_field ) {
 533             $values = $field->data();
 534         } else {
 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;
 541             }
 542         }
 543         # We force the key as an integer (trick for 00X and OXX fields)
 544         push @{ $field_list->{fields}{0+$fieldtag} }, $values;
 545     }
 546
 547     # For each field or subfield
 548     foreach my $csv_structure (@csv_structures) {
 549         my @field_values;
 550         my $tags = $csv_structure->{fields};
 551         my $content = $csv_structure->{content};
 552
 553         if ( $header ) {
 554             # If we have a user-supplied header, we use it
 555             if ( exists $csv_structure->{header} ) {
 556                 push @marcfieldsheaders, $csv_structure->{header};
 557             } else {
 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];
 564                 } else {
 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];
 568                 }
 569             }
 570         }
 571
 572         # TT tags exist
 573         if ( $content =~ m|\[\%.*\%\]| ) {
 574             my $tt = Template->new();
 575             my $template = $content;
 576             my $vars;
 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;
 580             my $tt_output;
 581             $tt->process( \$content, $field_list, \$tt_output );
 582             push @csv_rows, $tt_output;
 583         } else {
 584             for my $tag ( @$tags ) {
 585                 my @fields = $record->field( $tag->{fieldtag} );
 586                 # If it is a subfield
 587                 my @loop_values;
 588                 if ( $tag->{subfieldtag} ) {
 589                     my $av = Koha::AuthorisedValues->search_by_marc_field({ frameworkcode => $frameworkcode, tagfield => $tag->{fieldtag}, tagsubfield => $tag->{subfieldtag}, });
 590                     $av = $av->count ? $av->unblessed : [];
 591                     my $av_description_mapping = { map { ( $_->{authorised_value} => $_->{lib} ) } @$av };
 592                     # For each field
 593                     foreach my $field (@fields) {
 594                         my @subfields = $field->subfield( $tag->{subfieldtag} );
 595                         foreach my $subfield (@subfields) {
 596                             push @loop_values, (defined $av_description_mapping->{$subfield}) ? $av_description_mapping->{$subfield} : $subfield;
 597                         }
 598                     }
 599
 600                 # Or a field
 601                 } else {
 602                     my $av = Koha::AuthorisedValues->search_by_marc_field({ frameworkcode => $frameworkcode, tagfield => $tag->{fieldtag}, });
 603                     $av = $av->count ? $av->unblessed : [];
 604                     my $authvalues = { map { ( $_->{authorised_value} => $_->{lib} ) } @$av };
 605
 606                     foreach my $field ( @fields ) {
 607                         my $value;
 608
 609                         # If it is a control field
 610                         if ($field->is_control_field) {
 611                             $value = defined $authvalues->{$field->as_string} ? $authvalues->{$field->as_string} : $field->as_string;
 612                         } else {
 613                             # If it is a field, we gather all subfields, joined by the subfield separator
 614                             my @subvaluesarray;
 615                             my @subfields = $field->subfields;
 616                             foreach my $subfield (@subfields) {
 617                                 push (@subvaluesarray, defined $authvalues->{$subfield->[1]} ? $authvalues->{$subfield->[1]} : $subfield->[1]);
 618                             }
 619                             $value = join ($subfieldseparator, @subvaluesarray);
 620                         }
 621
 622                         # Field processing
 623                         my $marcfield = $tag->{fieldtag}; # This line fixes a retrocompatibility concern
 624                                                           # The "processing" could be based on the $marcfield variable.
 625                         eval $fieldprocessing if ($fieldprocessing);
 626
 627                         push @loop_values, $value;
 628                     }
 629
 630                 }
 631                 push @field_values, {
 632                     fieldtag => $tag->{fieldtag},
 633                     subfieldtag => $tag->{subfieldtag},
 634                     values => \@loop_values,
 635                 };
 636             }
 637             for my $field_value ( @field_values ) {
 638                 if ( $field_value->{subfieldtag} ) {
 639                     push @csv_rows, join( $subfieldseparator, @{ $field_value->{values} } );
 640                 } else {
 641                     push @csv_rows, join( $fieldseparator, @{ $field_value->{values} } );
 642                 }
 643             }
 644         }
 645     }
 646
 647
 648     if ( $header ) {
 649         $csv->combine(@marcfieldsheaders);
 650         $output = $csv->string() . "\n";
 651     }
 652     $csv->combine(@csv_rows);
 653     $output .= $csv->string() . "\n";
 654
 655     return $output;
 656
 657 }
 658
 659
 660 =head2 changeEncoding - Change the encoding of a record
 661
 662   my ($error, $newrecord) = changeEncoding($record,$format,$flavour,$to_encoding,$from_encoding);
 663
 664 Changes the encoding of a record
 665
 666 C<$record> - the record itself can be in ISO-2709, a MARC::Record object, or MARCXML for now (required)
 667
 668 C<$format> - MARC or MARCXML (required)
 669
 670 C<$flavour> - MARC21 or UNIMARC, if MARC21, it will change the leader (optional) [defaults to Koha system preference]
 671
 672 C<$to_encoding> - the encoding you want the record to end up in (optional) [UTF-8]
 673
 674 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)
 675
 676 FIXME: the from_encoding doesn't work yet
 677
 678 FIXME: better handling for UNIMARC, it should allow management of 100 field
 679
 680 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
 682 =cut
 683
 684 sub changeEncoding {
 685         my ($record,$format,$flavour,$to_encoding,$from_encoding) = @_;
 686         my $newrecord;
 687         my $error;
 688         unless($flavour) {$flavour = C4::Context->preference("marcflavour")};
 689         unless($to_encoding) {$to_encoding = "UTF-8"};
 690
 691         # ISO-2709 Record (MARC21 or UNIMARC)
 692         if (lc($format) =~ /^marc$/o) {
 693                 # if we're converting encoding of an ISO2709 file, we need to roundtrip through XML
 694                 #       because MARC::Record doesn't directly provide us with an encoding method
 695                 #       It's definitely less than idea and should be fixed eventually - kados
 696                 my $marcxml; # temporary storage of MARCXML scalar
 697                 ($error,$marcxml) = marc2marcxml($record,$to_encoding,$flavour);
 698                 unless ($error) {
 699                         ($error,$newrecord) = marcxml2marc($marcxml,$to_encoding,$flavour);
 700                 }
 701
 702         # MARCXML Record
 703         } elsif (lc($format) =~ /^marcxml$/o) { # MARCXML Record
 704                 my $marc;
 705                 ($error,$marc) = marcxml2marc($record,$to_encoding,$flavour);
 706                 unless ($error) {
 707                         ($error,$newrecord) = marc2marcxml($record,$to_encoding,$flavour);
 708                 }
 709         } else {
 710                 $error.="Unsupported record format:".$format;
 711         }
 712         return ($error,$newrecord);
 713 }
 714
 715 =head2 marc2bibtex - Convert from MARC21 and UNIMARC to BibTex
 716
 717   my ($bibtex) = marc2bibtex($record, $id);
 718
 719 Returns a BibTex scalar
 720
 721 C<$record> - a MARC::Record object
 722
 723 C<$id> - an id for the BibTex record (might be the biblionumber)
 724
 725 =cut
 726
 727
 728 sub marc2bibtex {
 729     my ($record, $id) = @_;
 730     my $tex;
 731     my $marcflavour = C4::Context->preference("marcflavour");
 732
 733     # Authors
 734     my $author;
 735     my @texauthors;
 736     my @authorFields = ('100','110','111','700','710','711');
 737     @authorFields = ('700','701','702','710','711','721') if ( $marcflavour eq "UNIMARC" );
 738
 739     foreach my $field ( @authorFields ) {
 740         # author formatted surname, firstname
 741         my $texauthor = '';
 742         if ( $marcflavour eq "UNIMARC" ) {
 743            $texauthor = join ', ',
 744            ( $record->subfield($field,"a"), $record->subfield($field,"b") );
 745        } else {
 746            $texauthor = $record->subfield($field,"a");
 747        }
 748        push @texauthors, $texauthor if $texauthor;
 749     }
 750     $author = join ' and ', @texauthors;
 751
 752     # Defining the conversion array according to the marcflavour
 753     my @bh;
 754     if ( $marcflavour eq "UNIMARC" ) {
 755
 756         # FIXME, TODO : handle repeatable fields
 757         # TODO : handle more types of documents
 758
 759         # Unimarc to bibtex array
 760         @bh = (
 761
 762             # Mandatory
 763             author    => $author,
 764             title     => $record->subfield("200", "a") || "",
 765             editor    => $record->subfield("210", "g") || "",
 766             publisher => $record->subfield("210", "c") || "",
 767             year      => $record->subfield("210", "d") || $record->subfield("210", "h") || "",
 768
 769             # Optional
 770             volume  =>  $record->subfield("200", "v") || "",
 771             series  =>  $record->subfield("225", "a") || "",
 772             address =>  $record->subfield("210", "a") || "",
 773             edition =>  $record->subfield("205", "a") || "",
 774             note    =>  $record->subfield("300", "a") || "",
 775             url     =>  $record->subfield("856", "u") || ""
 776         );
 777     } else {
 778
 779         # Marc21 to bibtex array
 780         @bh = (
 781
 782             # Mandatory
 783             author    => $author,
 784             title     => $record->subfield("245", "a") || "",
 785             editor    => $record->subfield("260", "f") || "",
 786             publisher => $record->subfield("264", "b") || $record->subfield("260", "b") || "",
 787             year      => $record->subfield("264", "c") || $record->subfield("260", "c") || $record->subfield("260", "g") || "",
 788
 789             # Optional
 790             # unimarc to marc21 specification says not to convert 200$v to marc21
 791             series  =>  $record->subfield("490", "a") || "",
 792             address =>  $record->subfield("264", "a") || $record->subfield("260", "a") || "",
 793             edition =>  $record->subfield("250", "a") || "",
 794             note    =>  $record->subfield("500", "a") || "",
 795             url     =>  $record->subfield("856", "u") || ""
 796         );
 797     }
 798
 799     my $BibtexExportAdditionalFields = C4::Context->preference('BibtexExportAdditionalFields');
 800     my $additional_fields;
 801     if ($BibtexExportAdditionalFields) {
 802         $BibtexExportAdditionalFields = "$BibtexExportAdditionalFields\n\n";
 803         $additional_fields = eval { YAML::Load($BibtexExportAdditionalFields); };
 804         if ($@) {
 805             warn "Unable to parse BibtexExportAdditionalFields : $@";
 806             $additional_fields = undef;
 807         }
 808     }
 809
 810     if ( $additional_fields && $additional_fields->{'@'} ) {
 811         my ( $f, $sf ) = split( /\$/, $additional_fields->{'@'} );
 812         my ( $type ) = read_field( { record => $record, field => $f, subfield => $sf, field_numbers => [1] } );
 813
 814         if ($type) {
 815             $tex .= '@' . $type . '{';
 816         }
 817         else {
 818             $tex .= "\@book{";
 819         }
 820     }
 821     else {
 822         $tex .= "\@book{";
 823     }
 824
 825     my @elt;
 826     for ( my $i = 0 ; $i < scalar( @bh ) ; $i = $i + 2 ) {
 827         next unless $bh[$i+1];
 828         push @elt, qq|\t$bh[$i] = {$bh[$i+1]}|;
 829     }
 830     $tex .= join(",\n", $id, @elt);
 831
 832     if ($additional_fields) {
 833         $tex .= ",\n";
 834         foreach my $bibtex_tag ( keys %$additional_fields ) {
 835             next if $bibtex_tag eq '@';
 836
 837             my @fields =
 838               ref( $additional_fields->{$bibtex_tag} ) eq 'ARRAY'
 839               ? @{ $additional_fields->{$bibtex_tag} }
 840               : $additional_fields->{$bibtex_tag};
 841
 842             for my $tag (@fields) {
 843                 my ( $f, $sf ) = split( /\$/, $tag );
 844                 my @values = read_field( { record => $record, field => $f, subfield => $sf } );
 845                 foreach my $v (@values) {
 846                     $tex .= qq(\t$bibtex_tag = {$v}\n);
 847                 }
 848             }
 849         }
 850     }
 851     else {
 852         $tex .= "\n";
 853     }
 854
 855     $tex .= "}\n";
 856
 857     return $tex;
 858 }
 859
 860
 861 =head1 INTERNAL FUNCTIONS
 862
 863 =head2 _entity_encode - Entity-encode an array of strings
 864
 865   my ($entity_encoded_string) = _entity_encode($string);
 866
 867 or
 868
 869   my (@entity_encoded_strings) = _entity_encode(@strings);
 870
 871 Entity-encode an array of strings
 872
 873 =cut
 874
 875 sub _entity_encode {
 876         my @strings = @_;
 877         my @strings_entity_encoded;
 878         foreach my $string (@strings) {
 879                 my $nfc_string = NFC($string);
 880                 $nfc_string =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
 881                 push @strings_entity_encoded, $nfc_string;
 882         }
 883         return @strings_entity_encoded;
 884 }
 885
 886 END { }       # module clean-up code here (global destructor)
 887 1;
 888 __END__
 889
 890 =head1 AUTHOR
 891
 892 Joshua Ferraro <jmf@liblime.com>
 893
 894 =head1 MODIFICATIONS
 895
 896
 897 =cut