X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;ds=sidebyside;f=C4%2FRecord.pm;h=be1912c0d8cab0f8b7156f6be4f40b236c82c60d;hb=f531af3b132d963577165930fe120872845adc54;hp=e9068507aaaef8cb159f8cefefade72bed3ca837;hpb=5900dfff9a455bbb60b33919faa9299843c42fd3;p=koha.git diff --git a/C4/Record.pm b/C4/Record.pm index e9068507aa..be1912c0d8 100644 --- a/C4/Record.pm +++ b/C4/Record.pm @@ -39,7 +39,7 @@ use Text::CSV::Encoded; #marc2csv use vars qw($VERSION @ISA @EXPORT); # set the version for version checking -$VERSION = 3.00; +$VERSION = 3.07.00.049; @ISA = qw(Exporter); @@ -52,6 +52,7 @@ $VERSION = 3.00; &marcxml2marc &marc2dcxml &marc2modsxml + &marc2madsxml &marc2bibtex &marc2csv &changeEncoding @@ -77,7 +78,32 @@ Returns an ISO-2709 scalar 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); } @@ -242,25 +268,52 @@ sub marc2dcxml { =head2 marc2modsxml - Convert from ISO-2709 to MODS - my ($error,$modsxml) = marc2modsxml($marc); + my $modsxml = marc2modsxml($marc); Returns a MODS scalar =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); + my ($marc) = @_; + return _transformWithStylesheet($marc, "/prog/en/xslt/MARC21slim2MODS3-1.xsl"); +} + +=head2 marc2madsxml - Convert from ISO-2709 to MADS + + my $madsxml = marc2madsxml($marc); + +Returns a MADS scalar + +=cut + +sub marc2madsxml { + my ($marc) = @_; + return _transformWithStylesheet($marc, "/prog/en/xslt/MARC21slim2MADS.xsl"); +} + +=head2 _transformWithStylesheet - Transform a MARC record with a stylesheet + + my $xml = _transformWithStylesheet($marc, $stylesheet) + +Returns the XML scalar result of the transformation. $stylesheet should +contain the path to a stylesheet under intrahtdocs. + +=cut + +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; + 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 { @@ -305,7 +358,7 @@ sub marc2endnote { =head2 marc2csv - Convert several records from UNIMARC to CSV - my ($csv) = marc2csv($biblios, $csvprofileid); + my ($csv) = marc2csv($biblios, $csvprofileid, $itemnumbers); Pre and postprocessing can be done through a YAML file @@ -315,10 +368,12 @@ 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<$itemnumbers> - a list of itemnumbers to export + =cut sub marc2csv { - my ($biblios, $id) = @_; + my ($biblios, $id, $itemnumbers) = @_; my $output; my $csv = Text::CSV::Encoded->new(); @@ -333,9 +388,17 @@ sub marc2csv { eval $preprocess if ($preprocess); my $firstpass = 1; - foreach my $biblio (@$biblios) { - $output .= marcrecord2csv($biblio, $id, $firstpass, $csv, $fieldprocessing) ; - $firstpass = 0; + 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; + } } # Postprocessing @@ -358,16 +421,21 @@ C<$header> - true if the headers are to be printed (typically at first pass) C<$csv> - an already initialised Text::CSV object +C<$fieldprocessing> + +C<$itemnumbers> a list of itemnumbers to export + =cut sub marcrecord2csv { - my ($biblio, $id, $header, $csv, $fieldprocessing) = @_; + my ($biblio, $id, $header, $csv, $fieldprocessing, $itemnumbers) = @_; my $output; # Getting the record - my $record = GetMarcBiblio($biblio, 1); + my $record = GetMarcBiblio($biblio); next unless $record; + C4::Biblio::EmbedItemsInMarcBiblio( $record, $biblio, $itemnumbers ); # Getting the framework my $frameworkcode = GetFrameworkCode($biblio); @@ -474,18 +542,28 @@ sub marcrecord2csv { my @fields = ($record->field($marcfield)); my $authvalues = GetKohaAuthorisedValuesFromField($marcfield, undef, $frameworkcode, undef); - my @valuesarray; - foreach (@fields) { - my $value; - - # Getting authorised value - $value = defined $authvalues->{$_->as_string} ? $authvalues->{$_->as_string} : $_->as_string; - - # Field processing - eval $fieldprocessing if ($fieldprocessing); - - push @valuesarray, $value; - } + 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); + + push @valuesarray, $value; + } push (@fieldstab, join($fieldseparator, @valuesarray)); } }; @@ -569,18 +647,40 @@ C<$id> - an id for the BibTex record (might be the biblionumber) 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 ( $mintag, $maxtag, $fields_filter ); + if ( $marcflavour eq "UNIMARC" ) { + $mintag = "700"; + $maxtag = "712"; + $fields_filter = '7..'; + } + else { + $mintag = "700"; + $maxtag = "720"; + $fields_filter = '7..'; + } + foreach my $field ( $record->field($fields_filter) ) { + next unless $field->tag() >= $mintag && $field->tag() <= $maxtag; + # author formatted surname, firstname + my $texauthor = ''; + if ( $marcflavour eq "UNIMARC" ) { + $texauthor = join ', ', + ( $field->subfield('a'), $field->subfield('b') ); + } + else { + $texauthor = $field->subfield('a'); + } + push @texauthors, $texauthor if $texauthor; } + $author = join ' and ', @texauthors; # Defining the conversion hash according to the marcflavour my %bh; - if (C4::Context->preference("marcflavour") eq "UNIMARC") { + if ( $marcflavour eq "UNIMARC" ) { # FIXME, TODO : handle repeatable fields # TODO : handle more types of documents