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 Koha::CsvProfiles;
  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                     # For each field
 590                     foreach my $field (@fields) {
 591                         my @subfields = $field->subfield( $tag->{subfieldtag} );
 592                         foreach my $subfield (@subfields) {
 593                             my $authvalues = GetKohaAuthorisedValuesFromField( $tag->{fieldtag}, $tag->{subfieldtag}, $frameworkcode, undef);
 594                             push @loop_values, (defined $authvalues->{$subfield}) ? $authvalues->{$subfield} : $subfield;
 595                         }
 596                     }
 597
 598                 # Or a field
 599                 } else {
 600                     my $authvalues = GetKohaAuthorisedValuesFromField( $tag->{fieldtag}, undef, $frameworkcode, undef);
 601
 602                     foreach my $field ( @fields ) {
 603                         my $value;
 604
 605                         # If it is a control field
 606                         if ($field->is_control_field) {
 607                             $value = defined $authvalues->{$field->as_string} ? $authvalues->{$field->as_string} : $field->as_string;
 608                         } else {
 609                             # If it is a field, we gather all subfields, joined by the subfield separator
 610                             my @subvaluesarray;
 611                             my @subfields = $field->subfields;
 612                             foreach my $subfield (@subfields) {
 613                                 push (@subvaluesarray, defined $authvalues->{$subfield->[1]} ? $authvalues->{$subfield->[1]} : $subfield->[1]);
 614                             }
 615                             $value = join ($subfieldseparator, @subvaluesarray);
 616                         }
 617
 618                         # Field processing
 619                         my $marcfield = $tag->{fieldtag}; # This line fixes a retrocompatibility concern
 620                                                           # The "processing" could be based on the $marcfield variable.
 621                         eval $fieldprocessing if ($fieldprocessing);
 622
 623                         push @loop_values, $value;
 624                     }
 625
 626                 }
 627                 push @field_values, {
 628                     fieldtag => $tag->{fieldtag},
 629                     subfieldtag => $tag->{subfieldtag},
 630                     values => \@loop_values,
 631                 };
 632             }
 633             for my $field_value ( @field_values ) {
 634                 if ( $field_value->{subfieldtag} ) {
 635                     push @csv_rows, join( $subfieldseparator, @{ $field_value->{values} } );
 636                 } else {
 637                     push @csv_rows, join( $fieldseparator, @{ $field_value->{values} } );
 638                 }
 639             }
 640         }
 641     }
 642
 643
 644     if ( $header ) {
 645         $csv->combine(@marcfieldsheaders);
 646         $output = $csv->string() . "\n";
 647     }
 648     $csv->combine(@csv_rows);
 649     $output .= $csv->string() . "\n";
 650
 651     return $output;
 652
 653 }
 654
 655
 656 =head2 changeEncoding - Change the encoding of a record
 657
 658   my ($error, $newrecord) = changeEncoding($record,$format,$flavour,$to_encoding,$from_encoding);
 659
 660 Changes the encoding of a record
 661
 662 C<$record> - the record itself can be in ISO-2709, a MARC::Record object, or MARCXML for now (required)
 663
 664 C<$format> - MARC or MARCXML (required)
 665
 666 C<$flavour> - MARC21 or UNIMARC, if MARC21, it will change the leader (optional) [defaults to Koha system preference]
 667
 668 C<$to_encoding> - the encoding you want the record to end up in (optional) [UTF-8]
 669
 670 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)
 671
 672 FIXME: the from_encoding doesn't work yet
 673
 674 FIXME: better handling for UNIMARC, it should allow management of 100 field
 675
 676 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
 677
 678 =cut
 679
 680 sub changeEncoding {
 681         my ($record,$format,$flavour,$to_encoding,$from_encoding) = @_;
 682         my $newrecord;
 683         my $error;
 684         unless($flavour) {$flavour = C4::Context->preference("marcflavour")};
 685         unless($to_encoding) {$to_encoding = "UTF-8"};
 686
 687         # ISO-2709 Record (MARC21 or UNIMARC)
 688         if (lc($format) =~ /^marc$/o) {
 689                 # if we're converting encoding of an ISO2709 file, we need to roundtrip through XML
 690                 #       because MARC::Record doesn't directly provide us with an encoding method
 691                 #       It's definitely less than idea and should be fixed eventually - kados
 692                 my $marcxml; # temporary storage of MARCXML scalar
 693                 ($error,$marcxml) = marc2marcxml($record,$to_encoding,$flavour);
 694                 unless ($error) {
 695                         ($error,$newrecord) = marcxml2marc($marcxml,$to_encoding,$flavour);
 696                 }
 697
 698         # MARCXML Record
 699         } elsif (lc($format) =~ /^marcxml$/o) { # MARCXML Record
 700                 my $marc;
 701                 ($error,$marc) = marcxml2marc($record,$to_encoding,$flavour);
 702                 unless ($error) {
 703                         ($error,$newrecord) = marc2marcxml($record,$to_encoding,$flavour);
 704                 }
 705         } else {
 706                 $error.="Unsupported record format:".$format;
 707         }
 708         return ($error,$newrecord);
 709 }
 710
 711 =head2 marc2bibtex - Convert from MARC21 and UNIMARC to BibTex
 712
 713   my ($bibtex) = marc2bibtex($record, $id);
 714
 715 Returns a BibTex scalar
 716
 717 C<$record> - a MARC::Record object
 718
 719 C<$id> - an id for the BibTex record (might be the biblionumber)
 720
 721 =cut
 722
 723
 724 sub marc2bibtex {
 725     my ($record, $id) = @_;
 726     my $tex;
 727     my $marcflavour = C4::Context->preference("marcflavour");
 728
 729     # Authors
 730     my $author;
 731     my @texauthors;
 732     my @authorFields = ('100','110','111','700','710','711');
 733     @authorFields = ('700','701','702','710','711','721') if ( $marcflavour eq "UNIMARC" );
 734
 735     foreach my $field ( @authorFields ) {
 736         # author formatted surname, firstname
 737         my $texauthor = '';
 738         if ( $marcflavour eq "UNIMARC" ) {
 739            $texauthor = join ', ',
 740            ( $record->subfield($field,"a"), $record->subfield($field,"b") );
 741        } else {
 742            $texauthor = $record->subfield($field,"a");
 743        }
 744        push @texauthors, $texauthor if $texauthor;
 745     }
 746     $author = join ' and ', @texauthors;
 747
 748     # Defining the conversion array according to the marcflavour
 749     my @bh;
 750     if ( $marcflavour eq "UNIMARC" ) {
 751
 752         # FIXME, TODO : handle repeatable fields
 753         # TODO : handle more types of documents
 754
 755         # Unimarc to bibtex array
 756         @bh = (
 757
 758             # Mandatory
 759             author    => $author,
 760             title     => $record->subfield("200", "a") || "",
 761             editor    => $record->subfield("210", "g") || "",
 762             publisher => $record->subfield("210", "c") || "",
 763             year      => $record->subfield("210", "d") || $record->subfield("210", "h") || "",
 764
 765             # Optional
 766             volume  =>  $record->subfield("200", "v") || "",
 767             series  =>  $record->subfield("225", "a") || "",
 768             address =>  $record->subfield("210", "a") || "",
 769             edition =>  $record->subfield("205", "a") || "",
 770             note    =>  $record->subfield("300", "a") || "",
 771             url     =>  $record->subfield("856", "u") || ""
 772         );
 773     } else {
 774
 775         # Marc21 to bibtex array
 776         @bh = (
 777
 778             # Mandatory
 779             author    => $author,
 780             title     => $record->subfield("245", "a") || "",
 781             editor    => $record->subfield("260", "f") || "",
 782             publisher => $record->subfield("264", "b") || $record->subfield("260", "b") || "",
 783             year      => $record->subfield("264", "c") || $record->subfield("260", "c") || $record->subfield("260", "g") || "",
 784
 785             # Optional
 786             # unimarc to marc21 specification says not to convert 200$v to marc21
 787             series  =>  $record->subfield("490", "a") || "",
 788             address =>  $record->subfield("264", "a") || $record->subfield("260", "a") || "",
 789             edition =>  $record->subfield("250", "a") || "",
 790             note    =>  $record->subfield("500", "a") || "",
 791             url     =>  $record->subfield("856", "u") || ""
 792         );
 793     }
 794
 795     my $BibtexExportAdditionalFields = C4::Context->preference('BibtexExportAdditionalFields');
 796     my $additional_fields;
 797     if ($BibtexExportAdditionalFields) {
 798         $BibtexExportAdditionalFields = "$BibtexExportAdditionalFields\n\n";
 799         $additional_fields = eval { YAML::Load($BibtexExportAdditionalFields); };
 800         if ($@) {
 801             warn "Unable to parse BibtexExportAdditionalFields : $@";
 802             $additional_fields = undef;
 803         }
 804     }
 805
 806     if ( $additional_fields && $additional_fields->{'@'} ) {
 807         my ( $f, $sf ) = split( /\$/, $additional_fields->{'@'} );
 808         my ( $type ) = read_field( { record => $record, field => $f, subfield => $sf, field_numbers => [1] } );
 809
 810         if ($type) {
 811             $tex .= '@' . $type . '{';
 812         }
 813         else {
 814             $tex .= "\@book{";
 815         }
 816     }
 817     else {
 818         $tex .= "\@book{";
 819     }
 820
 821     my @elt;
 822     for ( my $i = 0 ; $i < scalar( @bh ) ; $i = $i + 2 ) {
 823         next unless $bh[$i+1];
 824         push @elt, qq|\t$bh[$i] = {$bh[$i+1]}|;
 825     }
 826     $tex .= join(",\n", $id, @elt);
 827
 828     if ($additional_fields) {
 829         $tex .= ",\n";
 830         foreach my $bibtex_tag ( keys %$additional_fields ) {
 831             next if $bibtex_tag eq '@';
 832
 833             my @fields =
 834               ref( $additional_fields->{$bibtex_tag} ) eq 'ARRAY'
 835               ? @{ $additional_fields->{$bibtex_tag} }
 836               : $additional_fields->{$bibtex_tag};
 837
 838             for my $tag (@fields) {
 839                 my ( $f, $sf ) = split( /\$/, $tag );
 840                 my @values = read_field( { record => $record, field => $f, subfield => $sf } );
 841                 foreach my $v (@values) {
 842                     $tex .= qq(\t$bibtex_tag = {$v}\n);
 843                 }
 844             }
 845         }
 846     }
 847     else {
 848         $tex .= "\n";
 849     }
 850
 851     $tex .= "}\n";
 852
 853     return $tex;
 854 }
 855
 856
 857 =head1 INTERNAL FUNCTIONS
 858
 859 =head2 _entity_encode - Entity-encode an array of strings
 860
 861   my ($entity_encoded_string) = _entity_encode($string);
 862
 863 or
 864
 865   my (@entity_encoded_strings) = _entity_encode(@strings);
 866
 867 Entity-encode an array of strings
 868
 869 =cut
 870
 871 sub _entity_encode {
 872         my @strings = @_;
 873         my @strings_entity_encoded;
 874         foreach my $string (@strings) {
 875                 my $nfc_string = NFC($string);
 876                 $nfc_string =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
 877                 push @strings_entity_encoded, $nfc_string;
 878         }
 879         return @strings_entity_encoded;
 880 }
 881
 882 END { }       # module clean-up code here (global destructor)
 883 1;
 884 __END__
 885
 886 =head1 AUTHOR
 887
 888 Joshua Ferraro <jmf@liblime.com>
 889
 890 =head1 MODIFICATIONS
 891
 892
 893 =cut