C4/Record.pm

   1 package C4::Record;
   2 #
   3 # Copyright 2006 (C) LibLime
   4 # Joshua Ferraro <jmf@liblime.com>
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 2 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along with
  18 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  19 # Suite 330, Boston, MA  02111-1307 USA
  20 #
  21 #
  22 use strict;# use warnings; #FIXME: turn off warnings before release
  23
  24 # please specify in which methods a given module is used
  25 use MARC::Record; # marc2marcxml, marcxml2marc, html2marc, changeEncoding
  26 use MARC::File::XML; # marc2marcxml, marcxml2marc, html2marcxml, changeEncoding
  27 use MARC::Crosswalk::DublinCore; # marc2dcxml
  28 use Biblio::EndnoteStyle;
  29 use Unicode::Normalize; # _entity_encode
  30 use XML::LibXSLT;
  31 use XML::LibXML;
  32 use C4::Biblio; #marc2bibtex
  33
  34 use vars qw($VERSION @ISA @EXPORT);
  35
  36 # set the version for version checking
  37 $VERSION = 3.00;
  38
  39 @ISA = qw(Exporter);
  40
  41 # only export API methods
  42
  43 @EXPORT = qw(
  44   &marc2endnote
  45   &marc2marc
  46   &marc2marcxml
  47   &marcxml2marc
  48   &marc2dcxml
  49   &marc2modsxml
  50   &marc2bibtex
  51
  52   &html2marcxml
  53   &html2marc
  54   &changeEncoding
  55 );
  56
  57 =head1 NAME
  58
  59 C4::Record - MARC, MARCXML, DC, MODS, XML, etc. Record Management Functions and API
  60
  61 =head1 SYNOPSIS
  62
  63 New in Koha 3.x. This module handles all record-related management functions.
  64
  65 =head1 API (EXPORTED FUNCTIONS)
  66
  67 =head2 marc2marc - Convert from one flavour of ISO-2709 to another
  68
  69 =over 4
  70
  71 my ($error,$newmarc) = marc2marc($marc,$to_flavour,$from_flavour,$encoding);
  72
  73 Returns an ISO-2709 scalar
  74
  75 =back
  76
  77 =cut
  78
  79 sub marc2marc {
  80         my ($marc,$to_flavour,$from_flavour,$encoding) = @_;
  81         my $error = "Feature not yet implemented\n";
  82         return ($error,$marc);
  83 }
  84
  85 =head2 marc2marcxml - Convert from ISO-2709 to MARCXML
  86
  87 =over 4
  88
  89 my ($error,$marcxml) = marc2marcxml($marc,$encoding,$flavour);
  90
  91 Returns a MARCXML scalar
  92
  93 =over 2
  94
  95 C<$marc> - an ISO-2709 scalar or MARC::Record object
  96
  97 C<$encoding> - UTF-8 or MARC-8 [UTF-8]
  98
  99 C<$flavour> - MARC21 or UNIMARC
 100
 101 C<$dont_entity_encode> - a flag that instructs marc2marcxml not to entity encode the xml before returning (optional)
 102
 103 =back
 104
 105 =back
 106
 107 =cut
 108
 109 sub marc2marcxml {
 110         my ($marc,$encoding,$flavour,$dont_entity_encode) = @_;
 111         my $error; # the error string
 112         my $marcxml; # the final MARCXML scalar
 113
 114         # test if it's already a MARC::Record object, if not, make it one
 115         my $marc_record_obj;
 116         if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object
 117                 $marc_record_obj = $marc;
 118         } else { # it's not a MARC::Record object, make it one
 119                 eval { $marc_record_obj = MARC::Record->new_from_usmarc($marc) }; # handle exceptions
 120
 121                 # conversion to MARC::Record object failed, populate $error
 122                 if ($@) { $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR };
 123         }
 124         # only proceed if no errors so far
 125         unless ($error) {
 126
 127                 # check the record for warnings
 128                 my @warnings = $marc_record_obj->warnings();
 129                 if (@warnings) {
 130                         warn "\nWarnings encountered while processing ISO-2709 record with title \"".$marc_record_obj->title()."\":\n";
 131                         foreach my $warn (@warnings) { warn "\t".$warn };
 132                 }
 133                 unless($encoding) {$encoding = "UTF-8"}; # set default encoding
 134                 unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; # set default MARC flavour
 135
 136                 # attempt to convert the record to MARCXML
 137                 eval { $marcxml = $marc_record_obj->as_xml_record($flavour) }; #handle exceptions
 138
 139                 # record creation failed, populate $error
 140                 if ($@) {
 141                         $error .= "Creation of MARCXML failed:".$MARC::File::ERROR;
 142                         $error .= "Additional information:\n";
 143                         my @warnings = $@->warnings();
 144                         foreach my $warn (@warnings) { $error.=$warn."\n" };
 145
 146                 # record creation was successful
 147         } else {
 148
 149                         # check the record for warning flags again (warnings() will be cleared already if there was an error, see above block
 150                         @warnings = $marc_record_obj->warnings();
 151                         if (@warnings) {
 152                                 warn "\nWarnings encountered while processing ISO-2709 record with title \"".$marc_record_obj->title()."\":\n";
 153                                 foreach my $warn (@warnings) { warn "\t".$warn };
 154                         }
 155                 }
 156
 157                 # only proceed if no errors so far
 158                 unless ($error) {
 159
 160                         # entity encode the XML unless instructed not to
 161                 unless ($dont_entity_encode) {
 162                         my ($marcxml_entity_encoded) = _entity_encode($marcxml);
 163                         $marcxml = $marcxml_entity_encoded;
 164                 }
 165                 }
 166         }
 167         # return result to calling program
 168         return ($error,$marcxml);
 169 }
 170
 171 =head2 marcxml2marc - Convert from MARCXML to ISO-2709
 172
 173 =over 4
 174
 175 my ($error,$marc) = marcxml2marc($marcxml,$encoding,$flavour);
 176
 177 Returns an ISO-2709 scalar
 178
 179 =over 2
 180
 181 C<$marcxml> - a MARCXML record
 182
 183 C<$encoding> - UTF-8 or MARC-8 [UTF-8]
 184
 185 C<$flavour> - MARC21 or UNIMARC
 186
 187 =back
 188
 189 =back
 190
 191 =cut
 192
 193 sub marcxml2marc {
 194     my ($marcxml,$encoding,$flavour) = @_;
 195         my $error; # the error string
 196         my $marc; # the final ISO-2709 scalar
 197         unless($encoding) {$encoding = "UTF-8"}; # set the default encoding
 198         unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; # set the default MARC flavour
 199
 200         # attempt to do the conversion
 201         eval { $marc = MARC::Record->new_from_xml($marcxml,$encoding,$flavour) }; # handle exceptions
 202
 203         # record creation failed, populate $error
 204         if ($@) {$error .="\nCreation of MARCXML Record failed: ".$@;
 205                 $error.=$MARC::File::ERROR if ($MARC::File::ERROR);
 206                 };
 207         # return result to calling program
 208         return ($error,$marc);
 209 }
 210
 211 =head2 marc2dcxml - Convert from ISO-2709 to Dublin Core
 212
 213 =over 4
 214
 215 my ($error,$dcxml) = marc2dcxml($marc,$qualified);
 216
 217 Returns a DublinCore::Record object, will eventually return a Dublin Core scalar
 218
 219 FIXME: should return actual XML, not just an object
 220
 221 =over 2
 222
 223 C<$marc> - an ISO-2709 scalar or MARC::Record object
 224
 225 C<$qualified> - specify whether qualified Dublin Core should be used in the input or output [0]
 226
 227 =back
 228
 229 =back
 230
 231 =cut
 232
 233 sub marc2dcxml {
 234         my ($marc,$qualified) = @_;
 235         my $error;
 236     # test if it's already a MARC::Record object, if not, make it one
 237     my $marc_record_obj;
 238     if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object
 239         $marc_record_obj = $marc;
 240     } else { # it's not a MARC::Record object, make it one
 241                 eval { $marc_record_obj = MARC::Record->new_from_usmarc($marc) }; # handle exceptions
 242
 243                 # conversion to MARC::Record object failed, populate $error
 244                 if ($@) {
 245                         $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR;
 246                 }
 247         }
 248         my $crosswalk = MARC::Crosswalk::DublinCore->new;
 249         if ($qualified) {
 250                 $crosswalk = MARC::Crosswalk::DublinCore->new( qualified => 1 );
 251         }
 252         my $dcxml = $crosswalk->as_dublincore($marc_record_obj);
 253         my $dcxmlfinal = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
 254         $dcxmlfinal .= "<metadata
 255   xmlns=\"http://example.org/myapp/\"
 256   xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"
 257   xsi:schemaLocation=\"http://example.org/myapp/ http://example.org/myapp/schema.xsd\"
 258   xmlns:dc=\"http://purl.org/dc/elements/1.1/\"
 259   xmlns:dcterms=\"http://purl.org/dc/terms/\">";
 260
 261         foreach my $element ( $dcxml->elements() ) {
 262                 $dcxmlfinal.="<"."dc:".$element->name().">".$element->content()."</"."dc:".$element->name().">\n";
 263     }
 264         $dcxmlfinal .= "\n</metadata>";
 265         return ($error,$dcxmlfinal);
 266 }
 267 =head2 marc2modsxml - Convert from ISO-2709 to MODS
 268
 269 =over 4
 270
 271 my ($error,$modsxml) = marc2modsxml($marc);
 272
 273 Returns a MODS scalar
 274
 275 =back
 276
 277 =cut
 278
 279 sub marc2modsxml {
 280         my ($marc) = @_;
 281         # grab the XML, run it through our stylesheet, push it out to the browser
 282         my $xmlrecord = marc2marcxml($marc);
 283         my $xslfile = C4::Context->config('intrahtdocs')."/prog/en/xslt/MARC21slim2MODS3-1.xsl";
 284         my $parser = XML::LibXML->new();
 285         my $xslt = XML::LibXSLT->new();
 286         my $source = $parser->parse_string($xmlrecord);
 287         my $style_doc = $parser->parse_file($xslfile);
 288         my $stylesheet = $xslt->parse_stylesheet($style_doc);
 289         my $results = $stylesheet->transform($source);
 290         my $newxmlrecord = $stylesheet->output_string($results);
 291         return ($newxmlrecord);
 292 }
 293
 294 sub marc2endnote {
 295     my ($marc) = @_;
 296         my $marc_rec_obj =  MARC::Record->new_from_usmarc($marc);
 297         my $f260 = $marc_rec_obj->field('260');
 298         my $f260a = $f260->subfield('a') if $f260;
 299     my $f710 = $marc_rec_obj->field('710');
 300     my $f710a = $f710->subfield('a') if $f710;
 301         my $f500 = $marc_rec_obj->field('500');
 302         my $abstract = $f500->subfield('a') if $f500;
 303         my $fields = {
 304                 DB => C4::Context->preference("LibraryName"),
 305                 Title => $marc_rec_obj->title(),
 306                 Author => $marc_rec_obj->author(),
 307                 Publisher => $f710a,
 308                 City => $f260a,
 309                 Year => $marc_rec_obj->publication_date,
 310                 Abstract => $abstract,
 311         };
 312         my $endnote;
 313         my $style = new Biblio::EndnoteStyle();
 314         my $template;
 315         $template.= "DB - DB\n" if C4::Context->preference("LibraryName");
 316         $template.="T1 - Title\n" if $marc_rec_obj->title();
 317         $template.="A1 - Author\n" if $marc_rec_obj->author();
 318         $template.="PB - Publisher\n" if  $f710a;
 319         $template.="CY - City\n" if $f260a;
 320         $template.="Y1 - Year\n" if $marc_rec_obj->publication_date;
 321         $template.="AB - Abstract\n" if $abstract;
 322         my ($text, $errmsg) = $style->format($template, $fields);
 323         return ($text);
 324
 325 }
 326
 327
 328 =head2 marc2bibtex - Convert from UNIMARC to BibTex
 329
 330 =over 4
 331
 332 my ($bibtex) = marc2bibtex($record, $id);
 333
 334 Returns a BibTex scalar
 335
 336 =over 2
 337
 338 C<$record> - a MARC::Record object
 339
 340 C<$id> - an id for the BibTex record (might be the biblionumber)
 341
 342 =back
 343
 344 =back
 345
 346 =cut
 347
 348
 349 sub marc2bibtex {
 350     my ($record, $id) = @_;
 351     my $tex;
 352
 353     # Authors
 354     my $marcauthors = GetMarcAuthors($record,C4::Context->preference("marcflavour"));
 355     my $author;
 356     for my $authors ( map { map { @$_ } values %$_  } @$marcauthors  ) {
 357         $author .= " and " if ($author && $$authors{value});
 358         $author .= $$authors{value} if ($$authors{value});
 359     }
 360
 361     # Defining the conversion hash according to the marcflavour
 362     my %bh;
 363     if (C4::Context->preference("marcflavour") eq "UNIMARC") {
 364
 365         # FIXME, TODO : handle repeatable fields
 366         # TODO : handle more types of documents
 367
 368         # Unimarc to bibtex hash
 369         %bh = (
 370
 371             # Mandatory
 372             author    => $author,
 373             title     => $record->subfield("200", "a") || "",
 374             editor    => $record->subfield("210", "g") || "",
 375             publisher => $record->subfield("210", "c") || "",
 376             year      => $record->subfield("210", "d") || $record->subfield("210", "h") || "",
 377
 378             # Optional
 379             volume  =>  $record->subfield("200", "v") || "",
 380             series  =>  $record->subfield("225", "a") || "",
 381             address =>  $record->subfield("210", "a") || "",
 382             edition =>  $record->subfield("205", "a") || "",
 383             note    =>  $record->subfield("300", "a") || "",
 384             url     =>  $record->subfield("856", "u") || ""
 385         );
 386     } else {
 387
 388         # Marc21 to bibtex hash
 389         %bh = (
 390
 391             # Mandatory
 392             author    => $author,
 393             title     => $record->subfield("245", "a") || "",
 394             editor    => $record->subfield("260", "f") || "",
 395             publisher => $record->subfield("260", "b") || "",
 396             year      => $record->subfield("260", "c") || $record->subfield("260", "g") || "",
 397
 398             # Optional
 399             # unimarc to marc21 specification says not to convert 200$v to marc21
 400             series  =>  $record->subfield("490", "a") || "",
 401             address =>  $record->subfield("260", "a") || "",
 402             edition =>  $record->subfield("250", "a") || "",
 403             note    =>  $record->subfield("500", "a") || "",
 404             url     =>  $record->subfield("856", "u") || ""
 405         );
 406     }
 407
 408     $tex .= "\@book{";
 409     $tex .= join(",\n", $id, map { $bh{$_} ? qq(\t$_ = "$bh{$_}") : () } keys %bh);
 410     $tex .= "\n}\n";
 411
 412     return $tex;
 413 }
 414
 415 =head2 html2marcxml
 416
 417 =over 4
 418
 419 my ($error,$marcxml) = html2marcxml($tags,$subfields,$values,$indicator,$ind_tag);
 420
 421 Returns a MARCXML scalar
 422
 423 this is used in addbiblio.pl and additem.pl to build the MARCXML record from
 424 the form submission.
 425
 426 FIXME: this could use some better code documentation
 427
 428 =back
 429
 430 =cut
 431
 432 sub html2marcxml {
 433     my ($tags,$subfields,$values,$indicator,$ind_tag) = @_;
 434         my $error;
 435         # add the header info
 436     my $marcxml= MARC::File::XML::header(C4::Context->preference('TemplateEncoding'),C4::Context->preference('marcflavour'));
 437
 438         # some flags used to figure out where in the record we are
 439     my $prevvalue;
 440     my $prevtag=-1;
 441     my $first=1;
 442     my $j = -1;
 443
 444         # handle characters that would cause the parser to choke FIXME: is there a more elegant solution?
 445     for (my $i=0;$i<=@$tags;$i++){
 446                 @$values[$i] =~ s/&/&amp;/g;
 447                 @$values[$i] =~ s/</&lt;/g;
 448                 @$values[$i] =~ s/>/&gt;/g;
 449                 @$values[$i] =~ s/"/&quot;/g;
 450                 @$values[$i] =~ s/'/&apos;/g;
 451
 452                 if ((@$tags[$i] ne $prevtag)){
 453                         $j++ unless (@$tags[$i] eq "");
 454                         #warn "IND:".substr(@$indicator[$j],0,1).substr(@$indicator[$j],1,1)." ".@$tags[$i];
 455                         if (!$first){
 456                                 $marcxml.="</datafield>\n";
 457                                 if ((@$tags[$i] > 10) && (@$values[$i] ne "")){
 458                         my $ind1 = substr(@$indicator[$j],0,1);
 459                                         my $ind2 = substr(@$indicator[$j],1,1);
 460                                         $marcxml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
 461                                         $marcxml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
 462                                         $first=0;
 463                                 } else {
 464                                         $first=1;
 465                                 }
 466                         } else {
 467                                 if (@$values[$i] ne "") {
 468                                         # handle the leader
 469                                         if (@$tags[$i] eq "000") {
 470                                                 $marcxml.="<leader>@$values[$i]</leader>\n";
 471                                                 $first=1;
 472                                         # rest of the fixed fields
 473                                         } elsif (@$tags[$i] < 010) { #FIXME: <10 was the way it was, there might even be a better way
 474                                                 $marcxml.="<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
 475                                                 $first=1;
 476                                         } else {
 477                                                 my $ind1 = substr(@$indicator[$j],0,1);
 478                                                 my $ind2 = substr(@$indicator[$j],1,1);
 479                                                 $marcxml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
 480                                                 $marcxml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
 481                                                 $first=0;
 482                                         }
 483                                 }
 484                         }
 485                 } else { # @$tags[$i] eq $prevtag
 486                         if (@$values[$i] eq "") {
 487                         } else {
 488                                 if ($first){
 489                                         my $ind1 = substr(@$indicator[$j],0,1);
 490                                         my $ind2 = substr(@$indicator[$j],1,1);
 491                                         $marcxml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
 492                                         $first=0;
 493                                 }
 494                                 $marcxml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
 495                         }
 496                 }
 497                 $prevtag = @$tags[$i];
 498         }
 499         $marcxml.= MARC::File::XML::footer();
 500         #warn $marcxml;
 501         return ($error,$marcxml);
 502 }
 503
 504 =head2 html2marc
 505
 506 =over 4
 507
 508 Probably best to avoid using this ... it has some rather striking problems:
 509
 510 =over 2
 511
 512 * saves blank subfields
 513
 514 * subfield order is hardcoded to always start with 'a' for repeatable tags (because it is hardcoded in the addfield routine).
 515
 516 * only possible to specify one set of indicators for each set of tags (ie, one for all the 650s). (because they were stored in a hash with the tag as the key).
 517
 518 * the underlying routines didn't support subfield reordering or subfield repeatability.
 519
 520 =back
 521
 522 I've left it in here because it could be useful if someone took the time to fix it. -- kados
 523
 524 =back
 525
 526 =cut
 527
 528 sub html2marc {
 529     my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
 530     my $prevtag = -1;
 531     my $record = MARC::Record->new();
 532 #   my %subfieldlist=();
 533     my $prevvalue; # if tag <10
 534     my $field; # if tag >=10
 535     for (my $i=0; $i< @$rtags; $i++) {
 536         # rebuild MARC::Record
 537 #           warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
 538         if (@$rtags[$i] ne $prevtag) {
 539             if ($prevtag < 10) {
 540                 if ($prevvalue) {
 541                     if (($prevtag ne '000') && ($prevvalue ne "")) {
 542                         $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
 543                     } elsif ($prevvalue ne ""){
 544                         $record->leader($prevvalue);
 545                     }
 546                 }
 547             } else {
 548                 if (($field) && ($field ne "")) {
 549                     $record->add_fields($field);
 550                 }
 551             }
 552             $indicators{@$rtags[$i]}.='  ';
 553                 # skip blank tags, I hope this works
 554                 if (@$rtags[$i] eq ''){
 555                 $prevtag = @$rtags[$i];
 556                 undef $field;
 557                 next;
 558             }
 559             if (@$rtags[$i] <10) {
 560                 $prevvalue= @$rvalues[$i];
 561                 undef $field;
 562             } else {
 563                 undef $prevvalue;
 564                 if (@$rvalues[$i] eq "") {
 565                 undef $field;
 566                 } else {
 567                 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
 568                 }
 569 #           warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
 570             }
 571             $prevtag = @$rtags[$i];
 572         } else {
 573             if (@$rtags[$i] <10) {
 574                 $prevvalue=@$rvalues[$i];
 575             } else {
 576                 if (length(@$rvalues[$i])>0) {
 577                     $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
 578 #           warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
 579                 }
 580             }
 581             $prevtag= @$rtags[$i];
 582         }
 583     }
 584     #}
 585     # the last has not been included inside the loop... do it now !
 586     #use Data::Dumper;
 587     #warn Dumper($field->{_subfields});
 588     $record->add_fields($field) if (($field) && $field ne "");
 589     #warn "HTML2MARC=".$record->as_formatted;
 590     return $record;
 591 }
 592
 593 =head2 changeEncoding - Change the encoding of a record
 594
 595 =over 4
 596
 597 my ($error, $newrecord) = changeEncoding($record,$format,$flavour,$to_encoding,$from_encoding);
 598
 599 Changes the encoding of a record
 600
 601 =over 2
 602
 603 C<$record> - the record itself can be in ISO-2709, a MARC::Record object, or MARCXML for now (required)
 604
 605 C<$format> - MARC or MARCXML (required)
 606
 607 C<$flavour> - MARC21 or UNIMARC, if MARC21, it will change the leader (optional) [defaults to Koha system preference]
 608
 609 C<$to_encoding> - the encoding you want the record to end up in (optional) [UTF-8]
 610
 611 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)
 612
 613 =back
 614
 615 FIXME: the from_encoding doesn't work yet
 616
 617 FIXME: better handling for UNIMARC, it should allow management of 100 field
 618
 619 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
 620
 621 =back
 622
 623 =cut
 624
 625 sub changeEncoding {
 626         my ($record,$format,$flavour,$to_encoding,$from_encoding) = @_;
 627         my $newrecord;
 628         my $error;
 629         unless($flavour) {$flavour = C4::Context->preference("marcflavour")};
 630         unless($to_encoding) {$to_encoding = "UTF-8"};
 631
 632         # ISO-2709 Record (MARC21 or UNIMARC)
 633         if (lc($format) =~ /^marc$/o) {
 634                 # if we're converting encoding of an ISO2709 file, we need to roundtrip through XML
 635                 #       because MARC::Record doesn't directly provide us with an encoding method
 636                 #       It's definitely less than idea and should be fixed eventually - kados
 637                 my $marcxml; # temporary storage of MARCXML scalar
 638                 ($error,$marcxml) = marc2marcxml($record,$to_encoding,$flavour);
 639                 unless ($error) {
 640                         ($error,$newrecord) = marcxml2marc($marcxml,$to_encoding,$flavour);
 641                 }
 642
 643         # MARCXML Record
 644         } elsif (lc($format) =~ /^marcxml$/o) { # MARCXML Record
 645                 my $marc;
 646                 ($error,$marc) = marcxml2marc($record,$to_encoding,$flavour);
 647                 unless ($error) {
 648                         ($error,$newrecord) = marc2marcxml($record,$to_encoding,$flavour);
 649                 }
 650         } else {
 651                 $error.="Unsupported record format:".$format;
 652         }
 653         return ($error,$newrecord);
 654 }
 655
 656 =head1 INTERNAL FUNCTIONS
 657
 658 =head2 _entity_encode - Entity-encode an array of strings
 659
 660 =over 4
 661
 662 my ($entity_encoded_string) = _entity_encode($string);
 663
 664 or
 665
 666 my (@entity_encoded_strings) = _entity_encode(@strings);
 667
 668 Entity-encode an array of strings
 669
 670 =back
 671
 672 =cut
 673
 674 sub _entity_encode {
 675         my @strings = @_;
 676         my @strings_entity_encoded;
 677         foreach my $string (@strings) {
 678                 my $nfc_string = NFC($string);
 679                 $nfc_string =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
 680                 push @strings_entity_encoded, $nfc_string;
 681         }
 682         return @strings_entity_encoded;
 683 }
 684
 685 END { }       # module clean-up code here (global destructor)
 686 1;
 687 __END__
 688
 689 =head1 AUTHOR
 690
 691 Joshua Ferraro <jmf@liblime.com>
 692
 693 =head1 MODIFICATIONS
 694
 695
 696 =cut