Lines 62-67
package C4::Ris;
Link Here
|
62 |
#use strict; |
62 |
#use strict; |
63 |
#use warnings; |
63 |
#use warnings; |
64 |
|
64 |
|
|
|
65 |
use List::MoreUtils qw/uniq/; |
65 |
use vars qw($VERSION @ISA @EXPORT); |
66 |
use vars qw($VERSION @ISA @EXPORT); |
66 |
|
67 |
|
67 |
# set the version for version checking |
68 |
# set the version for version checking |
Lines 218-248
sub marc2ris {
Link Here
|
218 |
} |
219 |
} |
219 |
|
220 |
|
220 |
## 6XX fields contain KW candidates. We add all of them to a |
221 |
## 6XX fields contain KW candidates. We add all of them to a |
221 |
## hash to eliminate duplicates |
|
|
222 |
my %kwpool; |
223 |
|
222 |
|
224 |
if ($intype eq "unimarc") { |
223 |
my @field_list; |
225 |
foreach ('600', '601', '602', '604', '605', '606','607', '608', '610', '615', '620', '660'. '661', '670', '675', '676', '680', '686') { |
224 |
if ($intype eq "unimarc") { |
226 |
&get_keywords(\%kwpool, "$_",$record->field($_)); |
225 |
@field_list = ('600', '601', '602', '604', '605', '606','607', '608', '610', '615', '620', '660'. '661', '670', '675', '676', '680', '686'); |
227 |
} |
226 |
} elsif ($intype eq "ukmarc") { |
228 |
} |
227 |
@field_list = ('600', '610', '611', '630', '650', '651','653', '655', '660', '661', '668', '690', '691', '692', '695'); |
229 |
elsif ($intype eq "ukmarc") { |
228 |
} else { ## assume marc21 |
230 |
foreach ('600', '610', '611', '630', '650', '651','653', '655', '660', '661', '668', '690', '691', '692', '695') { |
229 |
@field_list = ('600', '610', '611', '630', '650', '651','653', '654', '655', '656', '657', '658'); |
231 |
&get_keywords(\%kwpool, "$_",$record->field($_)); |
230 |
} |
232 |
} |
|
|
233 |
} |
234 |
else { ## assume marc21 |
235 |
foreach ('600', '610', '611', '630', '650', '651','653', '654', '655', '656', '657', '658') { |
236 |
&get_keywords(\%kwpool, "$_",$record->field($_)); |
237 |
} |
238 |
} |
239 |
|
231 |
|
240 |
## print all keywords found in the hash. The value of each hash |
232 |
my @kwpool; |
241 |
## entry is the number of occurrences, but we're not really interested |
233 |
for my $f ( @field_list ) { |
242 |
## in that and rather print the key |
234 |
my @fields = $record->field($f); |
243 |
while (my ($key, $value) = each %kwpool) { |
235 |
push @kwpool, ( get_keywords("$f",$record->field($f)) ); |
244 |
print "KW - ", &charconv($key), "\r\n"; |
236 |
} |
245 |
} |
237 |
|
|
|
238 |
# Remove duplicate |
239 |
@kwpool = uniq @kwpool; |
240 |
|
241 |
for my $kw ( @kwpool ) { |
242 |
print "KW - ", &charconv($kw), "\r\n"; |
243 |
} |
246 |
|
244 |
|
247 |
## 5XX have various candidates for notes and abstracts. We pool |
245 |
## 5XX have various candidates for notes and abstracts. We pool |
248 |
## all notes-like stuff in one list. |
246 |
## all notes-like stuff in one list. |
Lines 762-769
sub print_pubinfo {
Link Here
|
762 |
## Arguments: list of fields (6XX) |
760 |
## Arguments: list of fields (6XX) |
763 |
##******************************************************************** |
761 |
##******************************************************************** |
764 |
sub get_keywords { |
762 |
sub get_keywords { |
765 |
my($href, $fieldname, @keywords) = @_; |
763 |
my($fieldname, @keywords) = @_; |
766 |
|
764 |
|
|
|
765 |
my @kw; |
767 |
## a list of all possible subfields |
766 |
## a list of all possible subfields |
768 |
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'); |
767 |
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'); |
769 |
|
768 |
|
Lines 773-779
sub get_keywords {
Link Here
|
773 |
## authornames get special treatment |
772 |
## authornames get special treatment |
774 |
if ($fieldname eq "600") { |
773 |
if ($fieldname eq "600") { |
775 |
my $val = normalize_author($kwfield->subfield('a'), $kwfield->subfield('b'), $kwfield->subfield('c'), $kwfield->indicator('1')); |
774 |
my $val = normalize_author($kwfield->subfield('a'), $kwfield->subfield('b'), $kwfield->subfield('c'), $kwfield->indicator('1')); |
776 |
${$href}{$val} += 1; |
775 |
push @kw, $val; |
777 |
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; |
776 |
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; |
778 |
} |
777 |
} |
779 |
else { |
778 |
else { |
Lines 789-796
sub get_keywords {
Link Here
|
789 |
## [1] contains value, remove trailing separators |
788 |
## [1] contains value, remove trailing separators |
790 |
@$kwtuple[1] =~ s% *[,;.:/]*$%%; |
789 |
@$kwtuple[1] =~ s% *[,;.:/]*$%%; |
791 |
if (length(@$kwtuple[1]) > 0) { |
790 |
if (length(@$kwtuple[1]) > 0) { |
792 |
## add to hash |
791 |
push @kw, @$kwtuple[1]; |
793 |
${$href}{@$kwtuple[1]} += 1; |
|
|
794 |
print "<marc>Field $fieldname subfield $subfield:", @$kwtuple[1], "\r\n" if $marcprint; |
792 |
print "<marc>Field $fieldname subfield $subfield:", @$kwtuple[1], "\r\n" if $marcprint; |
795 |
} |
793 |
} |
796 |
## we can leave the subfields loop here |
794 |
## we can leave the subfields loop here |
Lines 801-806
sub get_keywords {
Link Here
|
801 |
} |
799 |
} |
802 |
} |
800 |
} |
803 |
} |
801 |
} |
|
|
802 |
return @kw; |
804 |
} |
803 |
} |
805 |
|
804 |
|
806 |
##******************************************************************** |
805 |
##******************************************************************** |
807 |
- |
|
|