#
# 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 <http://www.gnu.org/licenses>.
#
#
-#use strict;
-#use warnings;
+use Modern::Perl;
+use List::MoreUtils qw/uniq/;
use vars qw($VERSION @ISA @EXPORT);
+use C4::Biblio qw(GetMarcSubfieldStructureFromKohaField);
+use Koha::SimpleMARC qw(read_field);
+
# set the version for version checking
$VERSION = 3.07.00.049;
&marc2ris
);
+our $utf;
+our $intype;
+our $marcprint;
+our $protoyear;
+
=head1 marc2bibtex - Convert from UNIMARC to RIS
my $output;
my $marcflavour = C4::Context->preference("marcflavour");
- my $intype = lc($marcflavour);
+ $intype = lc($marcflavour);
my $marcprint = 0; # Debug flag;
# Let's redirect stdout
open my $oldout, ">&STDOUT";
my $outvar;
close STDOUT;
- open STDOUT,'>', \$outvar;
-
-
- ## First we should check the character encoding. This may be
- ## MARC-8 or UTF-8. The former is indicated by a blank, the latter
- ## by 'a' at position 09 (zero-based) of the leader
- my $leader = $record->leader();
- if ($intype eq "marc21") {
- if ($leader =~ /^.{9}a/) {
- print "<marc>---\r\n<marc>UTF-8 data\r\n" if $marcprint;
- $utf = 1;
- }
- else {
- print "<marc>---\r\n<marc>MARC-8 data\r\n" if $marcprint;
- }
- }
- ## else: other MARC formats do not specify the character encoding
- ## we assume it's *not* UTF-8
+ open STDOUT,'>:encoding(utf8)', \$outvar;
+
+ ## First we should check the character encoding. This may be
+ ## MARC-8 or UTF-8. The former is indicated by a blank, the latter
+ ## by 'a' at position 09 (zero-based) of the leader
+ my $leader = $record->leader();
+ if ( $intype eq "marc21" ) {
+ if ( $leader =~ /^.{9}a/ ) {
+ print "<marc>---\r\n<marc>UTF-8 data\r\n" if $marcprint;
+ $utf = 1;
+ }
+ else {
+ print "<marc>---\r\n<marc>MARC-8 data\r\n" if $marcprint;
+ }
+ }
+ ## else: other MARC formats do not specify the character encoding
+ ## we assume it's *not* UTF-8
+
+ my $RisExportAdditionalFields = C4::Context->preference('RisExportAdditionalFields');
+ my $ris_additional_fields;
+ if ($RisExportAdditionalFields) {
+ $RisExportAdditionalFields = "$RisExportAdditionalFields\n\n";
+ $ris_additional_fields = eval { YAML::Load($RisExportAdditionalFields); };
+ if ($@) {
+ warn "Unable to parse RisExportAdditionalFields : $@";
+ $ris_additional_fields = undef;
+ }
+ }
- ## start RIS dataset
- &print_typetag($leader);
+ ## start RIS dataset
+ if ( $ris_additional_fields && $ris_additional_fields->{TY} ) {
+ my ( $f, $sf ) = split( /\$/, $ris_additional_fields->{TY} );
+ my ( $type ) = read_field( { record => $record, field => $f, subfield => $sf, field_numbers => [1] } );
+ if ($type) {
+ print "TY - $type\r\n";
+ }
+ else {
+ &print_typetag($leader);
+ }
+ }
+ else {
+ &print_typetag($leader);
+ }
## retrieve all author fields and collect them in a list
my @author_fields;
&print_pubinfo($record->field('210'));
}
else { ## marc21, ukmarc
- &print_pubinfo($record->field('260'));
+ if ($record->field('264')) {
+ &print_pubinfo($record->field('264'));
+ }
+ else {
+ &print_pubinfo($record->field('260'));
+ }
}
## 6XX fields contain KW candidates. We add all of them to a
- ## hash to eliminate duplicates
- my %kwpool;
- if ($intype eq "unimarc") {
- foreach ('600', '601', '602', '604', '605', '606','607', '608', '610', '615', '620', '660'. '661', '670', '675', '676', '680', '686') {
- &get_keywords(\%kwpool, "$_",$record->field($_));
- }
- }
- elsif ($intype eq "ukmarc") {
- foreach ('600', '610', '611', '630', '650', '651','653', '655', '660', '661', '668', '690', '691', '692', '695') {
- &get_keywords(\%kwpool, "$_",$record->field($_));
- }
- }
- else { ## assume marc21
- foreach ('600', '610', '611', '630', '650', '651','653', '654', '655', '656', '657', '658') {
- &get_keywords(\%kwpool, "$_",$record->field($_));
- }
- }
+ my @field_list;
+ if ($intype eq "unimarc") {
+ @field_list = ('600', '601', '602', '604', '605', '606','607', '608', '610', '615', '620', '660', '661', '670', '675', '676', '680', '686');
+ } elsif ($intype eq "ukmarc") {
+ @field_list = ('600', '610', '611', '630', '650', '651','653', '655', '660', '661', '668', '690', '691', '692', '695');
+ } else { ## assume marc21
+ @field_list = ('600', '610', '611', '630', '650', '651','653', '654', '655', '656', '657', '658');
+ }
- ## print all keywords found in the hash. The value of each hash
- ## entry is the number of occurrences, but we're not really interested
- ## in that and rather print the key
- while (my ($key, $value) = each %kwpool) {
- print "KW - ", &charconv($key), "\r\n";
- }
+ my @kwpool;
+ for my $f ( @field_list ) {
+ my @fields = $record->field($f);
+ push @kwpool, ( get_keywords("$f",$record->field($f)) );
+ }
+
+ # Remove duplicate
+ @kwpool = uniq @kwpool;
+
+ for my $kw ( @kwpool ) {
+ print "KW - ", &charconv($kw), "\r\n";
+ }
## 5XX have various candidates for notes and abstracts. We pool
## all notes-like stuff in one list.
elsif ($intype eq "ukmarc") {
foreach ('500', '501', '502', '503', '504', '505', '506', '508', '514', '515', '516', '521', '524', '525', '528', '530', '531', '532', '533', '534', '535', '537', '538', '540', '541', '542', '544', '554', '555', '556', '557', '561', '563', '580', '583', '584', '586') {
&pool_subx(\@notepool, $_, $record->field($_));
- }
+ }
}
else { ## assume marc21
foreach ('500', '501', '502', '504', '505', '506', '507', '508', '510', '511', '513', '514', '515', '516', '518', '521', '522', '524', '525', '526', '530', '533', '534', '535') {
print_uri($record->field('856'));
}
+ if ($ris_additional_fields) {
+ foreach my $ris_tag ( keys %$ris_additional_fields ) {
+ next if $ris_tag eq 'TY';
+
+ my @fields =
+ ref( $ris_additional_fields->{$ris_tag} ) eq 'ARRAY'
+ ? @{ $ris_additional_fields->{$ris_tag} }
+ : $ris_additional_fields->{$ris_tag};
+
+ for my $tag (@fields) {
+ my ( $f, $sf ) = split( /\$/, $tag );
+ my @values = read_field( { record => $record, field => $f, subfield => $sf } );
+ foreach my $v (@values) {
+ print "$ris_tag - $v\r\n";
+ }
+ }
+ }
+ }
+
## end RIS dataset
print "ER - \r\n";
##********************************************************************
## print_typetag(): prints the first line of a RIS dataset including
-## the preceeding newline
+## the preceding newline
## Argument: the leader of a MARC dataset
## Returns: the value at leader position 06
##********************************************************************
## we currently ignore subfield c until someone complains
if (length($rawauthorb) > 0) {
- return join ",", ($rawauthora, $rawauthorb);
+ return join ", ", ($rawauthora, $rawauthorb);
}
else {
return $rawauthora;
normalize_author($authorname, $authorfield->subfield('b'), $authorfield->subfield('c'), $authorfield->indicator("$indicator"));
}
else {
- normalize_author($authorfield->subfield('a'), $authorfield->subfield('b'), $authorfield->subfield('c'), $authorfield->indicator("$indicator"));
+ normalize_author($authorfield->subfield('a') // '', $authorfield->subfield('b') // '', $authorfield->subfield('c') // '', $authorfield->indicator("$indicator"));
}
}
my $clean_title = $titlefield->subfield('a');
my $clean_subtitle = $titlefield->subfield('b');
+$clean_subtitle ||= q{};
$clean_title =~ s% *[/:;.]$%%;
$clean_subtitle =~ s%^ *(.*) *[/:;.]$%$1%;
my($pubinfofield) = @_;
if (!$pubinfofield) {
- print "<marc>no publication information found (260)\r\n" if $marcprint;
+ print "<marc>no publication information found (260/264)\r\n" if $marcprint;
warn("no publication information found") if $marcprint;
}
else {
$protoyear =~ s% *[\.;:/]*$%%;
## isolate a four-digit year. We discard anything
- ## preceeding the year, but keep everything after
+ ## preceding the year, but keep everything after
## the year as other info.
$protoyear =~ s%\D*([0-9\-]{4})(.*)%$1///$2%;
## Arguments: list of fields (6XX)
##********************************************************************
sub get_keywords {
- my($href, $fieldname, @keywords) = @_;
+ my($fieldname, @keywords) = @_;
+ my @kw;
## a list of all possible subfields
my @subfields = ('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'x', 'y', 'z', '2', '3', '4');
## loop over all 6XX fields
foreach my $kwfield (@keywords) {
- if ($kwfield != undef) {
- ## authornames get special treatment
- if ($fieldname eq "600") {
- my $val = normalize_author($kwfield->subfield('a'), $kwfield->subfield('b'), $kwfield->subfield('c'), $kwfield->indicator('1'));
- ${$href}{$val} += 1;
- print "<marc>Field $kwfield subfield a:", $kwfield->subfield('a'), "\r\n<marc>Field $kwfield subfield b:", $kwfield->subfield('b'), "\r\n<marc>Field $kwfield subfield c:", $kwfield->subfield('c'), "\r\n" if $marcprint;
- }
- else {
- ## retrieve all available subfields
- @kwsubfields = $kwfield->subfields();
-
- ## loop over all available subfield tuples
- foreach my $kwtuple (@kwsubfields) {
- ## loop over all subfields to check
- foreach my $subfield (@subfields) {
- ## [0] contains subfield code
- if (@$kwtuple[0] eq $subfield) {
- ## [1] contains value, remove trailing separators
- @$kwtuple[1] =~ s% *[,;.:/]*$%%;
- if (length(@$kwtuple[1]) > 0) {
- ## add to hash
- ${$href}{@$kwtuple[1]} += 1;
- print "<marc>Field $fieldname subfield $subfield:", @$kwtuple[1], "\r\n" if $marcprint;
- }
- ## we can leave the subfields loop here
- last;
- }
- }
- }
- }
- }
+ if ($kwfield != undef) {
+ ## authornames get special treatment
+ if ($fieldname eq "600") {
+ my $val = normalize_author($kwfield->subfield('a'), $kwfield->subfield('b'), $kwfield->subfield('c'), $kwfield->indicator('1'));
+ push @kw, $val;
+ print "<marc>Field $kwfield subfield a:", $kwfield->subfield('a'), "\r\n<marc>Field $kwfield subfield b:", $kwfield->subfield('b'), "\r\n<marc>Field $kwfield subfield c:", $kwfield->subfield('c'), "\r\n" if $marcprint;
+ }
+ else {
+ ## retrieve all available subfields
+ my @kwsubfields = $kwfield->subfields();
+
+ ## loop over all available subfield tuples
+ foreach my $kwtuple (@kwsubfields) {
+ ## loop over all subfields to check
+ foreach my $subfield (@subfields) {
+ ## [0] contains subfield code
+ if (@$kwtuple[0] eq $subfield) {
+ ## [1] contains value, remove trailing separators
+ @$kwtuple[1] =~ s% *[,;.:/]*$%%;
+ if (length(@$kwtuple[1]) > 0) {
+ push @kw, @$kwtuple[1];
+ print "<marc>Field $fieldname subfield $subfield:", @$kwtuple[1], "\r\n" if $marcprint;
+ }
+ ## we can leave the subfields loop here
+ last;
+ }
+ }
+ }
+ }
+ }
}
+ return @kw;
}
##********************************************************************
## loop over all notefields
foreach my $notefield (@notefields) {
- if ($notefield != undef) {
- ## retrieve all available subfield tuples
- @notesubfields = $notefield->subfields();
-
- ## loop over all subfield tuples
- foreach my $notetuple (@notesubfields) {
- ## loop over all subfields to check
- foreach my $subfield (@subfields) {
- ## [0] contains subfield code
- if (@$notetuple[0] eq $subfield) {
- ## [1] contains value, remove trailing separators
- print "<marc>field $fieldname subfield $subfield: ", @$notetuple[1], "\r\n" if $marcprint;
- @$notetuple[1] =~ s% *[,;.:/]*$%%;
- if (length(@$notetuple[1]) > 0) {
- ## add to list
- push @{$aref}, @$notetuple[1];
- }
- last;
- }
- }
- }
- }
+ if (defined $notefield) {
+ ## retrieve all available subfield tuples
+ my @notesubfields = $notefield->subfields();
+
+ ## loop over all subfield tuples
+ foreach my $notetuple (@notesubfields) {
+ ## loop over all subfields to check
+ foreach my $subfield (@subfields) {
+ ## [0] contains subfield code
+ if (@$notetuple[0] eq $subfield) {
+ ## [1] contains value, remove trailing separators
+ print "<marc>field $fieldname subfield $subfield: ", @$notetuple[1], "\r\n" if $marcprint;
+ @$notetuple[1] =~ s% *[,;.:/]*$%%;
+ if (length(@$notetuple[1]) > 0) {
+ ## add to list
+ push @{$aref}, @$notetuple[1];
+ }
+ last;
+ }
+ }
+ }
+ }
}
}
## return unaltered if already utf-8
return @_;
}
- elsif ($uniout eq "t") {
+ elsif (my $uniout eq "t") {
## convert to utf-8
return marc8_to_utf8("@_");
}
projects / koha.git / blobdiff