From 4fe0888bb264c5ada13f8bbc744ec19af0f8b617 Mon Sep 17 00:00:00 2001 From: Kyle M Hall Date: Fri, 23 Jan 2015 07:24:20 -0500 Subject: [PATCH] Bug 12357 - Tidy Record.pm --- C4/Record.pm | 758 +++++++++++++++++++++++++++++++++------------------------- 1 files changed, 428 insertions(+), 330 deletions(-) diff --git a/C4/Record.pm b/C4/Record.pm index 8f2ad9c..f295864 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,46 @@ 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 + } + 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 +137,78 @@ 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 +226,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 +262,45 @@ 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 = "\n"; - $dcxmlfinal .= "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 = "\n"; + $dcxmlfinal .= ""; - foreach my $element ( $dcxml->elements() ) { - $dcxmlfinal.="<"."dc:".$element->name().">".$element->content()."name().">\n"; + foreach my $element ( $dcxml->elements() ) { + $dcxmlfinal .= + "<" . "dc:" + . $element->name() . ">" + . $element->content() . "name() . ">\n"; } - $dcxmlfinal .= "\n"; - return ($error,$dcxmlfinal); + $dcxmlfinal .= "\n"; + return ( $error, $dcxmlfinal ); } =head2 marc2modsxml - Convert from ISO-2709 to MODS @@ -276,7 +313,8 @@ 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 +327,8 @@ 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 +341,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 +365,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,31 +406,35 @@ 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] ); + $output .= marcrecord2csv( $biblionumber, $id, $firstpass, $csv, + $fieldprocessing, [$itemnumber] ); $firstpass = 0; } - } else { + } + else { foreach my $biblio (@$biblios) { - $output .= marcrecord2csv( $biblio, $id, $firstpass, $csv, $fieldprocessing ); + $output .= marcrecord2csv( $biblio, $id, $firstpass, $csv, + $fieldprocessing ); $firstpass = 0; } } @@ -421,15 +465,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 +481,154 @@ 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" } +# 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) ; + $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 +637,6 @@ sub marcrecord2csv { } - =head2 changeEncoding - Change the encoding of a record my ($error, $newrecord) = changeEncoding($record,$format,$flavour,$to_encoding,$from_encoding); @@ -595,34 +662,39 @@ 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 +709,33 @@ 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,46 +751,60 @@ 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") || "", - - # 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") || "" + 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" ) + || "", + + # 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" ) || "" ); } - my $BibtexExportAdditionalFields = C4::Context->preference('BibtexExportAdditionalFields'); + my $BibtexExportAdditionalFields = + C4::Context->preference('BibtexExportAdditionalFields'); my $additional_fields; if ($BibtexExportAdditionalFields) { $BibtexExportAdditionalFields = "$BibtexExportAdditionalFields\n\n"; - $additional_fields = eval { YAML::Load($BibtexExportAdditionalFields); }; + $additional_fields = + eval { YAML::Load($BibtexExportAdditionalFields); }; if ($@) { warn "Unable to parse BibtexExportAdditionalFields : $@"; $additional_fields = undef; @@ -722,7 +813,14 @@ 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 +834,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) { @@ -754,7 +852,8 @@ sub marc2bibtex { for my $tag (@fields) { my ( $f, $sf ) = split( /\$/, $tag ); - my @values = read_field( { record => $record, field => $f, subfield => $sf } ); + my @values = read_field( + { record => $record, field => $f, subfield => $sf } ); foreach my $v (@values) { $tex .= qq(\t$bibtex_tag = {$v}\n); } @@ -767,7 +866,6 @@ sub marc2bibtex { return $tex; } - =head1 INTERNAL FUNCTIONS =head2 _entity_encode - Entity-encode an array of strings @@ -783,17 +881,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