From 124df1a1df3811ab6d014d8cec2d343021ee2bed Mon Sep 17 00:00:00 2001 From: Hector Castro Date: Thu, 28 Jan 2016 15:47:58 -0600 Subject: [PATCH] Bug 15698: Include MARCMAker option export to Record.pm Feature inclue: -Sub marc2marcmaker in Record.pm -Include module MARC::File::MARCMaker --- C4/Installer/PerlDependencies.pm | 5 +++ C4/Record.pm | 69 ++++++++++++++++++++++++++++++++++++++ debian/control | 2 ++ 3 files changed, 76 insertions(+) diff --git a/C4/Installer/PerlDependencies.pm b/C4/Installer/PerlDependencies.pm index d621f33..6155abc 100644 --- a/C4/Installer/PerlDependencies.pm +++ b/C4/Installer/PerlDependencies.pm @@ -822,6 +822,11 @@ our $PERL_DEPS = { 'required' => '0', 'min_ver' => '0.03', }, + 'MARC::File::MARCMaker' => { + 'usage' => 'Core', + 'required' => '1', + 'min_ver' => '0.05', + }, }; 1; diff --git a/C4/Record.pm b/C4/Record.pm index 1360155..49008b4 100644 --- a/C4/Record.pm +++ b/C4/Record.pm @@ -25,6 +25,7 @@ use strict; # please specify in which methods a given module is used use MARC::Record; # marc2marcxml, marcxml2marc, changeEncoding +use MARC::File::MARCMaker; #marc2marcmaker use MARC::File::XML; # marc2marcxml, marcxml2marc, changeEncoding use Biblio::EndnoteStyle; use Unicode::Normalize; # _entity_encode @@ -58,6 +59,7 @@ $VERSION = 3.07.00.049; &marc2madsxml &marc2bibtex &marc2csv + &marc2marcmaker &changeEncoding ); @@ -854,6 +856,73 @@ sub marc2bibtex { return $tex; } +=head2 marc2marcmaker - Convert from ISO-2709 to MARCMaker format + + my ( $error, $marcmaker) = marc2marcmaker( $marc, $biblionumber, $unimarc2marc21 ); + +Returns a MARCMaker format + +C<$marc> - an ISO-2709 or MARC::Record object + +C<$biblionumber> - The biblionumber of the record + +C<$unimarc2marc21> - Set to 1 to convert UNIMARC to MARC21 on the fly or 0 if don't (Only for UNIMARC environment) + +=cut + +sub marc2marcmaker { + + my ( $marc, $biblionumber, $unimarc2marc21 ) = @_; + + # global variables + my ( $marc_mrk_output, $marcxml, $output_xsl, $marc_record_obj, $xsl, $error ); + + if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object + ($unimarc2marc21) ? + $marcxml = C4::Record::marc2marcxml( $marc ) : + $marc_record_obj = $marc; + } elsif ( defined $biblionumber ) { + ($unimarc2marc21) ? + $marcxml = C4::Biblio::GetXmlBiblio( $biblionumber ) : + $marc_record_obj = GetMarcBiblio($biblionumber, 1); + } else { # it's not a MARC::Record object, make it one + eval { $marc_record_obj = MARC::Record->new_from_usmarc( $marc ) }; # handle exceptions + } + + # conversion to MARC::Record object failed + if ( $@ ) { + $error .= "\nCreation of MARC::Record object failed: " . $MARC::Record::ERROR; + carp "Creation of MARC::Record object failed."; + } elsif ( $marc_record_obj->warnings() ) { + carp "Warnings encountered while processing ISO-2709 record.\n"; + my @warnings = $marc_record_obj->warnings(); + foreach my $warn (@warnings) { + carp "\t". $warn; + }; + } + + #Convert UNIMARC to MARC21 + if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and $unimarc2marc21 ) { + $xsl = C4::Context->config('intrahtdocs') . '/prog/en/xslt/UNIMARC2MARC21.xsl'; + my $xslt_engine = Koha::XSLT_Handler->new; + $output_xsl = $xslt_engine->transform( $marcxml, $xsl ); + my $err = $xslt_engine->err; # error number + my $errstr = $xslt_engine->errstr; # error message + if ( $err ) { + $error .= "Error when processing $errstr Error number: $err\n"; + carp "Error when processing $errstr Error number: $err\n"; + } else { + $marc_record_obj = C4::Record::marcxml2marc( $output_xsl, 'UTF-8', 'MARC21' ); + } + } + + unless ($error) { # if no errors makes MARCMaker convertion + $marc_mrk_output = MARC::File::MARCMaker->encode($marc_record_obj); + } + + return ( $error, $marc_mrk_output ); + +} =head1 INTERNAL FUNCTIONS diff --git a/debian/control b/debian/control index d8a5caf..f8466d7 100644 --- a/debian/control +++ b/debian/control @@ -70,6 +70,7 @@ Build-Depends: libalgorithm-checkdigits-perl, liblwp-protocol-https-perl|libwww-perl (<6.02), libio-socket-ssl-perl, libmail-sendmail-perl, libmarc-charset-perl, + libmarc-file-marcmaker-perl libmarc-record-perl, libmarc-xml-perl, libmemoize-memcached-perl, @@ -277,6 +278,7 @@ Depends: libalgorithm-checkdigits-perl, liblwp-protocol-https-perl|libwww-perl (<6.02), libio-socket-ssl-perl, libmail-sendmail-perl, libmarc-charset-perl, + libmarc-file-marcmaker-perl libmarc-record-perl, libmarc-xml-perl, libmemoize-memcached-perl, -- 1.7.10.4