Koha: C4/Record.pm

"Fossies" - the Fresh Open Source Software Archive

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

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

20.05.06_vs_20.11.00.

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