|
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 |
- |
|
|