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