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