Bugzilla – Attachment 35489 Details for
Bug 12357
Enhancements to RIS and BibTeX exporting
Home
|
New
|
Browse
|
Search
|
[?]
|
Reports
|
Help
|
New Account
|
Log In
[x]
|
Forgot Password
Login:
[x]
[patch]
Bug 12357 - Tidy Record.pm
Bug-12357---Tidy-Recordpm.patch (text/plain), 36.65 KB, created by
Kyle M Hall (khall)
on 2015-01-23 12:26:40 UTC
(
hide
)
Description:
Bug 12357 - Tidy Record.pm
Filename:
MIME Type:
Creator:
Kyle M Hall (khall)
Created:
2015-01-23 12:26:40 UTC
Size:
36.65 KB
patch
obsolete
>From 7a3478ef13b823ccdac240315b3e595f710a0247 Mon Sep 17 00:00:00 2001 >From: Kyle M Hall <kyle@bywatersolutions.com> >Date: Fri, 23 Jan 2015 07:24:20 -0500 >Subject: [PATCH] Bug 12357 - Tidy Record.pm > >--- > C4/Record.pm | 684 +++++++++++++++++++++++++++++++--------------------------- > 1 files changed, 362 insertions(+), 322 deletions(-) > >diff --git a/C4/Record.pm b/C4/Record.pm >index 8f2ad9c..e88a665 100644 >--- a/C4/Record.pm >+++ b/C4/Record.pm >@@ -20,20 +20,21 @@ package C4::Record; > # > # > use strict; >+ > #use warnings; FIXME - Bug 2505 > > # please specify in which methods a given module is used >-use MARC::Record; # marc2marcxml, marcxml2marc, changeEncoding >-use MARC::File::XML; # marc2marcxml, marcxml2marc, changeEncoding >-use MARC::Crosswalk::DublinCore; # marc2dcxml >+use MARC::Record; # marc2marcxml, marcxml2marc, changeEncoding >+use MARC::File::XML; # marc2marcxml, marcxml2marc, changeEncoding >+use MARC::Crosswalk::DublinCore; # marc2dcxml > use Biblio::EndnoteStyle; >-use Unicode::Normalize; # _entity_encode >-use C4::Biblio; #marc2bibtex >-use C4::Csv; #marc2csv >-use C4::Koha; #marc2csv >+use Unicode::Normalize; # _entity_encode >+use C4::Biblio; #marc2bibtex >+use C4::Csv; #marc2csv >+use C4::Koha; #marc2csv > use C4::XSLT (); >-use YAML; #marcrecords2csv >-use Text::CSV::Encoded; #marc2csv >+use YAML; #marcrecords2csv >+use Text::CSV::Encoded; #marc2csv > use Koha::SimpleMARC qw(read_field); > > use vars qw($VERSION @ISA @EXPORT); >@@ -77,34 +78,39 @@ Returns an ISO-2709 scalar > =cut > > sub marc2marc { >- my ($marc,$to_flavour,$from_flavour,$encoding) = @_; >- my $error; >- if ($to_flavour =~ m/marcstd/) { >+ my ( $marc, $to_flavour, $from_flavour, $encoding ) = @_; >+ my $error; >+ if ( $to_flavour =~ m/marcstd/ ) { > my $marc_record_obj; >- if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object >+ if ( $marc =~ /^MARC::Record/ ) { # it's already a MARC::Record object > $marc_record_obj = $marc; >- } else { # it's not a MARC::Record object, make it one >- eval { $marc_record_obj = MARC::Record->new_from_usmarc($marc) }; # handle exceptions >+ } >+ 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, populate $error >- if ($@) { $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR }; >+ # conversion to MARC::Record object failed, populate $error >+ if ($@) { $error .= "\nCreation of MARC::Record object failed: " . $MARC::File::ERROR } > } > unless ($error) { > my @privatefields; >- foreach my $field ($marc_record_obj->fields()) { >- if ($field->tag() =~ m/9/ && ($field->tag() != '490' || C4::Context->preference("marcflavour") eq 'UNIMARC')) { >+ foreach my $field ( $marc_record_obj->fields() ) { >+ if ( $field->tag() =~ m/9/ >+ && ( $field->tag() != '490' || C4::Context->preference("marcflavour") eq 'UNIMARC' ) ) >+ { > push @privatefields, $field; >- } elsif (! ($field->is_control_field())) { >- $field->delete_subfield(code => '9') if ($field->subfield('9')); >+ } >+ elsif ( !( $field->is_control_field() ) ) { >+ $field->delete_subfield( code => '9' ) if ( $field->subfield('9') ); > } > } > $marc_record_obj->delete_field($_) for @privatefields; > $marc = $marc_record_obj->as_usmarc(); > } >- } else { >+ } >+ else { > $error = "Feature not yet implemented\n"; > } >- return ($error,$marc); >+ return ( $error, $marc ); > } > > =head2 marc2marcxml - Convert from ISO-2709 to MARCXML >@@ -124,65 +130,73 @@ C<$dont_entity_encode> - a flag that instructs marc2marcxml not to entity encode > =cut > > sub marc2marcxml { >- my ($marc,$encoding,$flavour,$dont_entity_encode) = @_; >- my $error; # the error string >- my $marcxml; # the final MARCXML scalar >- >- # test if it's already a MARC::Record object, if not, make it one >- my $marc_record_obj; >- if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object >- $marc_record_obj = $marc; >- } 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, populate $error >- if ($@) { $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR }; >- } >- # only proceed if no errors so far >- unless ($error) { >- >- # check the record for warnings >- my @warnings = $marc_record_obj->warnings(); >- if (@warnings) { >- warn "\nWarnings encountered while processing ISO-2709 record with title \"".$marc_record_obj->title()."\":\n"; >- foreach my $warn (@warnings) { warn "\t".$warn }; >- } >- unless($encoding) {$encoding = "UTF-8"}; # set default encoding >- unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; # set default MARC flavour >- >- # attempt to convert the record to MARCXML >- eval { $marcxml = $marc_record_obj->as_xml_record($flavour) }; #handle exceptions >- >- # record creation failed, populate $error >- if ($@) { >- $error .= "Creation of MARCXML failed:".$MARC::File::ERROR; >- $error .= "Additional information:\n"; >- my @warnings = $@->warnings(); >- foreach my $warn (@warnings) { $error.=$warn."\n" }; >- >- # record creation was successful >- } else { >- >- # check the record for warning flags again (warnings() will be cleared already if there was an error, see above block >- @warnings = $marc_record_obj->warnings(); >- if (@warnings) { >- warn "\nWarnings encountered while processing ISO-2709 record with title \"".$marc_record_obj->title()."\":\n"; >- foreach my $warn (@warnings) { warn "\t".$warn }; >- } >- } >- >- # only proceed if no errors so far >- unless ($error) { >- >- # entity encode the XML unless instructed not to >- unless ($dont_entity_encode) { >- my ($marcxml_entity_encoded) = _entity_encode($marcxml); >- $marcxml = $marcxml_entity_encoded; >- } >- } >- } >- # return result to calling program >- return ($error,$marcxml); >+ my ( $marc, $encoding, $flavour, $dont_entity_encode ) = @_; >+ my $error; # the error string >+ my $marcxml; # the final MARCXML scalar >+ >+ # test if it's already a MARC::Record object, if not, make it one >+ my $marc_record_obj; >+ if ( $marc =~ /^MARC::Record/ ) { # it's already a MARC::Record object >+ $marc_record_obj = $marc; >+ } >+ 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, populate $error >+ if ($@) { $error .= "\nCreation of MARC::Record object failed: " . $MARC::File::ERROR } >+ } >+ >+ # only proceed if no errors so far >+ unless ($error) { >+ >+ # check the record for warnings >+ my @warnings = $marc_record_obj->warnings(); >+ if (@warnings) { >+ warn "\nWarnings encountered while processing ISO-2709 record with title \"" >+ . $marc_record_obj->title() . "\":\n"; >+ foreach my $warn (@warnings) { warn "\t" . $warn } >+ } >+ unless ($encoding) { $encoding = "UTF-8" } >+ ; # set default encoding >+ unless ($flavour) { $flavour = C4::Context->preference("marcflavour") } >+ ; # set default MARC flavour >+ >+ # attempt to convert the record to MARCXML >+ eval { $marcxml = $marc_record_obj->as_xml_record($flavour) }; #handle exceptions >+ >+ # record creation failed, populate $error >+ if ($@) { >+ $error .= "Creation of MARCXML failed:" . $MARC::File::ERROR; >+ $error .= "Additional information:\n"; >+ my @warnings = $@->warnings(); >+ foreach my $warn (@warnings) { $error .= $warn . "\n" } >+ >+ # record creation was successful >+ } >+ else { >+ >+ # check the record for warning flags again (warnings() will be cleared already if there was an error, see above block >+ @warnings = $marc_record_obj->warnings(); >+ if (@warnings) { >+ warn "\nWarnings encountered while processing ISO-2709 record with title \"" >+ . $marc_record_obj->title() . "\":\n"; >+ foreach my $warn (@warnings) { warn "\t" . $warn } >+ } >+ } >+ >+ # only proceed if no errors so far >+ unless ($error) { >+ >+ # entity encode the XML unless instructed not to >+ unless ($dont_entity_encode) { >+ my ($marcxml_entity_encoded) = _entity_encode($marcxml); >+ $marcxml = $marcxml_entity_encoded; >+ } >+ } >+ } >+ >+ # return result to calling program >+ return ( $error, $marcxml ); > } > > =head2 marcxml2marc - Convert from MARCXML to ISO-2709 >@@ -200,21 +214,25 @@ C<$flavour> - MARC21 or UNIMARC > =cut > > sub marcxml2marc { >- my ($marcxml,$encoding,$flavour) = @_; >- my $error; # the error string >- my $marc; # the final ISO-2709 scalar >- unless($encoding) {$encoding = "UTF-8"}; # set the default encoding >- unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; # set the default MARC flavour >- >- # attempt to do the conversion >- eval { $marc = MARC::Record->new_from_xml($marcxml,$encoding,$flavour) }; # handle exceptions >- >- # record creation failed, populate $error >- if ($@) {$error .="\nCreation of MARCXML Record failed: ".$@; >- $error.=$MARC::File::ERROR if ($MARC::File::ERROR); >- }; >- # return result to calling program >- return ($error,$marc); >+ my ( $marcxml, $encoding, $flavour ) = @_; >+ my $error; # the error string >+ my $marc; # the final ISO-2709 scalar >+ unless ($encoding) { $encoding = "UTF-8" } >+ ; # set the default encoding >+ unless ($flavour) { $flavour = C4::Context->preference("marcflavour") } >+ ; # set the default MARC flavour >+ >+ # attempt to do the conversion >+ eval { $marc = MARC::Record->new_from_xml( $marcxml, $encoding, $flavour ) }; # handle exceptions >+ >+ # record creation failed, populate $error >+ if ($@) { >+ $error .= "\nCreation of MARCXML Record failed: " . $@; >+ $error .= $MARC::File::ERROR if ($MARC::File::ERROR); >+ } >+ >+ # return result to calling program >+ return ( $error, $marc ); > } > > =head2 marc2dcxml - Convert from ISO-2709 to Dublin Core >@@ -232,38 +250,41 @@ C<$qualified> - specify whether qualified Dublin Core should be used in the inpu > =cut > > sub marc2dcxml { >- my ($marc,$qualified) = @_; >- my $error; >+ my ( $marc, $qualified ) = @_; >+ my $error; >+ > # test if it's already a MARC::Record object, if not, make it one > my $marc_record_obj; >- if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object >+ if ( $marc =~ /^MARC::Record/ ) { # it's already a MARC::Record object > $marc_record_obj = $marc; >- } 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, populate $error >- if ($@) { >- $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR; >- } >- } >- my $crosswalk = MARC::Crosswalk::DublinCore->new; >- if ($qualified) { >- $crosswalk = MARC::Crosswalk::DublinCore->new( qualified => 1 ); >- } >- my $dcxml = $crosswalk->as_dublincore($marc_record_obj); >- my $dcxmlfinal = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"; >- $dcxmlfinal .= "<metadata >+ } >+ 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, populate $error >+ if ($@) { >+ $error .= "\nCreation of MARC::Record object failed: " . $MARC::File::ERROR; >+ } >+ } >+ my $crosswalk = MARC::Crosswalk::DublinCore->new; >+ if ($qualified) { >+ $crosswalk = MARC::Crosswalk::DublinCore->new( qualified => 1 ); >+ } >+ my $dcxml = $crosswalk->as_dublincore($marc_record_obj); >+ my $dcxmlfinal = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"; >+ $dcxmlfinal .= "<metadata > xmlns=\"http://example.org/myapp/\" > xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" > xsi:schemaLocation=\"http://example.org/myapp/ http://example.org/myapp/schema.xsd\" > xmlns:dc=\"http://purl.org/dc/elements/1.1/\" > xmlns:dcterms=\"http://purl.org/dc/terms/\">"; > >- foreach my $element ( $dcxml->elements() ) { >- $dcxmlfinal.="<"."dc:".$element->name().">".$element->content()."</"."dc:".$element->name().">\n"; >+ foreach my $element ( $dcxml->elements() ) { >+ $dcxmlfinal .= >+ "<" . "dc:" . $element->name() . ">" . $element->content() . "</" . "dc:" . $element->name() . ">\n"; > } >- $dcxmlfinal .= "\n</metadata>"; >- return ($error,$dcxmlfinal); >+ $dcxmlfinal .= "\n</metadata>"; >+ return ( $error, $dcxmlfinal ); > } > > =head2 marc2modsxml - Convert from ISO-2709 to MODS >@@ -276,7 +297,7 @@ Returns a MODS scalar > > sub marc2modsxml { > my ($marc) = @_; >- return _transformWithStylesheet($marc, "/prog/en/xslt/MARC21slim2MODS3-1.xsl"); >+ return _transformWithStylesheet( $marc, "/prog/en/xslt/MARC21slim2MODS3-1.xsl" ); > } > > =head2 marc2madsxml - Convert from ISO-2709 to MADS >@@ -289,7 +310,7 @@ Returns a MADS scalar > > sub marc2madsxml { > my ($marc) = @_; >- return _transformWithStylesheet($marc, "/prog/en/xslt/MARC21slim2MADS.xsl"); >+ return _transformWithStylesheet( $marc, "/prog/en/xslt/MARC21slim2MADS.xsl" ); > } > > =head2 _transformWithStylesheet - Transform a MARC record with a stylesheet >@@ -302,16 +323,17 @@ contain the path to a stylesheet under intrahtdocs. > =cut > > sub _transformWithStylesheet { >- my ($marc, $stylesheet) = @_; >+ my ( $marc, $stylesheet ) = @_; >+ > # grab the XML, run it through our stylesheet, push it out to the browser > my $xmlrecord = marc2marcxml($marc); >- my $xslfile = C4::Context->config('intrahtdocs') . $stylesheet; >- return C4::XSLT::engine->transform($xmlrecord, $xslfile); >+ my $xslfile = C4::Context->config('intrahtdocs') . $stylesheet; >+ return C4::XSLT::engine->transform( $xmlrecord, $xslfile ); > } > > sub marc2endnote { > my ($marc) = @_; >- my $marc_rec_obj = MARC::Record->new_from_usmarc($marc); >+ my $marc_rec_obj = MARC::Record->new_from_usmarc($marc); > my ( $abstract, $f260a, $f710a ); > my $f260 = $marc_rec_obj->field('260'); > if ($f260) { >@@ -325,27 +347,27 @@ sub marc2endnote { > if ($f500) { > $abstract = $f500->subfield('a'); > } >- my $fields = { >- DB => C4::Context->preference("LibraryName"), >- Title => $marc_rec_obj->title(), >- Author => $marc_rec_obj->author(), >- Publisher => $f710a, >- City => $f260a, >- Year => $marc_rec_obj->publication_date, >- Abstract => $abstract, >- }; >- my $endnote; >- my $style = new Biblio::EndnoteStyle(); >- my $template; >- $template.= "DB - DB\n" if C4::Context->preference("LibraryName"); >- $template.="T1 - Title\n" if $marc_rec_obj->title(); >- $template.="A1 - Author\n" if $marc_rec_obj->author(); >- $template.="PB - Publisher\n" if $f710a; >- $template.="CY - City\n" if $f260a; >- $template.="Y1 - Year\n" if $marc_rec_obj->publication_date; >- $template.="AB - Abstract\n" if $abstract; >- my ($text, $errmsg) = $style->format($template, $fields); >- return ($text); >+ my $fields = { >+ DB => C4::Context->preference("LibraryName"), >+ Title => $marc_rec_obj->title(), >+ Author => $marc_rec_obj->author(), >+ Publisher => $f710a, >+ City => $f260a, >+ Year => $marc_rec_obj->publication_date, >+ Abstract => $abstract, >+ }; >+ my $endnote; >+ my $style = new Biblio::EndnoteStyle(); >+ my $template; >+ $template .= "DB - DB\n" if C4::Context->preference("LibraryName"); >+ $template .= "T1 - Title\n" if $marc_rec_obj->title(); >+ $template .= "A1 - Author\n" if $marc_rec_obj->author(); >+ $template .= "PB - Publisher\n" if $f710a; >+ $template .= "CY - City\n" if $f260a; >+ $template .= "Y1 - Year\n" if $marc_rec_obj->publication_date; >+ $template .= "AB - Abstract\n" if $abstract; >+ my ( $text, $errmsg ) = $style->format( $template, $fields ); >+ return ($text); > > } > >@@ -366,29 +388,30 @@ C<$itemnumbers> - a list of itemnumbers to export > =cut > > sub marc2csv { >- my ($biblios, $id, $itemnumbers) = @_; >+ my ( $biblios, $id, $itemnumbers ) = @_; > $itemnumbers ||= []; > my $output; > my $csv = Text::CSV::Encoded->new(); > > # Getting yaml file > my $configfile = "../tools/csv-profiles/$id.yaml"; >- my ($preprocess, $postprocess, $fieldprocessing); >- if (-e $configfile){ >- ($preprocess,$postprocess, $fieldprocessing) = YAML::LoadFile($configfile); >+ my ( $preprocess, $postprocess, $fieldprocessing ); >+ if ( -e $configfile ) { >+ ( $preprocess, $postprocess, $fieldprocessing ) = YAML::LoadFile($configfile); > } > > # Preprocessing > eval $preprocess if ($preprocess); > > my $firstpass = 1; >- if ( @$itemnumbers ) { >- for my $itemnumber ( @$itemnumbers) { >+ if (@$itemnumbers) { >+ for my $itemnumber (@$itemnumbers) { > my $biblionumber = GetBiblionumberFromItemnumber $itemnumber; > $output .= marcrecord2csv( $biblionumber, $id, $firstpass, $csv, $fieldprocessing, [$itemnumber] ); > $firstpass = 0; > } >- } else { >+ } >+ else { > foreach my $biblio (@$biblios) { > $output .= marcrecord2csv( $biblio, $id, $firstpass, $csv, $fieldprocessing ); > $firstpass = 0; >@@ -421,15 +444,15 @@ C<$itemnumbers> a list of itemnumbers to export > > =cut > >- > sub marcrecord2csv { >- my ($biblio, $id, $header, $csv, $fieldprocessing, $itemnumbers) = @_; >+ my ( $biblio, $id, $header, $csv, $fieldprocessing, $itemnumbers ) = @_; > my $output; > > # Getting the record > my $record = GetMarcBiblio($biblio); > next unless $record; > C4::Biblio::EmbedItemsInMarcBiblio( $record, $biblio, $itemnumbers ); >+ > # Getting the framework > my $frameworkcode = GetFrameworkCode($biblio); > >@@ -437,130 +460,142 @@ sub marcrecord2csv { > my $profile = GetCsvProfile($id); > > # Getting output encoding >- my $encoding = $profile->{encoding} || 'utf8'; >+ my $encoding = $profile->{encoding} || 'utf8'; >+ > # Getting separators > my $csvseparator = $profile->{csv_separator} || ','; > my $fieldseparator = $profile->{field_separator} || '#'; > my $subfieldseparator = $profile->{subfield_separator} || '|'; > > # TODO: Be more generic (in case we have to handle other protected chars or more separators) >- if ($csvseparator eq '\t') { $csvseparator = "\t" } >- if ($fieldseparator eq '\t') { $fieldseparator = "\t" } >- if ($subfieldseparator eq '\t') { $subfieldseparator = "\t" } >- if ($csvseparator eq '\n') { $csvseparator = "\n" } >- if ($fieldseparator eq '\n') { $fieldseparator = "\n" } >- if ($subfieldseparator eq '\n') { $subfieldseparator = "\n" } >- >- $csv = $csv->encoding_out($encoding) ; >+ if ( $csvseparator eq '\t' ) { $csvseparator = "\t" } >+ if ( $fieldseparator eq '\t' ) { $fieldseparator = "\t" } >+ if ( $subfieldseparator eq '\t' ) { $subfieldseparator = "\t" } >+ if ( $csvseparator eq '\n' ) { $csvseparator = "\n" } >+ if ( $fieldseparator eq '\n' ) { $fieldseparator = "\n" } >+ if ( $subfieldseparator eq '\n' ) { $subfieldseparator = "\n" } >+ >+ $csv = $csv->encoding_out($encoding); > $csv->sep_char($csvseparator); > > # Getting the marcfields > my $marcfieldslist = $profile->{content}; > > # Getting the marcfields as an array >- my @marcfieldsarray = split('\|', $marcfieldslist); >+ my @marcfieldsarray = split( '\|', $marcfieldslist ); > >- # Separating the marcfields from the user-supplied headers >+ # Separating the marcfields from the user-supplied headers > my @marcfields; > foreach (@marcfieldsarray) { >- my @result = split('=', $_); >- if (scalar(@result) == 2) { >- push @marcfields, { header => $result[0], field => $result[1] }; >- } else { >- push @marcfields, { field => $result[0] } >+ my @result = split( '=', $_ ); >+ if ( scalar(@result) == 2 ) { >+ push @marcfields, { header => $result[0], field => $result[1] }; >+ } >+ else { >+ push @marcfields, { field => $result[0] }; > } > } > > # If we have to insert the headers > if ($header) { >- my @marcfieldsheaders; >- my $dbh = C4::Context->dbh; >- >- # For each field or subfield >- foreach (@marcfields) { >- >- my $field = $_->{field}; >- # Remove any blank char that might have unintentionally insered into the tag name >- $field =~ s/\s+//g; >- >- # If we have a user-supplied header, we use it >- if (exists $_->{header}) { >- push @marcfieldsheaders, $_->{header}; >- } else { >- # If not, we get the matching tag name from koha >- if (index($field, '$') > 0) { >- my ($fieldtag, $subfieldtag) = split('\$', $field); >- my $query = "SELECT liblibrarian FROM marc_subfield_structure WHERE tagfield=? AND tagsubfield=?"; >- my $sth = $dbh->prepare($query); >- $sth->execute($fieldtag, $subfieldtag); >- my @results = $sth->fetchrow_array(); >- push @marcfieldsheaders, $results[0]; >- } else { >- my $query = "SELECT liblibrarian FROM marc_tag_structure WHERE tagfield=?"; >- my $sth = $dbh->prepare($query); >- $sth->execute($field); >- my @results = $sth->fetchrow_array(); >- push @marcfieldsheaders, $results[0]; >- } >- } >- } >- $csv->combine(@marcfieldsheaders); >- $output = $csv->string() . "\n"; >+ my @marcfieldsheaders; >+ my $dbh = C4::Context->dbh; >+ >+ # For each field or subfield >+ foreach (@marcfields) { >+ >+ my $field = $_->{field}; >+ >+ # Remove any blank char that might have unintentionally insered into the tag name >+ $field =~ s/\s+//g; >+ >+ # If we have a user-supplied header, we use it >+ if ( exists $_->{header} ) { >+ push @marcfieldsheaders, $_->{header}; >+ } >+ else { >+ # If not, we get the matching tag name from koha >+ if ( index( $field, '$' ) > 0 ) { >+ my ( $fieldtag, $subfieldtag ) = split( '\$', $field ); >+ my $query = "SELECT liblibrarian FROM marc_subfield_structure WHERE tagfield=? AND tagsubfield=?"; >+ my $sth = $dbh->prepare($query); >+ $sth->execute( $fieldtag, $subfieldtag ); >+ my @results = $sth->fetchrow_array(); >+ push @marcfieldsheaders, $results[0]; >+ } >+ else { >+ my $query = "SELECT liblibrarian FROM marc_tag_structure WHERE tagfield=?"; >+ my $sth = $dbh->prepare($query); >+ $sth->execute($field); >+ my @results = $sth->fetchrow_array(); >+ push @marcfieldsheaders, $results[0]; >+ } >+ } >+ } >+ $csv->combine(@marcfieldsheaders); >+ $output = $csv->string() . "\n"; > } > > # For each marcfield to export > my @fieldstab; > foreach (@marcfields) { >- my $marcfield = $_->{field}; >- # If it is a subfield >- if (index($marcfield, '$') > 0) { >- my ($fieldtag, $subfieldtag) = split('\$', $marcfield); >- my @fields = $record->field($fieldtag); >- my @tmpfields; >- >- # For each field >- foreach my $field (@fields) { >- >- # We take every matching subfield >- my @subfields = $field->subfield($subfieldtag); >- foreach my $subfield (@subfields) { >- >- # Getting authorised value >- my $authvalues = GetKohaAuthorisedValuesFromField($fieldtag, $subfieldtag, $frameworkcode, undef); >- push @tmpfields, (defined $authvalues->{$subfield}) ? $authvalues->{$subfield} : $subfield; >- } >- } >- push (@fieldstab, join($subfieldseparator, @tmpfields)); >- # Or a field >- } else { >- my @fields = ($record->field($marcfield)); >- my $authvalues = GetKohaAuthorisedValuesFromField($marcfield, undef, $frameworkcode, undef); >- >- my @valuesarray; >- foreach (@fields) { >- my $value; >- >- # If it is a control field >- if ($_->is_control_field) { >- $value = defined $authvalues->{$_->as_string} ? $authvalues->{$_->as_string} : $_->as_string; >- } else { >- # If it is a field, we gather all subfields, joined by the subfield separator >- my @subvaluesarray; >- my @subfields = $_->subfields; >+ my $marcfield = $_->{field}; >+ >+ # If it is a subfield >+ if ( index( $marcfield, '$' ) > 0 ) { >+ my ( $fieldtag, $subfieldtag ) = split( '\$', $marcfield ); >+ my @fields = $record->field($fieldtag); >+ my @tmpfields; >+ >+ # For each field >+ foreach my $field (@fields) { >+ >+ # We take every matching subfield >+ my @subfields = $field->subfield($subfieldtag); > foreach my $subfield (@subfields) { >- push (@subvaluesarray, defined $authvalues->{$subfield->[1]} ? $authvalues->{$subfield->[1]} : $subfield->[1]); >+ >+ # Getting authorised value >+ my $authvalues = GetKohaAuthorisedValuesFromField( $fieldtag, $subfieldtag, $frameworkcode, undef ); >+ push @tmpfields, ( defined $authvalues->{$subfield} ) ? $authvalues->{$subfield} : $subfield; > } >- $value = join ($subfieldseparator, @subvaluesarray); > } >+ push( @fieldstab, join( $subfieldseparator, @tmpfields ) ); >+ >+ # Or a field >+ } >+ else { >+ my @fields = ( $record->field($marcfield) ); >+ my $authvalues = GetKohaAuthorisedValuesFromField( $marcfield, undef, $frameworkcode, undef ); >+ >+ my @valuesarray; >+ foreach (@fields) { >+ my $value; >+ >+ # If it is a control field >+ if ( $_->is_control_field ) { >+ $value = defined $authvalues->{ $_->as_string } ? $authvalues->{ $_->as_string } : $_->as_string; >+ } >+ else { >+ # If it is a field, we gather all subfields, joined by the subfield separator >+ my @subvaluesarray; >+ my @subfields = $_->subfields; >+ foreach my $subfield (@subfields) { >+ push( @subvaluesarray, >+ defined $authvalues->{ $subfield->[1] } >+ ? $authvalues->{ $subfield->[1] } >+ : $subfield->[1] ); >+ } >+ $value = join( $subfieldseparator, @subvaluesarray ); >+ } > >- # Field processing >- eval $fieldprocessing if ($fieldprocessing); >+ # Field processing >+ eval $fieldprocessing if ($fieldprocessing); > >- push @valuesarray, $value; >+ push @valuesarray, $value; >+ } >+ push( @fieldstab, join( $fieldseparator, @valuesarray ) ); > } >- push (@fieldstab, join($fieldseparator, @valuesarray)); >- } >- }; >+ } > > $csv->combine(@fieldstab); > $output .= $csv->string() . "\n"; >@@ -569,7 +604,6 @@ sub marcrecord2csv { > > } > >- > =head2 changeEncoding - Change the encoding of a record > > my ($error, $newrecord) = changeEncoding($record,$format,$flavour,$to_encoding,$from_encoding); >@@ -595,34 +629,37 @@ FIXME: shouldn't have to convert to and from xml/marc just to change encoding so > =cut > > sub changeEncoding { >- my ($record,$format,$flavour,$to_encoding,$from_encoding) = @_; >- my $newrecord; >- my $error; >- unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; >- unless($to_encoding) {$to_encoding = "UTF-8"}; >- >- # ISO-2709 Record (MARC21 or UNIMARC) >- if (lc($format) =~ /^marc$/o) { >- # if we're converting encoding of an ISO2709 file, we need to roundtrip through XML >- # because MARC::Record doesn't directly provide us with an encoding method >- # It's definitely less than idea and should be fixed eventually - kados >- my $marcxml; # temporary storage of MARCXML scalar >- ($error,$marcxml) = marc2marcxml($record,$to_encoding,$flavour); >- unless ($error) { >- ($error,$newrecord) = marcxml2marc($marcxml,$to_encoding,$flavour); >- } >- >- # MARCXML Record >- } elsif (lc($format) =~ /^marcxml$/o) { # MARCXML Record >- my $marc; >- ($error,$marc) = marcxml2marc($record,$to_encoding,$flavour); >- unless ($error) { >- ($error,$newrecord) = marc2marcxml($record,$to_encoding,$flavour); >- } >- } else { >- $error.="Unsupported record format:".$format; >- } >- return ($error,$newrecord); >+ my ( $record, $format, $flavour, $to_encoding, $from_encoding ) = @_; >+ my $newrecord; >+ my $error; >+ unless ($flavour) { $flavour = C4::Context->preference("marcflavour") } >+ unless ($to_encoding) { $to_encoding = "UTF-8" } >+ >+ # ISO-2709 Record (MARC21 or UNIMARC) >+ if ( lc($format) =~ /^marc$/o ) { >+ >+ # if we're converting encoding of an ISO2709 file, we need to roundtrip through XML >+ # because MARC::Record doesn't directly provide us with an encoding method >+ # It's definitely less than idea and should be fixed eventually - kados >+ my $marcxml; # temporary storage of MARCXML scalar >+ ( $error, $marcxml ) = marc2marcxml( $record, $to_encoding, $flavour ); >+ unless ($error) { >+ ( $error, $newrecord ) = marcxml2marc( $marcxml, $to_encoding, $flavour ); >+ } >+ >+ # MARCXML Record >+ } >+ elsif ( lc($format) =~ /^marcxml$/o ) { # MARCXML Record >+ my $marc; >+ ( $error, $marc ) = marcxml2marc( $record, $to_encoding, $flavour ); >+ unless ($error) { >+ ( $error, $newrecord ) = marc2marcxml( $record, $to_encoding, $flavour ); >+ } >+ } >+ else { >+ $error .= "Unsupported record format:" . $format; >+ } >+ return ( $error, $newrecord ); > } > > =head2 marc2bibtex - Convert from MARC21 and UNIMARC to BibTex >@@ -637,28 +674,28 @@ C<$id> - an id for the BibTex record (might be the biblionumber) > > =cut > >- > sub marc2bibtex { >- my ($record, $id) = @_; >+ my ( $record, $id ) = @_; > my $tex; > my $marcflavour = C4::Context->preference("marcflavour"); > > # Authors > my $author; > my @texauthors; >- my @authorFields = ('100','110','111','700','710','711'); >- @authorFields = ('700','701','702','710','711','721') if ( $marcflavour eq "UNIMARC" ); >+ my @authorFields = ( '100', '110', '111', '700', '710', '711' ); >+ @authorFields = ( '700', '701', '702', '710', '711', '721' ) if ( $marcflavour eq "UNIMARC" ); >+ >+ foreach my $field (@authorFields) { > >- foreach my $field ( @authorFields ) { > # author formatted surname, firstname > my $texauthor = ''; > if ( $marcflavour eq "UNIMARC" ) { >- $texauthor = join ', ', >- ( $record->subfield($field,"a"), $record->subfield($field,"b") ); >- } else { >- $texauthor = $record->subfield($field,"a"); >- } >- push @texauthors, $texauthor if $texauthor; >+ $texauthor = join ', ', ( $record->subfield( $field, "a" ), $record->subfield( $field, "b" ) ); >+ } >+ else { >+ $texauthor = $record->subfield( $field, "a" ); >+ } >+ push @texauthors, $texauthor if $texauthor; > } > $author = join ' and ', @texauthors; > >@@ -674,38 +711,42 @@ sub marc2bibtex { > > # Mandatory > author => $author, >- title => $record->subfield("200", "a") || "", >- editor => $record->subfield("210", "g") || "", >- publisher => $record->subfield("210", "c") || "", >- year => $record->subfield("210", "d") || $record->subfield("210", "h") || "", >+ title => $record->subfield( "200", "a" ) || "", >+ editor => $record->subfield( "210", "g" ) || "", >+ publisher => $record->subfield( "210", "c" ) || "", >+ year => $record->subfield( "210", "d" ) || $record->subfield( "210", "h" ) || "", > > # Optional >- volume => $record->subfield("200", "v") || "", >- series => $record->subfield("225", "a") || "", >- address => $record->subfield("210", "a") || "", >- edition => $record->subfield("205", "a") || "", >- note => $record->subfield("300", "a") || "", >- url => $record->subfield("856", "u") || "" >+ volume => $record->subfield( "200", "v" ) || "", >+ series => $record->subfield( "225", "a" ) || "", >+ address => $record->subfield( "210", "a" ) || "", >+ edition => $record->subfield( "205", "a" ) || "", >+ note => $record->subfield( "300", "a" ) || "", >+ url => $record->subfield( "856", "u" ) || "" > ); >- } else { >+ } >+ else { > > # Marc21 to bibtex array > @bh = ( > > # Mandatory > author => $author, >- title => $record->subfield("245", "a") || "", >- editor => $record->subfield("260", "f") || "", >- publisher => $record->subfield("264", "b") || $record->subfield("260", "b") || "", >- year => $record->subfield("264", "c") || $record->subfield("260", "c") || $record->subfield("260", "g") || "", >+ title => $record->subfield( "245", "a" ) || "", >+ editor => $record->subfield( "260", "f" ) || "", >+ publisher => $record->subfield( "264", "b" ) || $record->subfield( "260", "b" ) || "", >+ year => $record->subfield( "264", "c" ) >+ || $record->subfield( "260", "c" ) >+ || $record->subfield( "260", "g" ) >+ || "", > > # Optional > # unimarc to marc21 specification says not to convert 200$v to marc21 >- series => $record->subfield("490", "a") || "", >- address => $record->subfield("264", "a") || $record->subfield("260", "a") || "", >- edition => $record->subfield("250", "a") || "", >- note => $record->subfield("500", "a") || "", >- url => $record->subfield("856", "u") || "" >+ series => $record->subfield( "490", "a" ) || "", >+ address => $record->subfield( "264", "a" ) || $record->subfield( "260", "a" ) || "", >+ edition => $record->subfield( "250", "a" ) || "", >+ note => $record->subfield( "500", "a" ) || "", >+ url => $record->subfield( "856", "u" ) || "" > ); > } > >@@ -722,7 +763,7 @@ sub marc2bibtex { > > if ( $additional_fields && $additional_fields->{'@'} ) { > my ( $f, $sf ) = split( /\$/, $additional_fields->{'@'} ); >- my ( $type ) = read_field( { record => $record, field => $f, subfield => $sf, field_numbers => [1] } ); >+ my ($type) = read_field( { record => $record, field => $f, subfield => $sf, field_numbers => [1] } ); > > if ($type) { > $tex .= '@' . $type . '{'; >@@ -736,11 +777,11 @@ sub marc2bibtex { > } > > my @elt; >- for ( my $i = 0 ; $i < scalar( @bh ) ; $i = $i + 2 ) { >- next unless $bh[$i+1]; >+ for ( my $i = 0 ; $i < scalar(@bh) ; $i = $i + 2 ) { >+ next unless $bh[ $i + 1 ]; > push @elt, qq|\t$bh[$i] = {$bh[$i+1]}|; > } >- $tex .= join(",\n", $id, @elt); >+ $tex .= join( ",\n", $id, @elt ); > $tex .= "\n"; > > if ($additional_fields) { >@@ -767,7 +808,6 @@ sub marc2bibtex { > return $tex; > } > >- > =head1 INTERNAL FUNCTIONS > > =head2 _entity_encode - Entity-encode an array of strings >@@ -783,17 +823,17 @@ Entity-encode an array of strings > =cut > > sub _entity_encode { >- my @strings = @_; >- my @strings_entity_encoded; >- foreach my $string (@strings) { >- my $nfc_string = NFC($string); >- $nfc_string =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe; >- push @strings_entity_encoded, $nfc_string; >- } >- return @strings_entity_encoded; >+ my @strings = @_; >+ my @strings_entity_encoded; >+ foreach my $string (@strings) { >+ my $nfc_string = NFC($string); >+ $nfc_string =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe; >+ push @strings_entity_encoded, $nfc_string; >+ } >+ return @strings_entity_encoded; > } > >-END { } # module clean-up code here (global destructor) >+END { } # module clean-up code here (global destructor) > 1; > __END__ > >-- >1.7.2.5
You cannot view the attachment while viewing its details because your browser does not support IFRAMEs.
View the attachment on a separate page
.
View Attachment As Diff
View Attachment As Raw
Actions:
View
|
Diff
|
Splinter Review
Attachments on
bug 12357
:
28646
|
28647
|
28648
|
28649
|
28650
|
29291
|
29292
|
29293
|
29294
|
29295
|
29296
|
29297
|
31677
|
31678
|
31679
|
31680
|
33123
|
33124
|
33125
|
33126
|
35485
|
35487
|
35489
|
35826
|
35827
|
35828
|
38602
|
38604
|
39469
|
39471
|
39773
|
39774
|
39775
|
39776
|
39803
|
39804
|
39805
|
39806