#
#use strict;
-#use warnings; FIXME - Bug 2505
+#use warnings;
+use List::MoreUtils qw/uniq/;
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
-$VERSION = 3.00;
+$VERSION = 3.07.00.049;
@ISA = qw(Exporter);
&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') {
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 {
## 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) {
+ 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;
+ 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 {
@kwsubfields = $kwfield->subfields();
## loop over all available subfield tuples
- foreach $kwtuple (@kwsubfields) {
+ foreach my $kwtuple (@kwsubfields) {
## loop over all subfields to check
- foreach $subfield (@subfields) {
+ 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;
+ push @kw, @$kwtuple[1];
print "<marc>Field $fieldname subfield $subfield:", @$kwtuple[1], "\r\n" if $marcprint;
}
## we can leave the subfields loop here
}
}
}
+ return @kw;
}
##********************************************************************
}
## loop over all notefields
- foreach $notefield (@notefields) {
+ foreach my $notefield (@notefields) {
if ($notefield != undef) {
## retrieve all available subfield tuples
@notesubfields = $notefield->subfields();
## loop over all subfield tuples
- foreach $notetuple (@notesubfields) {
+ foreach my $notetuple (@notesubfields) {
## loop over all subfields to check
- foreach $subfield (@subfields) {
+ foreach my $subfield (@subfields) {
## [0] contains subfield code
if (@$notetuple[0] eq $subfield) {
## [1] contains value, remove trailing separators
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\r\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;