View | Details | Raw Unified | Return to bug 13360
Collapse All | Expand All

(-)a/C4/Ris.pm (-28 / +26 lines)
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
- 

Return to bug 13360