X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FRecord.pm;h=cde523f015ada6574614f94d0cb47c9a43ff0f10;hb=3f7b2fa41898f59ce39d1725f8dfe6001095f796;hp=7ca1f98d78d8b5d133f9d5408e84d0d2e23df574;hpb=a04e8a8bfcff1d6c8e09a98086f108fac76d6e2d;p=koha.git diff --git a/C4/Record.pm b/C4/Record.pm index 7ca1f98d78..cde523f015 100644 --- a/C4/Record.pm +++ b/C4/Record.pm @@ -2,6 +2,7 @@ package C4::Record; # # Copyright 2006 (C) LibLime # Parts copyright 2010 BibLibre +# Part copyright 2015 Universidad de El Salvador # # This file is part of Koha. # @@ -25,21 +26,23 @@ use strict; # 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 Biblio::EndnoteStyle; use Unicode::Normalize; # _entity_encode use C4::Biblio; #marc2bibtex -use C4::Csv; #marc2csv use C4::Koha; #marc2csv use C4::XSLT (); use YAML; #marcrecords2csv use Template; use Text::CSV::Encoded; #marc2csv +use Koha::Items; +use Koha::SimpleMARC qw(read_field); +use Koha::XSLT_Handler; +use Koha::CsvProfiles; +use Koha::AuthorisedValues; +use Carp; -use vars qw($VERSION @ISA @EXPORT); +use vars qw(@ISA @EXPORT); -# set the version for version checking -$VERSION = 3.07.00.049; @ISA = qw(Exporter); @@ -219,51 +222,91 @@ sub marcxml2marc { =head2 marc2dcxml - Convert from ISO-2709 to Dublin Core - my ($error,$dcxml) = marc2dcxml($marc,$qualified); + my dcxml = marc2dcxml ($marc, $xml, $biblionumber, $format); -Returns a DublinCore::Record object, will eventually return a Dublin Core scalar +EXAMPLE -FIXME: should return actual XML, not just an object + my dcxml = marc2dcxml (undef, undef, 1, "oaidc"); + +Convert MARC or MARCXML to Dublin Core metadata (XSLT Transformation), +optionally can get an XML directly from biblio_metadata +without item information. This method take into consideration the syspref +'marcflavour' (UNIMARC, MARC21 and NORMARC). +Return an XML file with the format defined in C<$format> C<$marc> - an ISO-2709 scalar or MARC::Record object -C<$qualified> - specify whether qualified Dublin Core should be used in the input or output [0] +C<$xml> - a MARCXML file + +C<$biblionumber> - biblionumber for database access + +C<$format> - accept three type of DC formats (oaidc, srwdc, and rdfdc ) =cut sub marc2dcxml { - 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 - $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 + my ( $marc, $xml, $biblionumber, $format ) = @_; + + # global variables + my ( $marcxml, $record, $output ); + + # set the default path for intranet xslts + # differents xslts to process (OAIDC, SRWDC and RDFDC) + my $xsl = C4::Context->config('intrahtdocs') . '/prog/en/xslt/' . + C4::Context->preference('marcflavour') . 'slim2' . uc ( $format ) . '.xsl'; + + if ( defined $marc ) { + # no need to catch errors or warnings marc2marcxml do it instead + $marcxml = C4::Record::marc2marcxml( $marc ); + } elsif ( not defined $xml and defined $biblionumber ) { + # get MARCXML biblio directly without item information + $marcxml = C4::Biblio::GetXmlBiblio( $biblionumber ); + } else { + $marcxml = $xml; + } - # 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"; + # only proceed if MARC21 or UNIMARC; else clause is executed if marcflavour set it to NORMARC + # generate MARC::Record object to see if not a marcxml record + unless ( C4::Context->preference('marcflavour') eq 'NORMARC' ) { + eval { $record = MARC::Record->new_from_xml( + $marcxml, + 'UTF-8', + C4::Context->preference('marcflavour') + ); + }; + } else { + eval { $record = MARC::Record->new_from_xml( + $marcxml, + 'UTF-8', + 'MARC21' + ); + }; + } + + # conversion to MARC::Record object failed + if ( $@ ) { + croak "Creation of MARC::Record object failed."; + } elsif ( $record->warnings() ) { + carp "Warnings encountered while processing ISO-2709 record.\n"; + my @warnings = $record->warnings(); + foreach my $warn (@warnings) { + carp "\t". $warn; + }; + } elsif ( $record =~ /^MARC::Record/ ) { # if OK makes xslt transformation + my $xslt_engine = Koha::XSLT_Handler->new; + if ( $format =~ /^(dc|oaidc|srwdc|rdfdc)$/i ) { + $output = $xslt_engine->transform( $marcxml, $xsl ); + } else { + croak "The format argument ($format) not accepted.\n" . + "Please pass a valid format (oaidc, srwdc, or rdfdc)\n"; + } + my $err = $xslt_engine->err; # error code + if ( $err ) { + croak "Error $err while processing\n"; + } else { + return $output; + } } - $dcxmlfinal .= "\n"; - return ($error,$dcxmlfinal); } =head2 marc2modsxml - Convert from ISO-2709 to MODS @@ -325,28 +368,28 @@ 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); + } =head2 marc2csv - Convert several records from UNIMARC to CSV @@ -359,7 +402,7 @@ Returns a CSV scalar C<$biblio> - a list of biblionumbers -C<$csvprofileid> - the id of the CSV profile to use for the export (see export_format.export_format_id and the GetCsvProfiles function in C4::Csv) +C<$csvprofileid> - the id of the CSV profile to use for the export (see export_format.export_format_id) C<$itemnumbers> - a list of itemnumbers to export @@ -379,12 +422,13 @@ sub marc2csv { } # Preprocessing - eval {$preprocess} if ($preprocess); + eval $preprocess if ($preprocess); my $firstpass = 1; if ( @$itemnumbers ) { for my $itemnumber ( @$itemnumbers) { - my $biblionumber = GetBiblionumberFromItemnumber $itemnumber; + my $item = Koha::Items->find( $itemnumber ); + my $biblionumber = $item->biblio->biblionumber; $output .= marcrecord2csv( $biblionumber, $id, $firstpass, $csv, $fieldprocessing, [$itemnumber] ); $firstpass = 0; } @@ -396,7 +440,7 @@ sub marc2csv { } # Postprocessing - eval {$postprocess} if ($postprocess); + eval $postprocess if ($postprocess); return $output; } @@ -409,7 +453,7 @@ Returns a CSV scalar C<$biblio> - a biblionumber -C<$csvprofileid> - the id of the CSV profile to use for the export (see export_format.export_format_id and the GetCsvProfiles function in C4::Csv) +C<$csvprofileid> - the id of the CSV profile to use for the export (see export_format.export_format_id) C<$header> - true if the headers are to be printed (typically at first pass) @@ -426,21 +470,24 @@ sub marcrecord2csv { my $output; # Getting the record - my $record = GetMarcBiblio($biblio); + my $record = GetMarcBiblio({ biblionumber => $biblio }); return unless $record; - C4::Biblio::EmbedItemsInMarcBiblio( $record, $biblio, $itemnumbers ); + C4::Biblio::EmbedItemsInMarcBiblio({ + marc_record => $record, + biblionumber => $biblio, + item_numbers => $itemnumbers }); # Getting the framework my $frameworkcode = GetFrameworkCode($biblio); # Getting information about the csv profile - my $profile = GetCsvProfile($id); + my $profile = Koha::CsvProfiles->find($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} || '|'; + 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" } @@ -454,7 +501,7 @@ sub marcrecord2csv { $csv->sep_char($csvseparator); # Getting the marcfields - my $marcfieldslist = $profile->{content}; + my $marcfieldslist = $profile->content; # Getting the marcfields as an array my @marcfieldsarray = split('\|', $marcfieldslist); @@ -543,18 +590,22 @@ sub marcrecord2csv { # If it is a subfield my @loop_values; if ( $tag->{subfieldtag} ) { + my $av = Koha::AuthorisedValues->search_by_marc_field({ frameworkcode => $frameworkcode, tagfield => $tag->{fieldtag}, tagsubfield => $tag->{subfieldtag}, }); + $av = $av->count ? $av->unblessed : []; + my $av_description_mapping = { map { ( $_->{authorised_value} => $_->{lib} ) } @$av }; # For each field foreach my $field (@fields) { my @subfields = $field->subfield( $tag->{subfieldtag} ); foreach my $subfield (@subfields) { - my $authvalues = GetKohaAuthorisedValuesFromField( $tag->{fieldtag}, $tag->{subfieldtag}, $frameworkcode, undef); - push @loop_values, (defined $authvalues->{$subfield}) ? $authvalues->{$subfield} : $subfield; + push @loop_values, (defined $av_description_mapping->{$subfield}) ? $av_description_mapping->{$subfield} : $subfield; } } # Or a field } else { - my $authvalues = GetKohaAuthorisedValuesFromField( $tag->{fieldtag}, undef, $frameworkcode, undef); + my $av = Koha::AuthorisedValues->search_by_marc_field({ frameworkcode => $frameworkcode, tagfield => $tag->{fieldtag}, }); + $av = $av->count ? $av->unblessed : []; + my $authvalues = { map { ( $_->{authorised_value} => $_->{lib} ) } @$av }; foreach my $field ( @fields ) { my $value; @@ -575,7 +626,7 @@ sub marcrecord2csv { # Field processing my $marcfield = $tag->{fieldtag}; # This line fixes a retrocompatibility concern # The "processing" could be based on the $marcfield variable. - eval {$fieldprocessing} if ($fieldprocessing); + eval $fieldprocessing if ($fieldprocessing); push @loop_values, $value; } @@ -640,7 +691,7 @@ sub changeEncoding { 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 @@ -651,7 +702,7 @@ sub changeEncoding { unless ($error) { ($error,$newrecord) = marcxml2marc($marcxml,$to_encoding,$flavour); } - + # MARCXML Record } elsif (lc($format) =~ /^marcxml$/o) { # MARCXML Record my $marc; @@ -749,14 +800,63 @@ sub marc2bibtex { ); } - $tex .= "\@book{"; + my $BibtexExportAdditionalFields = C4::Context->preference('BibtexExportAdditionalFields'); + my $additional_fields; + if ($BibtexExportAdditionalFields) { + $BibtexExportAdditionalFields = "$BibtexExportAdditionalFields\n\n"; + $additional_fields = eval { YAML::Load($BibtexExportAdditionalFields); }; + if ($@) { + warn "Unable to parse BibtexExportAdditionalFields : $@"; + $additional_fields = undef; + } + } + + if ( $additional_fields && $additional_fields->{'@'} ) { + my ( $f, $sf ) = split( /\$/, $additional_fields->{'@'} ); + my ( $type ) = read_field( { record => $record, field => $f, subfield => $sf, field_numbers => [1] } ); + + if ($type) { + $tex .= '@' . $type . '{'; + } + else { + $tex .= "\@book{"; + } + } + else { + $tex .= "\@book{"; + } + my @elt; 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 .= "\n}\n"; + + if ($additional_fields) { + $tex .= ",\n"; + foreach my $bibtex_tag ( keys %$additional_fields ) { + next if $bibtex_tag eq '@'; + + my @fields = + ref( $additional_fields->{$bibtex_tag} ) eq 'ARRAY' + ? @{ $additional_fields->{$bibtex_tag} } + : $additional_fields->{$bibtex_tag}; + + for my $tag (@fields) { + my ( $f, $sf ) = split( /\$/, $tag ); + my @values = read_field( { record => $record, field => $f, subfield => $sf } ); + foreach my $v (@values) { + $tex .= qq(\t$bibtex_tag = {$v}\n); + } + } + } + } + else { + $tex .= "\n"; + } + + $tex .= "}\n"; return $tex; }