# Modified 2008 by BibLibre for Koha
+# Modified 2011 by Catalyst
+# Modified 2011 by Equinox Software, Inc.
+# Modified 2016 by 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 <http://www.gnu.org/licenses>.
#
#
-#use strict;
-#use warnings; FIXME - Bug 2505
+use Modern::Perl;
-use vars qw($VERSION @ISA @EXPORT);
+use List::MoreUtils qw/uniq/;
+use vars qw(@ISA @EXPORT);
+
+use Koha::SimpleMARC qw(read_field);
-# set the version for version checking
-$VERSION = 3.00;
@ISA = qw(Exporter);
&marc2ris
);
+our $marcprint = 0; # Debug flag;
=head1 marc2bibtex - Convert from UNIMARC to RIS
my $marcflavour = C4::Context->preference("marcflavour");
my $intype = lc($marcflavour);
- my $marcprint = 1; # Debug
# 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>---\n<marc>UTF-8 data\n" if $marcprint;
- $utf = 1;
- }
- else {
- print "<marc>---\n<marc>MARC-8 data\n" if $marcprint;
- }
- }
- ## else: other MARC formats do not specify the character encoding
- ## we assume it's *not* UTF-8
-
- ## start RIS dataset
- &print_typetag($leader);
+ 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;
+ }
+ 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
+ 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;
foreach my $field (@author_fields) {
if (length($field)) {
my $author = &get_author($field);
- print "AU - ",&charconv($author),"\n";
+ print "AU - ",$author,"\r\n";
}
}
foreach my $field (@editor_fields) {
if (length($field)) {
my $editor = &get_editor($field);
- print "ED - ",&charconv($editor),"\n";
+ print "ED - ",$editor,"\r\n";
}
}
&print_stitle($record->field('225'));
}
else { ## marc21, ukmarc
- &print_stitle($record->field('210'));
+ &print_stitle($record->field('490'));
}
## ISBN/ISSN
&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), "\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 - ", $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') {
my $allnotes = join "; ", @notepool;
if (length($allnotes) > 0) {
- print "N1 - ", &charconv($allnotes), "\n";
+ print "N1 - ", $allnotes, "\r\n";
}
## 320/520 have the abstract
else { ## assume marc21
&print_abstract($record->field('520'));
}
+
+ # 856u has the URI
+ if ($record->field('856')) {
+ print_uri($record->field('856'));
+ }
- ## end RIS dataset
- print "ER - \n";
+ 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};
- warn $outvar;
+ 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";
# Let's re-redirect stdout
close STDOUT;
##********************************************************************
## 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
##********************************************************************
sub print_typetag {
+ my ($leader)= @_;
## the keys of typehash are the allowed values at position 06
## of the leader of a MARC record, the values are the RIS types
## that might appropriately represent these types.
my %ustypehash = (
- "a" => "BOOK",
- "c" => "MUSIC",
- "d" => "MUSIC",
- "e" => "MAP",
- "f" => "MAP",
- "g" => "ADVS",
- "i" => "SOUND",
- "j" => "SOUND",
- "k" => "ART",
- "m" => "DATA",
- "o" => "GEN",
- "p" => "GEN",
- "r" => "ART",
- "t" => "GEN",
- );
-
+ "a" => "BOOK",
+ "c" => "MUSIC",
+ "d" => "MUSIC",
+ "e" => "MAP",
+ "f" => "MAP",
+ "g" => "ADVS",
+ "i" => "SOUND",
+ "j" => "SOUND",
+ "k" => "ART",
+ "m" => "DATA",
+ "o" => "GEN",
+ "p" => "GEN",
+ "r" => "ART",
+ "t" => "MANSCPT",
+ );
+
my %unitypehash = (
- "a" => "BOOK",
- "b" => "BOOK",
- "c" => "MUSIC",
- "d" => "MUSIC",
- "e" => "MAP",
- "f" => "MAP",
- "g" => "ADVS",
- "i" => "SOUND",
- "j" => "SOUND",
- "k" => "ART",
- "l" => "ELEC",
- "m" => "ADVS",
- "r" => "ART",
- );
-
+ "a" => "BOOK",
+ "b" => "MANSCPT",
+ "c" => "MUSIC",
+ "d" => "MUSIC",
+ "e" => "MAP",
+ "f" => "MAP",
+ "g" => "ADVS",
+ "i" => "SOUND",
+ "j" => "SOUND",
+ "k" => "ART",
+ "l" => "ELEC",
+ "m" => "GEN",
+ "r" => "ART",
+ );
+
## The type of a MARC record is found at position 06 of the leader
- my $typeofrecord = substr("@_", 6, 1);
+ my $typeofrecord = defined($leader) && length $leader >=6 ?
+ substr($leader, 6, 1): undef;
+ ## Pos 07 == Bibliographic level
+ my $biblevel = defined($leader) && length $leader >=7 ?
+ substr($leader, 7, 1): '';
- ## ToDo: for books, field 008 positions 24-27 might have a few more
+ ## TODO: for books, field 008 positions 24-27 might have a few more
## hints
- my $typehash;
-
- ## the ukmarc here is just a guess
- if ($intype eq "marc21" || $intype eq "ukmarc") {
- $typehash = $ustypehash;
- }
- elsif ($intype eq "unimarc") {
- $typehash = $unitypehash;
- }
- else {
- ## assume MARC21 as default
- $typehash = $ustypehash;
- }
-
- if (!exists $typehash{$typeofrecord}) {
- print "\nTY - BOOK\n"; ## most reasonable default
- warn ("no type found - assume BOOK");
+ my %typehash;
+ my $marcflavour = C4::Context->preference("marcflavour");
+ my $intype = lc($marcflavour);
+ if ($intype eq "unimarc") {
+ %typehash = %unitypehash;
}
else {
- print "\nTY - $typehash{$typeofrecord}\n";
+ %typehash = %ustypehash;
+ }
+
+ if (!defined $typeofrecord || !exists $typehash{$typeofrecord}) {
+ print "TY - GEN\r\n"; ## most reasonable default
+ warn ("no type found - assume GEN") if $marcprint;
+ } elsif ( $typeofrecord =~ "a" ) {
+ if ( $biblevel eq 'a' ) {
+ print "TY - GEN\r\n"; ## monographic component part
+ } elsif ( $biblevel eq 'b' || $biblevel eq 's' ) {
+ print "TY - SER\r\n"; ## serial or serial component part
+ } elsif ( $biblevel eq 'm' ) {
+ print "TY - $typehash{$typeofrecord}\r\n"; ## book
+ } elsif ( $biblevel eq 'c' || $biblevel eq 'd' ) {
+ print "TY - GEN\r\n"; ## collections, part of collections or made-up collections
+ } elsif ( $biblevel eq 'i' ) {
+ print "TY - DATA\r\n"; ## updating loose-leafe as Dataset
+ }
+ } else {
+ print "TY - $typehash{$typeofrecord}\r\n";
}
## use $typeofrecord as the return value, just in case
if ($nametype == 0) {
# ToDo: convert every input to Last[,(F.|First)[ (M.|Middle)[,Suffix]]]
- warn("name >>$rawauthora<< in direct order - leave as is");
+ warn("name >>$rawauthora<< in direct order - leave as is") if $marcprint;
return $rawauthora;
}
elsif ($nametype == 1) {
## we currently ignore subfield c until someone complains
if (length($rawauthorb) > 0) {
- return join ",", ($rawauthora, $rawauthorb);
+ return join ", ", ($rawauthora, $rawauthorb);
}
else {
return $rawauthora;
## the sequence of the name parts is encoded either in indicator
## 1 (marc21) or 2 (unimarc)
+ my $marcflavour = C4::Context->preference("marcflavour");
+ my $intype = lc($marcflavour);
if ($intype eq "unimarc") {
$indicator = 2;
}
$indicator = 1;
}
- print "<marc>:Author(Ind$indicator): ", $authorfield->indicator("$indicator"),"\n" if $marcprint;
- print "<marc>:Author(\$a): ", $authorfield->subfield('a'),"\n" if $marcprint;
- print "<marc>:Author(\$b): ", $authorfield->subfield('b'),"\n" if $marcprint;
- print "<marc>:Author(\$c): ", $authorfield->subfield('c'),"\n" if $marcprint;
- print "<marc>:Author(\$h): ", $authorfield->subfield('h'),"\n" if $marcprint;
+ print "<marc>:Author(Ind$indicator): ", $authorfield->indicator("$indicator"),"\r\n" if $marcprint;
+ print "<marc>:Author(\$a): ", $authorfield->subfield('a'),"\r\n" if $marcprint;
+ print "<marc>:Author(\$b): ", $authorfield->subfield('b'),"\r\n" if $marcprint;
+ print "<marc>:Author(\$c): ", $authorfield->subfield('c'),"\r\n" if $marcprint;
+ print "<marc>:Author(\$h): ", $authorfield->subfield('h'),"\r\n" if $marcprint;
if ($intype eq "ukmarc") {
my $authorname = $authorfield->subfield('a') . "," . $authorfield->subfield('h');
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"));
}
}
sub get_editor {
my ($editorfield) = @_;
- if ($editorfield == undef) {
- return undef;
+ if (!$editorfield) {
+ return;
}
else {
- print "<marc>Editor(\$a): ", $editorfield->subfield('a'),"\n" if $marcprint;
- print "<marc>Editor(\$b): ", $editorfield->subfield('b'),"\n" if $marcprint;
- print "<marc>editor(\$c): ", $editorfield->subfield('c'),"\n" if $marcprint;
+ print "<marc>Editor(\$a): ", $editorfield->subfield('a'),"\r\n" if $marcprint;
+ print "<marc>Editor(\$b): ", $editorfield->subfield('b'),"\r\n" if $marcprint;
+ print "<marc>editor(\$c): ", $editorfield->subfield('c'),"\r\n" if $marcprint;
return $editorfield->subfield('a');
}
}
##********************************************************************
sub print_title {
my ($titlefield) = @_;
- if ($titlefield == undef) {
- print "<marc>empty title field (245)\n" if $marcprint;
- warn("empty title field (245)");
- @_;
+ if (!$titlefield) {
+ print "<marc>empty title field (245)\r\n" if $marcprint;
+ warn("empty title field (245)") if $marcprint;
}
else {
- print "<marc>Title(\$a): ",$titlefield->subfield('a'),"\n" if $marcprint;
- print "<marc>Title(\$b): ",$titlefield->subfield('b'),"\n" if $marcprint;
- print "<marc>Title(\$c): ",$titlefield->subfield('c'),"\n" if $marcprint;
+ print "<marc>Title(\$a): ",$titlefield->subfield('a'),"\r\n" if $marcprint;
+ print "<marc>Title(\$b): ",$titlefield->subfield('b'),"\r\n" if $marcprint;
+ print "<marc>Title(\$c): ",$titlefield->subfield('c'),"\r\n" if $marcprint;
## The title is usually written in a very odd notation. The title
## proper ($a) often ends with a space followed by a separator like
my $clean_title = $titlefield->subfield('a');
my $clean_subtitle = $titlefield->subfield('b');
+$clean_subtitle ||= q{};
$clean_title =~ s% *[/:;.]$%%;
$clean_subtitle =~ s%^ *(.*) *[/:;.]$%$1%;
+ my $marcflavour = C4::Context->preference("marcflavour");
+ my $intype = lc($marcflavour);
if (length($clean_title) > 0
|| (length($clean_subtitle) > 0 && $intype ne "unimarc")) {
- print "TI - ", &charconv($clean_title);
+ print "TI - ", $clean_title;
## subfield $b is relevant only for marc21/ukmarc
if (length($clean_subtitle) > 0 && $intype ne "unimarc") {
- print ": ",&charconv($clean_subtitle);
+ print ": ",$clean_subtitle;
}
- print "\n";
+ print "\r\n";
}
## The statement of responsibility is just this: horrors. There is
## be written and designated. The field is free-form and resistant
## to all parsing efforts, so this information is lost on me
}
- }
+ return;
+}
##********************************************************************
## print_stitle(): prints info from series title field
sub print_stitle {
my ($titlefield) = @_;
- if ($titlefield == undef) {
- print "<marc>empty series title field\n" if $marcprint;
- warn("empty series title field");
- @_;
+ if (!$titlefield) {
+ print "<marc>empty series title field\r\n" if $marcprint;
}
else {
- print "<marc>Series title(\$a): ",$titlefield->subfield('a'),"\n" if $marcprint;
+ print "<marc>Series title(\$a): ",$titlefield->subfield('a'),"\r\n" if $marcprint;
my $clean_title = $titlefield->subfield('a');
$clean_title =~ s% *[/:;.]$%%;
if (length($clean_title) > 0) {
- print "T2 - ", &charconv($clean_title);
+ print "T2 - ", $clean_title,"\r\n";
}
+ my $marcflavour = C4::Context->preference("marcflavour");
+ my $intype = lc($marcflavour);
if ($intype eq "unimarc") {
- print "<marc>Series vol(\$v): ",$titlefield->subfield('v'),"\n" if $marcprint;
+ print "<marc>Series vol(\$v): ",$titlefield->subfield('v'),"\r\n" if $marcprint;
if (length($titlefield->subfield('v')) > 0) {
- print "VL - ", &charconv($titlefield->subfield('v'));
+ print "VL - ", $titlefield->subfield('v'),"\r\n";
}
}
}
- }
+ return;
+}
##********************************************************************
## print_isbn(): gets info from MARC field 020
sub print_isbn {
my($isbnfield) = @_;
- if ($isbnfield == undef ||length ($isbnfield->subfield('a')) == 0) {
- print "<marc>no isbn found (020\$a)\n" if $marcprint;
- warn("no isbn found");
+ if (!$isbnfield || length ($isbnfield->subfield('a')) == 0) {
+ print "<marc>no isbn found (020\$a)\r\n" if $marcprint;
+ warn("no isbn found") if $marcprint;
}
else {
if (length ($isbnfield->subfield('a')) < 10) {
- print "<marc>truncated isbn (020\$a)\n" if $marcprint;
- warn("truncated isbn");
+ print "<marc>truncated isbn (020\$a)\r\n" if $marcprint;
+ warn("truncated isbn") if $marcprint;
}
- my $isbn = substr($isbnfield->subfield('a'), 0, 10);
- print "SN - ", &charconv($isbn), "\n";
+ my $isbn = $isbnfield->subfield('a');
+ print "SN - ", $isbn, "\r\n";
}
}
sub print_issn {
my($issnfield) = @_;
- if ($issnfield == undef ||length ($issnfield->subfield('a')) == 0) {
- print "<marc>no issn found (022\$a)\n" if $marcprint;
- warn("no issn found");
+ if (!$issnfield || length ($issnfield->subfield('a')) == 0) {
+ print "<marc>no issn found (022\$a)\r\n" if $marcprint;
+ warn("no issn found") if $marcprint;
}
else {
if (length ($issnfield->subfield('a')) < 9) {
- print "<marc>truncated issn (022\$a)\n" if $marcprint;
- warn("truncated issn");
+ print "<marc>truncated issn (022\$a)\r\n" if $marcprint;
+ warn("truncated issn") if $marcprint;
}
my $issn = substr($issnfield->subfield('a'), 0, 9);
- print "SN - ", &charconv($issn), "\n";
+ print "SN - ", $issn, "\r\n";
+ }
+}
+
+###
+# print_uri() prints info from 856 u
+###
+sub print_uri {
+ my @f856s = @_;
+
+ foreach my $f856 (@f856s) {
+ if (my $uri = $f856->subfield('u')) {
+ print "UR - ", $uri, "\r\n";
+ }
}
}
sub print_loc_callno {
my($callnofield) = @_;
- if ($callnofield == undef || length ($callnofield->subfield('a')) == 0) {
- print "<marc>no LOC call number found (050\$a)\n" if $marcprint;
- warn("no LOC call number found");
+ if (!$callnofield || length ($callnofield->subfield('a')) == 0) {
+ print "<marc>no LOC call number found (050\$a)\r\n" if $marcprint;
+ warn("no LOC call number found") if $marcprint;
}
else {
- print "AV - ", &charconv($callnofield->subfield('a')), " ", &charconv($callnofield->subfield('b')), "\n";
+ print "AV - ", $callnofield->subfield('a'), " ", $callnofield->subfield('b'), "\r\n";
}
}
sub print_dewey {
my($deweyfield) = @_;
- if ($deweyfield == undef || length ($deweyfield->subfield('a')) == 0) {
- print "<marc>no Dewey number found (082\$a)\n" if $marcprint;
- warn("no Dewey number found");
+ if (!$deweyfield || length ($deweyfield->subfield('a')) == 0) {
+ print "<marc>no Dewey number found (082\$a)\r\n" if $marcprint;
+ warn("no Dewey number found") if $marcprint;
}
else {
- print "U1 - ", &charconv($deweyfield->subfield('a')), " ", &charconv($deweyfield->subfield('2')), "\n";
+ print "U1 - ", $deweyfield->subfield('a'), " ", $deweyfield->subfield('2'), "\r\n";
}
}
sub print_pubinfo {
my($pubinfofield) = @_;
- if ($pubinfofield == undef) {
- print "<marc>no publication information found (260)\n" if $marcprint;
- warn("no publication information found");
+ if (!$pubinfofield) {
+ print "<marc>no publication information found (260/264)\r\n" if $marcprint;
+ warn("no publication information found") if $marcprint;
}
else {
## the following information is available in MARC21:
my $pubsub_publisher;
my $pubsub_date;
+ my $marcflavour = C4::Context->preference("marcflavour");
+ my $intype = lc($marcflavour);
if ($intype eq "unimarc") {
$pubsub_place = "a";
$pubsub_publisher = "c";
## the dates are free-form, so we want to extract
## a four-digit year and leave the rest as
## "other info"
- $protoyear = @$tuple[1];
- print "<marc>Year (260\$c): $protoyear\n" if $marcprint;
+ my $protoyear = @$tuple[1];
+ print "<marc>Year (260\$c): $protoyear\r\n" if $marcprint;
## strip any separator chars at the end
$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%;
}
else {
## have no year info
- print "<marc>no four-digit year found, use 0000\n" if $marcprint;
+ print "<marc>no four-digit year found, use 0000\r\n" if $marcprint;
$protoyear = "0000///$protoyear";
- warn("no four-digit year found, use 0000");
+ warn("no four-digit year found, use 0000") if $marcprint;
}
if ($pycounter == 0 && length($protoyear)) {
- print "PY - $protoyear\n";
+ print "PY - $protoyear\r\n";
}
elsif ($pycounter == 1 && length($_)) {
- print "Y2 - $protoyear\n";
+ print "Y2 - $protoyear\r\n";
}
## else: discard
}
## now dump the collected CY and PB lists
if (@cities > 0) {
- print "CY - ", &charconv(join(", ", @cities)), "\n";
+ print "CY - ", join(", ", @cities), "\r\n";
}
if (@publishers > 0) {
- print "PB - ", &charconv(join(", ", @publishers)), "\n";
+ print "PB - ", join(", ", @publishers), "\r\n";
}
}
}
## 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 $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'), "\n<marc>Field $kwfield subfield b:", $kwfield->subfield('b'), "\n<marc>Field $kwfield subfield c:", $kwfield->subfield('c'), "\n" if $marcprint;
- }
- else {
- ## retrieve all available subfields
- @kwsubfields = $kwfield->subfields();
-
- ## loop over all available subfield tuples
- foreach $kwtuple (@kwsubfields) {
- ## loop over all subfields to check
- foreach $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], "\n" if $marcprint;
- }
- ## we can leave the subfields loop here
- last;
- }
- }
- }
- }
- }
- }
+ 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'));
+ 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 $notefield (@notefields) {
- if ($notefield != undef) {
- ## retrieve all available subfield tuples
- @notesubfields = $notefield->subfields();
-
- ## loop over all subfield tuples
- foreach $notetuple (@notesubfields) {
- ## loop over all subfields to check
- foreach $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], "\n" if $marcprint;
- @$notetuple[1] =~ s% *[,;.:/]*$%%;
- if (length(@$notetuple[1]) > 0) {
- ## add to list
- push @{$aref}, @$notetuple[1];
- }
- last;
- }
- }
- }
- }
+ foreach my $notefield (@notefields) {
+ 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;
+ }
+ }
+ }
+ }
}
}
my @abstrings;
## loop over all abfields
- foreach $abfield (@abfields) {
- foreach $field (@subfields) {
- if (length ($abfield->subfield($field)) > 0) {
- my $ab = $abfield->subfield($field);
+ foreach my $abfield (@abfields) {
+ foreach my $field (@subfields) {
+ if ( length( $abfield->subfield($field) ) > 0 ) {
+ my $ab = $abfield->subfield($field);
- print "<marc>field 520 subfield $field: $ab\n" if $marcprint;
+ print "<marc>field 520 subfield $field: $ab\r\n" if $marcprint;
- ## strip trailing separators
- $ab =~ s% *[;,:./]*$%%;
+ ## strip trailing separators
+ $ab =~ s% *[;,:./]*$%%;
- ## add string to the list
- push (@abstrings, $ab);
- }
- }
+ ## add string to the list
+ push( @abstrings, $ab );
+ }
+ }
}
my $allabs = join "; ", @abstrings;
if (length($allabs) > 0) {
- print "N2 - ", &charconv($allabs), "\n";
+ print "N2 - ", $allabs, "\r\n";
}
}
-##********************************************************************
-## charconv(): converts to a different charset based on a global var
-## Arguments: string
-## Returns: string
-##********************************************************************
-sub charconv {
- if ($utf) {
- ## return unaltered if already utf-8
- return @_;
- }
- elsif ($uniout eq "t") {
- ## convert to utf-8
- warn "marc8_to_utf8";
- return marc8_to_utf8("@_");
- }
- else {
- ## return unaltered if no utf-8 requested
- return @_;
- }
-}
1;
projects / koha.git / blobdiff