X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FRecord.pm;h=abc0075f180409735c3f0568222971fd2ef46493;hb=2266733767536ddf47f31821ba87d860c246700f;hp=80f5c47bcb0afdf8f2ba06282b12ab9902ea51cb;hpb=a404384b11d1514692de71acb863dc4dc71b6498;p=koha.git diff --git a/C4/Record.pm b/C4/Record.pm index 80f5c47bcb..abc0075f18 100644 --- a/C4/Record.pm +++ b/C4/Record.pm @@ -1,42 +1,47 @@ package C4::Record; # # Copyright 2006 (C) LibLime -# Joshua Ferraro +# Parts copyright 2010 BibLibre +# Part copyright 2015 Universidad de El Salvador # # This file is part of Koha. # -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. # -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. # -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . # # -use strict;# use warnings; #FIXME: turn off warnings before release +use strict; +#use warnings; FIXME - Bug 2505 # please specify in which methods a given module is used -use MARC::Record; # marc2marcxml, marcxml2marc, html2marc, changeEncoding -use MARC::File::XML; # marc2marcxml, marcxml2marc, html2marcxml, changeEncoding -use MARC::Crosswalk::DublinCore; # marc2dcxml +use MARC::Record; # marc2marcxml, marcxml2marc, changeEncoding +use MARC::File::XML; # marc2marcxml, marcxml2marc, changeEncoding use Biblio::EndnoteStyle; use Unicode::Normalize; # _entity_encode -use XML::LibXSLT; -use XML::LibXML; use C4::Biblio; #marc2bibtex -use C4::Csv; #marc2csv -use Text::CSV; #marc2csv +use C4::Koha; #marc2csv +use C4::XSLT (); +use YAML; #marcrecords2csv +use Template; +use Text::CSV::Encoded; #marc2csv +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.00; @ISA = qw(Exporter); @@ -49,11 +54,9 @@ $VERSION = 3.00; &marcxml2marc &marc2dcxml &marc2modsxml + &marc2madsxml &marc2bibtex &marc2csv - - &html2marcxml - &html2marc &changeEncoding ); @@ -69,32 +72,49 @@ New in Koha 3.x. This module handles all record-related management functions. =head2 marc2marc - Convert from one flavour of ISO-2709 to another -=over 4 - -my ($error,$newmarc) = marc2marc($marc,$to_flavour,$from_flavour,$encoding); + my ($error,$newmarc) = marc2marc($marc,$to_flavour,$from_flavour,$encoding); Returns an ISO-2709 scalar -=back - =cut sub marc2marc { my ($marc,$to_flavour,$from_flavour,$encoding) = @_; - my $error = "Feature not yet implemented\n"; + my $error; + if ($to_flavour =~ m/marcstd/) { + 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 }; + } + 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')) { + push @privatefields, $field; + } 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 { + $error = "Feature not yet implemented\n"; + } return ($error,$marc); } =head2 marc2marcxml - Convert from ISO-2709 to MARCXML -=over 4 - -my ($error,$marcxml) = marc2marcxml($marc,$encoding,$flavour); + my ($error,$marcxml) = marc2marcxml($marc,$encoding,$flavour); Returns a MARCXML scalar -=over 2 - C<$marc> - an ISO-2709 scalar or MARC::Record object C<$encoding> - UTF-8 or MARC-8 [UTF-8] @@ -103,10 +123,6 @@ C<$flavour> - MARC21 or UNIMARC C<$dont_entity_encode> - a flag that instructs marc2marcxml not to entity encode the xml before returning (optional) -=back - -=back - =cut sub marc2marcxml { @@ -173,24 +189,16 @@ sub marc2marcxml { =head2 marcxml2marc - Convert from MARCXML to ISO-2709 -=over 4 - -my ($error,$marc) = marcxml2marc($marcxml,$encoding,$flavour); + my ($error,$marc) = marcxml2marc($marcxml,$encoding,$flavour); Returns an ISO-2709 scalar -=over 2 - C<$marcxml> - a MARCXML record C<$encoding> - UTF-8 or MARC-8 [UTF-8] C<$flavour> - MARC21 or UNIMARC -=back - -=back - =cut sub marcxml2marc { @@ -213,441 +221,448 @@ sub marcxml2marc { =head2 marc2dcxml - Convert from ISO-2709 to Dublin Core -=over 4 - -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"); -=over 2 +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 -=back +C<$biblionumber> - biblionumber for database access -=back +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 =~ /oaidc|srwdc|rdfdc/ ) { + $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 number + my $errstr = $xslt_engine->errstr; # error message + if ( $err ) { + croak "Error when processing $errstr Error number: $err\n"; + } else { + return $output; + } } - $dcxmlfinal .= "\n"; - return ($error,$dcxmlfinal); } -=head2 marc2modsxml - Convert from ISO-2709 to MODS -=over 4 +=head2 marc2modsxml - Convert from ISO-2709 to MODS -my ($error,$modsxml) = marc2modsxml($marc); + my $modsxml = marc2modsxml($marc); Returns a MODS scalar -=back - =cut sub marc2modsxml { - my ($marc) = @_; - # grab the XML, run it through our stylesheet, push it out to the browser - my $xmlrecord = marc2marcxml($marc); - my $xslfile = C4::Context->config('intrahtdocs')."/prog/en/xslt/MARC21slim2MODS3-1.xsl"; - my $parser = XML::LibXML->new(); - my $xslt = XML::LibXSLT->new(); - my $source = $parser->parse_string($xmlrecord); - my $style_doc = $parser->parse_file($xslfile); - my $stylesheet = $xslt->parse_stylesheet($style_doc); - my $results = $stylesheet->transform($source); - my $newxmlrecord = $stylesheet->output_string($results); - return ($newxmlrecord); -} - -sub marc2endnote { my ($marc) = @_; - my $marc_rec_obj = MARC::Record->new_from_usmarc($marc); - my $f260 = $marc_rec_obj->field('260'); - my $f260a = $f260->subfield('a') if $f260; - my $f710 = $marc_rec_obj->field('710'); - my $f710a = $f710->subfield('a') if $f710; - my $f500 = $marc_rec_obj->field('500'); - my $abstract = $f500->subfield('a') if $f500; - 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); - + return _transformWithStylesheet($marc, "/prog/en/xslt/MARC21slim2MODS3-1.xsl"); } -=head2 marc2csv - Convert from UNIMARC to CSV +=head2 marc2madsxml - Convert from ISO-2709 to MADS -=over 4 + my $madsxml = marc2madsxml($marc); -my ($csv) = marc2csv($record, $csvprofileid); +Returns a MADS scalar -Returns a CSV scalar +=cut -=over 2 +sub marc2madsxml { + my ($marc) = @_; + return _transformWithStylesheet($marc, "/prog/en/xslt/MARC21slim2MADS.xsl"); +} -C<$record> - a MARC::Record object +=head2 _transformWithStylesheet - Transform a MARC record with a stylesheet -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) + my $xml = _transformWithStylesheet($marc, $stylesheet) -C<$header> - true if the headers are to be printed (typically at first pass) +Returns the XML scalar result of the transformation. $stylesheet should +contain the path to a stylesheet under intrahtdocs. -=back +=cut -=back +sub _transformWithStylesheet { + 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); +} -=cut +sub marc2endnote { + my ($marc) = @_; + my $marc_rec_obj = MARC::Record->new_from_usmarc($marc); + my ( $abstract, $f260a, $f710a ); + my $f260 = $marc_rec_obj->field('260'); + if ($f260) { + $f260a = $f260->subfield('a') if $f260; + } + my $f710 = $marc_rec_obj->field('710'); + if ($f710) { + $f710a = $f710->subfield('a'); + } + my $f500 = $marc_rec_obj->field('500'); + 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); +} -sub marc2csv { - my ($record, $id, $header) = @_; - my $output; +=head2 marc2csv - Convert several records from UNIMARC to CSV - # Get the information about the csv profile - my $profile = GetCsvProfile($id); + my ($csv) = marc2csv($biblios, $csvprofileid, $itemnumbers); - # Getting separators - my $csvseparator = $profile->{csv_separator} || ','; - my $fieldseparator = $profile->{field_separator} || '#'; - my $subfieldseparator = $profile->{subfield_separator} || '|'; +Pre and postprocessing can be done through a YAML file - # 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" } +Returns a CSV scalar - # Init CSV - my $csv = Text::CSV->new({ sep_char => $csvseparator }); +C<$biblio> - a list of biblionumbers - # Getting the marcfields - my $marcfieldslist = $profile->{marcfields}; +C<$csvprofileid> - the id of the CSV profile to use for the export (see export_format.export_format_id) - # Getting the marcfields as an array - my @marcfieldsarray = split('\|', $marcfieldslist); +C<$itemnumbers> - a list of itemnumbers to export - # Separating the marcfields from the 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] } - } +=cut + +sub marc2csv { + 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); } - # 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}; - - # If we have a user-supplied header, we use it - if (exists $_->{header}) { - push @marcfieldsheaders, $_->{header}; - } else { -warn "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(); -warn "subfield $fieldtag, $subfieldtag"; - 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(); -warn "field $results[0]"; - push @marcfieldsheaders, $results[0]; - } - } - } - $csv->combine(@marcfieldsheaders); - $output = $csv->string() . "\n"; + # Preprocessing + eval $preprocess if ($preprocess); + + my $firstpass = 1; + if ( @$itemnumbers ) { + for my $itemnumber ( @$itemnumbers) { + my $biblionumber = GetBiblionumberFromItemnumber $itemnumber; + $output .= marcrecord2csv( $biblionumber, $id, $firstpass, $csv, $fieldprocessing, [$itemnumber] ); + $firstpass = 0; + } + } else { + foreach my $biblio (@$biblios) { + $output .= marcrecord2csv( $biblio, $id, $firstpass, $csv, $fieldprocessing ); + $firstpass = 0; + } } - # 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) { - push @tmpfields, $subfield; - } - } - push (@fieldstab, join($subfieldseparator, @tmpfields)); - # Or a field - } else { - my @fields = ($record->field($marcfield)); - push (@fieldstab, join($fieldseparator, map($_->as_string(), @fields))); - } - }; + # Postprocessing + eval $postprocess if ($postprocess); - $csv->combine(@fieldstab); - $output .= $csv->string() . "\n"; - return $output; - } +=head2 marcrecord2csv - Convert a single record from UNIMARC to CSV -=head2 html2marcxml + my ($csv) = marcrecord2csv($biblio, $csvprofileid, $header); -=over 4 +Returns a CSV scalar -my ($error,$marcxml) = html2marcxml($tags,$subfields,$values,$indicator,$ind_tag); +C<$biblio> - a biblionumber -Returns a MARCXML scalar +C<$csvprofileid> - the id of the CSV profile to use for the export (see export_format.export_format_id) -this is used in addbiblio.pl and additem.pl to build the MARCXML record from -the form submission. +C<$header> - true if the headers are to be printed (typically at first pass) -FIXME: this could use some better code documentation +C<$csv> - an already initialised Text::CSV object -=back +C<$fieldprocessing> -=cut +C<$itemnumbers> a list of itemnumbers to export -sub html2marcxml { - my ($tags,$subfields,$values,$indicator,$ind_tag) = @_; - my $error; - # add the header info - my $marcxml= MARC::File::XML::header(C4::Context->preference('TemplateEncoding'),C4::Context->preference('marcflavour')); - - # some flags used to figure out where in the record we are - my $prevvalue; - my $prevtag=-1; - my $first=1; - my $j = -1; - - # handle characters that would cause the parser to choke FIXME: is there a more elegant solution? - for (my $i=0;$i<=@$tags;$i++){ - @$values[$i] =~ s/&/&/g; - @$values[$i] =~ s//>/g; - @$values[$i] =~ s/"/"/g; - @$values[$i] =~ s/'/'/g; - - if ((@$tags[$i] ne $prevtag)){ - $j++ unless (@$tags[$i] eq ""); - #warn "IND:".substr(@$indicator[$j],0,1).substr(@$indicator[$j],1,1)." ".@$tags[$i]; - if (!$first){ - $marcxml.="\n"; - if ((@$tags[$i] > 10) && (@$values[$i] ne "")){ - my $ind1 = substr(@$indicator[$j],0,1); - my $ind2 = substr(@$indicator[$j],1,1); - $marcxml.="\n"; - $marcxml.="@$values[$i]\n"; - $first=0; - } else { - $first=1; - } - } else { - if (@$values[$i] ne "") { - # handle the leader - if (@$tags[$i] eq "000") { - $marcxml.="@$values[$i]\n"; - $first=1; - # rest of the fixed fields - } elsif (@$tags[$i] lt '010') { # don't compare numerically 010 == 8 - $marcxml.="@$values[$i]\n"; - $first=1; - } else { - my $ind1 = substr(@$indicator[$j],0,1); - my $ind2 = substr(@$indicator[$j],1,1); - $marcxml.="\n"; - $marcxml.="@$values[$i]\n"; - $first=0; - } - } - } - } else { # @$tags[$i] eq $prevtag - if (@$values[$i] eq "") { - } else { - if ($first){ - my $ind1 = substr(@$indicator[$j],0,1); - my $ind2 = substr(@$indicator[$j],1,1); - $marcxml.="\n"; - $first=0; - } - $marcxml.="@$values[$i]\n"; - } - } - $prevtag = @$tags[$i]; - } - $marcxml.= MARC::File::XML::footer(); - #warn $marcxml; - return ($error,$marcxml); -} +=cut -=head2 html2marc +sub marcrecord2csv { + my ($biblio, $id, $header, $csv, $fieldprocessing, $itemnumbers) = @_; + my $output; -=over 4 + # Getting the record + my $record = GetMarcBiblio($biblio); + return unless $record; + C4::Biblio::EmbedItemsInMarcBiblio( $record, $biblio, $itemnumbers ); + # Getting the framework + my $frameworkcode = GetFrameworkCode($biblio); -Probably best to avoid using this ... it has some rather striking problems: + # Getting information about the csv profile + my $profile = Koha::CsvProfiles->find($id); -=over 2 + # Getting output encoding + my $encoding = $profile->encoding || 'utf8'; + # Getting separators + my $csvseparator = $profile->csv_separator || ','; + my $fieldseparator = $profile->field_separator || '#'; + my $subfieldseparator = $profile->subfield_separator || '|'; -* saves blank subfields + # 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" } -* subfield order is hardcoded to always start with 'a' for repeatable tags (because it is hardcoded in the addfield routine). + $csv = $csv->encoding_out($encoding) ; + $csv->sep_char($csvseparator); -* 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). + # Getting the marcfields + my $marcfieldslist = $profile->content; -* the underlying routines didn't support subfield reordering or subfield repeatability. + # Getting the marcfields as an array + my @marcfieldsarray = split('\|', $marcfieldslist); -=back + # Separating the marcfields from the user-supplied headers + my @csv_structures; + foreach (@marcfieldsarray) { + my @result = split('=', $_, 2); + my $content = ( @result == 2 ) + ? $result[1] + : $result[0]; + my @fields; + while ( $content =~ m|(\d{3})\$?(.)?|g ) { + my $fieldtag = $1; + my $subfieldtag = $2 || undef; + push @fields, { fieldtag => $fieldtag, subfieldtag => $subfieldtag }; + } + if ( @result == 2) { + push @csv_structures, { header => $result[0], content => $content, fields => \@fields }; + } else { + push @csv_structures, { content => $content, fields => \@fields } + } + } -I've left it in here because it could be useful if someone took the time to fix it. -- kados + my ( @marcfieldsheaders, @csv_rows ); + my $dbh = C4::Context->dbh; -=back + my $field_list; + for my $field ( $record->fields ) { + my $fieldtag = $field->tag; + my $values; + if ( $field->is_control_field ) { + $values = $field->data(); + } else { + $values->{indicator}{1} = $field->indicator(1); + $values->{indicator}{2} = $field->indicator(2); + for my $subfield ( $field->subfields ) { + my $subfieldtag = $subfield->[0]; + my $value = $subfield->[1]; + push @{ $values->{$subfieldtag} }, $value; + } + } + # We force the key as an integer (trick for 00X and OXX fields) + push @{ $field_list->{fields}{0+$fieldtag} }, $values; + } -=cut + # For each field or subfield + foreach my $csv_structure (@csv_structures) { + my @field_values; + my $tags = $csv_structure->{fields}; + my $content = $csv_structure->{content}; -sub html2marc { - my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_; - my $prevtag = -1; - my $record = MARC::Record->new(); -# my %subfieldlist=(); - my $prevvalue; # if tag <10 - my $field; # if tag >=10 - for (my $i=0; $i< @$rtags; $i++) { - # rebuild MARC::Record -# warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": "; - if (@$rtags[$i] ne $prevtag) { - if ($prevtag < 10) { - if ($prevvalue) { - if (($prevtag ne '000') && ($prevvalue ne "")) { - $record->add_fields((sprintf "%03s",$prevtag),$prevvalue); - } elsif ($prevvalue ne ""){ - $record->leader($prevvalue); - } - } + if ( $header ) { + # If we have a user-supplied header, we use it + if ( exists $csv_structure->{header} ) { + push @marcfieldsheaders, $csv_structure->{header}; } else { - if (($field) && ($field ne "")) { - $record->add_fields($field); + # If not, we get the matching tag name from koha + my $tag = $tags->[0]; + if ( $tag->{subfieldtag} ) { + my $query = "SELECT liblibrarian FROM marc_subfield_structure WHERE tagfield=? AND tagsubfield=?"; + my @results = $dbh->selectrow_array( $query, {}, $tag->{fieldtag}, $tag->{subfieldtag} ); + push @marcfieldsheaders, $results[0]; + } else { + my $query = "SELECT liblibrarian FROM marc_tag_structure WHERE tagfield=?"; + my @results = $dbh->selectrow_array( $query, {}, $tag->{fieldtag} ); + push @marcfieldsheaders, $results[0]; } } - $indicators{@$rtags[$i]}.=' '; - # skip blank tags, I hope this works - if (@$rtags[$i] eq ''){ - $prevtag = @$rtags[$i]; - undef $field; - next; - } - if (@$rtags[$i] <10) { - $prevvalue= @$rvalues[$i]; - undef $field; - } else { - undef $prevvalue; - if (@$rvalues[$i] eq "") { - undef $field; + } + + # TT tags exist + if ( $content =~ m|\[\%.*\%\]| ) { + my $tt = Template->new(); + my $template = $content; + my $vars; + # Replace 00X and 0XX with X or XX + $content =~ s|fields.00(\d)|fields.$1|g; + $content =~ s|fields.0(\d{2})|fields.$1|g; + my $tt_output; + $tt->process( \$content, $field_list, \$tt_output ); + push @csv_rows, $tt_output; + } else { + for my $tag ( @$tags ) { + my @fields = $record->field( $tag->{fieldtag} ); + # 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) { + push @loop_values, (defined $av_description_mapping->{$subfield}) ? $av_description_mapping->{$subfield} : $subfield; + } + } + + # Or a field } else { - $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]); + 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; + + # If it is a control field + if ($field->is_control_field) { + $value = defined $authvalues->{$field->as_string} ? $authvalues->{$field->as_string} : $field->as_string; + } else { + # If it is a field, we gather all subfields, joined by the subfield separator + my @subvaluesarray; + my @subfields = $field->subfields; + foreach my $subfield (@subfields) { + push (@subvaluesarray, defined $authvalues->{$subfield->[1]} ? $authvalues->{$subfield->[1]} : $subfield->[1]); + } + $value = join ($subfieldseparator, @subvaluesarray); + } + + # 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); + + push @loop_values, $value; + } + } -# warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted; + push @field_values, { + fieldtag => $tag->{fieldtag}, + subfieldtag => $tag->{subfieldtag}, + values => \@loop_values, + }; } - $prevtag = @$rtags[$i]; - } else { - if (@$rtags[$i] <10) { - $prevvalue=@$rvalues[$i]; - } else { - if (length(@$rvalues[$i])>0) { - $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]); -# warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted; + for my $field_value ( @field_values ) { + if ( $field_value->{subfieldtag} ) { + push @csv_rows, join( $subfieldseparator, @{ $field_value->{values} } ); + } else { + push @csv_rows, join( $fieldseparator, @{ $field_value->{values} } ); } } - $prevtag= @$rtags[$i]; } } - #} - # the last has not been included inside the loop... do it now ! - #use Data::Dumper; - #warn Dumper($field->{_subfields}); - $record->add_fields($field) if (($field) && $field ne ""); - #warn "HTML2MARC=".$record->as_formatted; - return $record; + + + if ( $header ) { + $csv->combine(@marcfieldsheaders); + $output = $csv->string() . "\n"; + } + $csv->combine(@csv_rows); + $output .= $csv->string() . "\n"; + + return $output; + } -=head2 changeEncoding - Change the encoding of a record -=over 4 +=head2 changeEncoding - Change the encoding of a record -my ($error, $newrecord) = changeEncoding($record,$format,$flavour,$to_encoding,$from_encoding); + my ($error, $newrecord) = changeEncoding($record,$format,$flavour,$to_encoding,$from_encoding); Changes the encoding of a record -=over 2 - C<$record> - the record itself can be in ISO-2709, a MARC::Record object, or MARCXML for now (required) C<$format> - MARC or MARCXML (required) @@ -658,16 +673,12 @@ C<$to_encoding> - the encoding you want the record to end up in (optional) [UTF- 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) -=back - FIXME: the from_encoding doesn't work yet FIXME: better handling for UNIMARC, it should allow management of 100 field 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 -=back - =cut sub changeEncoding { @@ -676,7 +687,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 @@ -687,7 +698,7 @@ sub changeEncoding { unless ($error) { ($error,$newrecord) = marcxml2marc($marcxml,$to_encoding,$flavour); } - + # MARCXML Record } elsif (lc($format) =~ /^marcxml$/o) { # MARCXML Record my $marc; @@ -703,87 +714,145 @@ sub changeEncoding { =head2 marc2bibtex - Convert from MARC21 and UNIMARC to BibTex -=over 4 - -my ($bibtex) = marc2bibtex($record, $id); + my ($bibtex) = marc2bibtex($record, $id); Returns a BibTex scalar -=over 2 - C<$record> - a MARC::Record object C<$id> - an id for the BibTex record (might be the biblionumber) -=back - -=back - =cut sub marc2bibtex { my ($record, $id) = @_; my $tex; + my $marcflavour = C4::Context->preference("marcflavour"); # Authors - my $marcauthors = GetMarcAuthors($record,C4::Context->preference("marcflavour")); my $author; - for my $authors ( map { map { @$_ } values %$_ } @$marcauthors ) { - $author .= " and " if ($author && $$authors{value}); - $author .= $$authors{value} if ($$authors{value}); + my @texauthors; + my @authorFields = ('100','110','111','700','710','711'); + @authorFields = ('700','701','702','710','711','721') if ( $marcflavour eq "UNIMARC" ); + + 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; } - - # Defining the conversion hash according to the marcflavour - my %bh; - if (C4::Context->preference("marcflavour") eq "UNIMARC") { - - # FIXME, TODO : handle repeatable fields - # TODO : handle more types of documents - - # Unimarc to bibtex hash - %bh = ( - - # 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") || "", - - # 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") || "" - ); + $author = join ' and ', @texauthors; + + # Defining the conversion array according to the marcflavour + my @bh; + if ( $marcflavour eq "UNIMARC" ) { + + # FIXME, TODO : handle repeatable fields + # TODO : handle more types of documents + + # Unimarc to bibtex array + @bh = ( + + # 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") || "", + + # 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") || "" + ); } else { - # Marc21 to bibtex hash - %bh = ( - - # Mandatory - author => $author, - title => $record->subfield("245", "a") || "", - editor => $record->subfield("260", "f") || "", - publisher => $record->subfield("260", "b") || "", - year => $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("260", "a") || "", - edition => $record->subfield("250", "a") || "", - note => $record->subfield("500", "a") || "", - url => $record->subfield("856", "u") || "" - ); + # 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") || "" + ); + } + + 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; + } } - $tex .= "\@book{"; - $tex .= join(",\n", $id, map { $bh{$_} ? qq(\t$_ = "$bh{$_}") : () } keys %bh); - $tex .= "\n}\n"; + 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); + + 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; } @@ -793,18 +862,14 @@ sub marc2bibtex { =head2 _entity_encode - Entity-encode an array of strings -=over 4 - -my ($entity_encoded_string) = _entity_encode($string); + my ($entity_encoded_string) = _entity_encode($string); or -my (@entity_encoded_strings) = _entity_encode(@strings); + my (@entity_encoded_strings) = _entity_encode(@strings); Entity-encode an array of strings -=back - =cut sub _entity_encode {