4 ## marc2ris: converts MARC21 and UNIMARC datasets to RIS format
5 ## See comments below for compliance with other MARC dialects
7 ## usage: perl marc2ris < infile.marc > outfile.ris
9 ## Dependencies: perl 5.6.0 or later
13 ## markus@mhoenicka.de 2002-11-16
15 ## This program is free software; you can redistribute it and/or modify
16 ## it under the terms of the GNU General Public License as published by
17 ## the Free Software Foundation; either version 2 of the License, or
18 ## (at your option) any later version.
20 ## This program is distributed in the hope that it will be useful,
21 ## but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ## GNU General Public License for more details.
25 ## You should have received a copy of the GNU General Public License
26 ## along with this program; if not, write to the Free Software
27 ## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
29 ## Some background about MARC as understood by this script
30 ## The default input format used in this script is MARC21, which
31 ## superseded USMARC and CANMARC. The specification can be found at:
32 ## http://lcweb.loc.gov/marc/
33 ## UNIMARC follows the specification at:
34 ## http://www.ifla.org/VI/3/p1996-1/sec-uni.htm
35 ## UKMARC support is a bit shaky because there is no specification available
36 ## for free. The wisdom used in this script was taken from a PDF document
37 ## comparing UKMARC to MARC21 found at:
38 ## www.bl.uk/services/bibliographic/marcchange.pdf
41 # Modified 2008 by BibLibre for Koha
42 # Modified 2011 by Catalyst
43 # Modified 2011 by Equinox Software, Inc.
44 # Modified 2016 by Universidad de El Salvador
46 # This file is part of Koha.
48 # Koha is free software; you can redistribute it and/or modify it
49 # under the terms of the GNU General Public License as published by
50 # the Free Software Foundation; either version 3 of the License, or
51 # (at your option) any later version.
53 # Koha is distributed in the hope that it will be useful, but
54 # WITHOUT ANY WARRANTY; without even the implied warranty of
55 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
56 # GNU General Public License for more details.
58 # You should have received a copy of the GNU General Public License
59 # along with Koha; if not, see <http://www.gnu.org/licenses>.
65 use List::MoreUtils qw/uniq/;
66 use vars qw(@ISA @EXPORT);
68 use Koha::SimpleMARC qw(read_field);
73 # only export API methods
79 our $marcprint = 0; # Debug flag;
81 =head1 marc2bibtex - Convert from UNIMARC to RIS
83 my ($ris) = marc2ris($record);
87 C<$record> - a MARC::Record object
95 my $marcflavour = C4::Context->preference("marcflavour");
96 my $intype = lc($marcflavour);
98 # Let's redirect stdout
99 open my $oldout, ">&STDOUT";
102 open STDOUT,'>:encoding(utf8)', \$outvar;
104 ## First we should check the character encoding. This may be
105 ## MARC-8 or UTF-8. The former is indicated by a blank, the latter
106 ## by 'a' at position 09 (zero-based) of the leader
107 my $leader = $record->leader();
108 if ( $intype eq "marc21" ) {
109 if ( $leader =~ /^.{9}a/ ) {
110 print "<marc>---\r\n<marc>UTF-8 data\r\n" if $marcprint;
113 print "<marc>---\r\n<marc>MARC-8 data\r\n" if $marcprint;
116 ## else: other MARC formats do not specify the character encoding
117 ## we assume it's *not* UTF-8
119 my $RisExportAdditionalFields = C4::Context->preference('RisExportAdditionalFields');
120 my $ris_additional_fields;
121 if ($RisExportAdditionalFields) {
122 $RisExportAdditionalFields = "$RisExportAdditionalFields\n\n";
123 $ris_additional_fields = eval { YAML::Load($RisExportAdditionalFields); };
125 warn "Unable to parse RisExportAdditionalFields : $@";
126 $ris_additional_fields = undef;
131 if ( $ris_additional_fields && $ris_additional_fields->{TY} ) {
132 my ( $f, $sf ) = split( /\$/, $ris_additional_fields->{TY} );
133 my ( $type ) = read_field( { record => $record, field => $f, subfield => $sf, field_numbers => [1] } );
135 print "TY - $type\r\n";
138 &print_typetag($leader);
142 &print_typetag($leader);
145 ## retrieve all author fields and collect them in a list
148 if ($intype eq "unimarc") {
149 ## Fields 700, 701, and 702 can contain author names
150 @author_fields = ($record->field('700'), $record->field('701'), $record->field('702'));
152 else { ## marc21, ukmarc
153 ## Field 100 sometimes carries main author
154 ## Field(s) 700 carry added entries - personal names
155 @author_fields = ($record->field('100'), $record->field('700'));
158 ## loop over all author fields
159 foreach my $field (@author_fields) {
160 if (length($field)) {
161 my $author = &get_author($field);
162 print "AU - ",$author,"\r\n";
166 # ToDo: should we specify anonymous as author if we didn't find
167 # one? or use one of the corporate/meeting names below?
169 ## add corporate names or meeting names as editors ??
172 if ($intype eq "unimarc") {
173 ## Fields 710, 711, and 712 can carry corporate names
174 ## Field(s) 720, 721, 722, 730 have additional candidates
175 @editor_fields = ($record->field('710'), $record->field('711'), $record->field('712'), $record->field('720'), $record->field('721'), $record->field('722'), $record->field('730'));
177 else { ## marc21, ukmarc
178 ## Fields 110 and 111 carry the main entries - corporate name and
179 ## meeting name, respectively
180 ## Field(s) 710, 711 carry added entries - personal names
181 @editor_fields = ($record->field('110'), $record->field('111'), $record->field('710'), $record->field('711'));
184 ## loop over all editor fields
185 foreach my $field (@editor_fields) {
186 if (length($field)) {
187 my $editor = &get_editor($field);
188 print "ED - ",$editor,"\r\n";
192 ## get info from the title field
193 if ($intype eq "unimarc") {
194 &print_title($record->field('200'));
196 else { ## marc21, ukmarc
197 &print_title($record->field('245'));
201 if ($intype eq "unimarc") {
202 &print_stitle($record->field('225'));
204 else { ## marc21, ukmarc
205 &print_stitle($record->field('490'));
209 if ($intype eq "unimarc") {
210 &print_isbn($record->field('010'));
211 &print_issn($record->field('011'));
213 elsif ($intype eq "ukmarc") {
214 &print_isbn($record->field('021'));
215 ## this is just an assumption
216 &print_issn($record->field('022'));
218 else { ## assume marc21
219 &print_isbn($record->field('020'));
220 &print_issn($record->field('022'));
223 if ($intype eq "marc21") {
224 &print_loc_callno($record->field('050'));
225 &print_dewey($record->field('082'));
227 ## else: unimarc, ukmarc do not seem to store call numbers?
230 if ($intype eq "unimarc") {
231 &print_pubinfo($record->field('210'));
233 else { ## marc21, ukmarc
234 if ($record->field('264')) {
235 &print_pubinfo($record->field('264'));
238 &print_pubinfo($record->field('260'));
242 ## 6XX fields contain KW candidates. We add all of them to a
245 if ($intype eq "unimarc") {
246 @field_list = ('600', '601', '602', '604', '605', '606','607', '608', '610', '615', '620', '660', '661', '670', '675', '676', '680', '686');
247 } elsif ($intype eq "ukmarc") {
248 @field_list = ('600', '610', '611', '630', '650', '651','653', '655', '660', '661', '668', '690', '691', '692', '695');
249 } else { ## assume marc21
250 @field_list = ('600', '610', '611', '630', '650', '651','653', '654', '655', '656', '657', '658');
254 for my $f ( @field_list ) {
255 my @fields = $record->field($f);
256 push @kwpool, ( get_keywords("$f",$record->field($f)) );
260 @kwpool = uniq @kwpool;
262 for my $kw ( @kwpool ) {
263 print "KW - ", $kw, "\r\n";
266 ## 5XX have various candidates for notes and abstracts. We pool
267 ## all notes-like stuff in one list.
270 ## these fields have notes candidates
271 if ($intype eq "unimarc") {
272 foreach ('300', '301', '302', '303', '304', '305', '306', '307', '308', '310', '311', '312', '313', '314', '315', '316', '317', '318', '320', '321', '322', '323', '324', '325', '326', '327', '328', '332', '333', '336', '337', '345') {
273 &pool_subx(\@notepool, $_, $record->field($_));
276 elsif ($intype eq "ukmarc") {
277 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') {
278 &pool_subx(\@notepool, $_, $record->field($_));
281 else { ## assume marc21
282 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') {
283 &pool_subx(\@notepool, $_, $record->field($_));
287 my $allnotes = join "; ", @notepool;
289 if (length($allnotes) > 0) {
290 print "N1 - ", $allnotes, "\r\n";
293 ## 320/520 have the abstract
294 if ($intype eq "unimarc") {
295 &print_abstract($record->field('320'));
297 elsif ($intype eq "ukmarc") {
298 &print_abstract($record->field('512'), $record->field('513'));
300 else { ## assume marc21
301 &print_abstract($record->field('520'));
305 if ($record->field('856')) {
306 print_uri($record->field('856'));
309 if ($ris_additional_fields) {
310 foreach my $ris_tag ( keys %$ris_additional_fields ) {
311 next if $ris_tag eq 'TY';
314 ref( $ris_additional_fields->{$ris_tag} ) eq 'ARRAY'
315 ? @{ $ris_additional_fields->{$ris_tag} }
316 : $ris_additional_fields->{$ris_tag};
318 for my $tag (@fields) {
319 my ( $f, $sf ) = split( /\$/, $tag );
320 my @values = read_field( { record => $record, field => $f, subfield => $sf } );
321 foreach my $v (@values) {
322 print "$ris_tag - $v\r\n";
331 # Let's re-redirect stdout
333 open STDOUT, ">&", $oldout;
340 ##********************************************************************
341 ## print_typetag(): prints the first line of a RIS dataset including
342 ## the preceding newline
343 ## Argument: the leader of a MARC dataset
344 ## Returns: the value at leader position 06
345 ##********************************************************************
348 ## the keys of typehash are the allowed values at position 06
349 ## of the leader of a MARC record, the values are the RIS types
350 ## that might appropriately represent these types.
384 ## The type of a MARC record is found at position 06 of the leader
385 my $typeofrecord = defined($leader) && length $leader >=6 ?
386 substr($leader, 6, 1): undef;
387 ## Pos 07 == Bibliographic level
388 my $biblevel = defined($leader) && length $leader >=7 ?
389 substr($leader, 7, 1): '';
391 ## TODO: for books, field 008 positions 24-27 might have a few more
395 my $marcflavour = C4::Context->preference("marcflavour");
396 my $intype = lc($marcflavour);
397 if ($intype eq "unimarc") {
398 %typehash = %unitypehash;
401 %typehash = %ustypehash;
404 if (!defined $typeofrecord || !exists $typehash{$typeofrecord}) {
405 print "TY - GEN\r\n"; ## most reasonable default
406 warn ("no type found - assume GEN") if $marcprint;
407 } elsif ( $typeofrecord =~ "a" ) {
408 if ( $biblevel eq 'a' ) {
409 print "TY - GEN\r\n"; ## monographic component part
410 } elsif ( $biblevel eq 'b' || $biblevel eq 's' ) {
411 print "TY - SER\r\n"; ## serial or serial component part
412 } elsif ( $biblevel eq 'm' ) {
413 print "TY - $typehash{$typeofrecord}\r\n"; ## book
414 } elsif ( $biblevel eq 'c' || $biblevel eq 'd' ) {
415 print "TY - GEN\r\n"; ## collections, part of collections or made-up collections
416 } elsif ( $biblevel eq 'i' ) {
417 print "TY - DATA\r\n"; ## updating loose-leafe as Dataset
420 print "TY - $typehash{$typeofrecord}\r\n";
423 ## use $typeofrecord as the return value, just in case
427 ##********************************************************************
428 ## normalize_author(): normalizes an authorname
429 ## Arguments: authorname subfield a
430 ## authorname subfield b
431 ## authorname subfield c
432 ## name type if known: 0=direct order
433 ## 1=only surname or full name in
435 ## 3=family, clan, dynasty name
436 ## Returns: the normalized authorname
437 ##********************************************************************
438 sub normalize_author {
439 my($rawauthora, $rawauthorb, $rawauthorc, $nametype) = @_;
441 if ($nametype == 0) {
442 # ToDo: convert every input to Last[,(F.|First)[ (M.|Middle)[,Suffix]]]
443 warn("name >>$rawauthora<< in direct order - leave as is") if $marcprint;
446 elsif ($nametype == 1) {
447 ## start munging subfield a (the real name part)
448 ## remove spaces after separators
449 $rawauthora =~ s%([,.]+) *%$1%g;
451 ## remove trailing separators after spaces
452 $rawauthora =~ s% *[,;:/]*$%%;
454 ## remove periods after a non-abbreviated name
455 $rawauthora =~ s%(\w{2,})\.%$1%g;
457 ## start munging subfield b (something like the suffix)
458 ## remove trailing separators after spaces
459 $rawauthorb =~ s% *[,;:/]*$%%;
461 ## we currently ignore subfield c until someone complains
462 if (length($rawauthorb) > 0) {
463 return join ", ", ($rawauthora, $rawauthorb);
469 elsif ($nametype == 3) {
474 ##********************************************************************
475 ## get_author(): gets authorname info from MARC fields 100, 700
476 ## Argument: field (100 or 700)
477 ## Returns: an author string in the format found in the record
478 ##********************************************************************
480 my ($authorfield) = @_;
483 ## the sequence of the name parts is encoded either in indicator
484 ## 1 (marc21) or 2 (unimarc)
485 my $marcflavour = C4::Context->preference("marcflavour");
486 my $intype = lc($marcflavour);
487 if ($intype eq "unimarc") {
490 else { ## assume marc21
494 print "<marc>:Author(Ind$indicator): ", $authorfield->indicator("$indicator"),"\r\n" if $marcprint;
495 print "<marc>:Author(\$a): ", $authorfield->subfield('a'),"\r\n" if $marcprint;
496 print "<marc>:Author(\$b): ", $authorfield->subfield('b'),"\r\n" if $marcprint;
497 print "<marc>:Author(\$c): ", $authorfield->subfield('c'),"\r\n" if $marcprint;
498 print "<marc>:Author(\$h): ", $authorfield->subfield('h'),"\r\n" if $marcprint;
499 if ($intype eq "ukmarc") {
500 my $authorname = $authorfield->subfield('a') . "," . $authorfield->subfield('h');
501 normalize_author($authorname, $authorfield->subfield('b'), $authorfield->subfield('c'), $authorfield->indicator("$indicator"));
504 normalize_author($authorfield->subfield('a') // '', $authorfield->subfield('b') // '', $authorfield->subfield('c') // '', $authorfield->indicator("$indicator"));
508 ##********************************************************************
509 ## get_editor(): gets editor info from MARC fields 110, 111, 710, 711
510 ## Argument: field (110, 111, 710, or 711)
511 ## Returns: an author string in the format found in the record
512 ##********************************************************************
514 my ($editorfield) = @_;
520 print "<marc>Editor(\$a): ", $editorfield->subfield('a'),"\r\n" if $marcprint;
521 print "<marc>Editor(\$b): ", $editorfield->subfield('b'),"\r\n" if $marcprint;
522 print "<marc>editor(\$c): ", $editorfield->subfield('c'),"\r\n" if $marcprint;
523 return $editorfield->subfield('a');
527 ##********************************************************************
528 ## print_title(): gets info from MARC field 245
529 ## Arguments: field (245)
531 ##********************************************************************
533 my ($titlefield) = @_;
535 print "<marc>empty title field (245)\r\n" if $marcprint;
536 warn("empty title field (245)") if $marcprint;
539 print "<marc>Title(\$a): ",$titlefield->subfield('a'),"\r\n" if $marcprint;
540 print "<marc>Title(\$b): ",$titlefield->subfield('b'),"\r\n" if $marcprint;
541 print "<marc>Title(\$c): ",$titlefield->subfield('c'),"\r\n" if $marcprint;
543 ## The title is usually written in a very odd notation. The title
544 ## proper ($a) often ends with a space followed by a separator like
545 ## a slash or a colon. The subtitle ($b) doesn't start with a space
546 ## so simple concatenation looks odd. We have to conditionally remove
547 ## the separator and make sure there's a space between title and
550 my $clean_title = $titlefield->subfield('a');
552 my $clean_subtitle = $titlefield->subfield('b');
553 $clean_subtitle ||= q{};
554 $clean_title =~ s% *[/:;.]$%%;
555 $clean_subtitle =~ s%^ *(.*) *[/:;.]$%$1%;
557 my $marcflavour = C4::Context->preference("marcflavour");
558 my $intype = lc($marcflavour);
559 if (length($clean_title) > 0
560 || (length($clean_subtitle) > 0 && $intype ne "unimarc")) {
561 print "TI - ", $clean_title;
563 ## subfield $b is relevant only for marc21/ukmarc
564 if (length($clean_subtitle) > 0 && $intype ne "unimarc") {
565 print ": ",$clean_subtitle;
570 ## The statement of responsibility is just this: horrors. There is
571 ## no formal definition how authors, editors and the like should
572 ## be written and designated. The field is free-form and resistant
573 ## to all parsing efforts, so this information is lost on me
578 ##********************************************************************
579 ## print_stitle(): prints info from series title field
582 ##********************************************************************
584 my ($titlefield) = @_;
587 print "<marc>empty series title field\r\n" if $marcprint;
590 print "<marc>Series title(\$a): ",$titlefield->subfield('a'),"\r\n" if $marcprint;
591 my $clean_title = $titlefield->subfield('a');
593 $clean_title =~ s% *[/:;.]$%%;
595 if (length($clean_title) > 0) {
596 print "T2 - ", $clean_title,"\r\n";
599 my $marcflavour = C4::Context->preference("marcflavour");
600 my $intype = lc($marcflavour);
601 if ($intype eq "unimarc") {
602 print "<marc>Series vol(\$v): ",$titlefield->subfield('v'),"\r\n" if $marcprint;
603 if (length($titlefield->subfield('v')) > 0) {
604 print "VL - ", $titlefield->subfield('v'),"\r\n";
611 ##********************************************************************
612 ## print_isbn(): gets info from MARC field 020
613 ## Arguments: field (020)
614 ##********************************************************************
618 if (!$isbnfield || length ($isbnfield->subfield('a')) == 0) {
619 print "<marc>no isbn found (020\$a)\r\n" if $marcprint;
620 warn("no isbn found") if $marcprint;
623 if (length ($isbnfield->subfield('a')) < 10) {
624 print "<marc>truncated isbn (020\$a)\r\n" if $marcprint;
625 warn("truncated isbn") if $marcprint;
628 my $isbn = $isbnfield->subfield('a');
629 print "SN - ", $isbn, "\r\n";
633 ##********************************************************************
634 ## print_issn(): gets info from MARC field 022
635 ## Arguments: field (022)
636 ##********************************************************************
640 if (!$issnfield || length ($issnfield->subfield('a')) == 0) {
641 print "<marc>no issn found (022\$a)\r\n" if $marcprint;
642 warn("no issn found") if $marcprint;
645 if (length ($issnfield->subfield('a')) < 9) {
646 print "<marc>truncated issn (022\$a)\r\n" if $marcprint;
647 warn("truncated issn") if $marcprint;
650 my $issn = substr($issnfield->subfield('a'), 0, 9);
651 print "SN - ", $issn, "\r\n";
656 # print_uri() prints info from 856 u
661 foreach my $f856 (@f856s) {
662 if (my $uri = $f856->subfield('u')) {
663 print "UR - ", $uri, "\r\n";
668 ##********************************************************************
669 ## print_loc_callno(): gets info from MARC field 050
670 ## Arguments: field (050)
671 ##********************************************************************
672 sub print_loc_callno {
673 my($callnofield) = @_;
675 if (!$callnofield || length ($callnofield->subfield('a')) == 0) {
676 print "<marc>no LOC call number found (050\$a)\r\n" if $marcprint;
677 warn("no LOC call number found") if $marcprint;
680 print "AV - ", $callnofield->subfield('a'), " ", $callnofield->subfield('b'), "\r\n";
684 ##********************************************************************
685 ## print_dewey(): gets info from MARC field 082
686 ## Arguments: field (082)
687 ##********************************************************************
689 my($deweyfield) = @_;
691 if (!$deweyfield || length ($deweyfield->subfield('a')) == 0) {
692 print "<marc>no Dewey number found (082\$a)\r\n" if $marcprint;
693 warn("no Dewey number found") if $marcprint;
696 print "U1 - ", $deweyfield->subfield('a'), " ", $deweyfield->subfield('2'), "\r\n";
700 ##********************************************************************
701 ## print_pubinfo(): gets info from MARC field 260
702 ## Arguments: field (260)
703 ##********************************************************************
705 my($pubinfofield) = @_;
707 if (!$pubinfofield) {
708 print "<marc>no publication information found (260/264)\r\n" if $marcprint;
709 warn("no publication information found") if $marcprint;
712 ## the following information is available in MARC21:
714 ## $b publisher -> PB
716 ## the corresponding subfields for UNIMARC:
718 ## $c publisher -> PB
721 ## all of them are repeatable. We pool all places into a
722 ## comma-separated list in CY. We also pool all publishers
723 ## into a comma-separated list in PB. We break the rule with
724 ## the date field because this wouldn't make much sense. In
725 ## this case, we use the first occurrence for PY, the second
726 ## for Y2, and ignore the rest
728 my @pubsubfields = $pubinfofield->subfields();
734 my $pubsub_publisher;
737 my $marcflavour = C4::Context->preference("marcflavour");
738 my $intype = lc($marcflavour);
739 if ($intype eq "unimarc") {
741 $pubsub_publisher = "c";
744 else { ## assume marc21
746 $pubsub_publisher = "b";
750 ## loop over all subfield list entries
751 for my $tuple (@pubsubfields) {
752 ## each tuple consists of the subfield code and the value
753 if (@$tuple[0] eq $pubsub_place) {
754 ## strip any trailing crap
757 ## pool all occurrences in a list
760 elsif (@$tuple[0] eq $pubsub_publisher) {
761 ## strip any trailing crap
764 ## pool all occurrences in a list
765 push (@publishers, $_);
767 elsif (@$tuple[0] eq $pubsub_date) {
768 ## the dates are free-form, so we want to extract
769 ## a four-digit year and leave the rest as
771 my $protoyear = @$tuple[1];
772 print "<marc>Year (260\$c): $protoyear\r\n" if $marcprint;
774 ## strip any separator chars at the end
775 $protoyear =~ s% *[\.;:/]*$%%;
777 ## isolate a four-digit year. We discard anything
778 ## preceding the year, but keep everything after
779 ## the year as other info.
780 $protoyear =~ s%\D*([0-9\-]{4})(.*)%$1///$2%;
782 ## check what we've got. If there is no four-digit
783 ## year, make it up. If digits are replaced by '-',
784 ## replace those with 0s
786 if (index($protoyear, "/") == 4) {
788 ## replace all '-' in the four-digit year
790 substr($protoyear,0,4) =~ s!-!0!g;
794 print "<marc>no four-digit year found, use 0000\r\n" if $marcprint;
795 $protoyear = "0000///$protoyear";
796 warn("no four-digit year found, use 0000") if $marcprint;
799 if ($pycounter == 0 && length($protoyear)) {
800 print "PY - $protoyear\r\n";
802 elsif ($pycounter == 1 && length($_)) {
803 print "Y2 - $protoyear\r\n";
810 ## now dump the collected CY and PB lists
812 print "CY - ", join(", ", @cities), "\r\n";
814 if (@publishers > 0) {
815 print "PB - ", join(", ", @publishers), "\r\n";
820 ##********************************************************************
821 ## get_keywords(): prints info from MARC fields 6XX
822 ## Arguments: list of fields (6XX)
823 ##********************************************************************
825 my($fieldname, @keywords) = @_;
828 ## a list of all possible subfields
829 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');
831 ## loop over all 6XX fields
832 foreach my $kwfield (@keywords) {
833 if ($kwfield != undef) {
834 ## authornames get special treatment
835 if ($fieldname eq "600") {
836 my $val = normalize_author($kwfield->subfield('a'), $kwfield->subfield('b'), $kwfield->subfield('c'), $kwfield->indicator('1'));
838 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;
841 ## retrieve all available subfields
842 my @kwsubfields = $kwfield->subfields();
844 ## loop over all available subfield tuples
845 foreach my $kwtuple (@kwsubfields) {
846 ## loop over all subfields to check
847 foreach my $subfield (@subfields) {
848 ## [0] contains subfield code
849 if (@$kwtuple[0] eq $subfield) {
850 ## [1] contains value, remove trailing separators
851 @$kwtuple[1] =~ s% *[,;.:/]*$%%;
852 if (length(@$kwtuple[1]) > 0) {
853 push @kw, @$kwtuple[1];
854 print "<marc>Field $fieldname subfield $subfield:", @$kwtuple[1], "\r\n" if $marcprint;
856 ## we can leave the subfields loop here
867 ##********************************************************************
868 ## pool_subx(): adds contents of several subfields to a list
869 ## Arguments: reference to a list
871 ## list of fields (5XX)
872 ##********************************************************************
874 my($aref, $fieldname, @notefields) = @_;
876 ## we use a list that contains the interesting subfields
878 # ToDo: this is apparently correct only for marc21
881 if ($fieldname eq "500") {
884 elsif ($fieldname eq "501") {
887 elsif ($fieldname eq "502") {
890 elsif ($fieldname eq "504") {
891 @subfields = ('a', 'b');
893 elsif ($fieldname eq "505") {
894 @subfields = ('a', 'g', 'r', 't', 'u');
896 elsif ($fieldname eq "506") {
897 @subfields = ('a', 'b', 'c', 'd', 'e');
899 elsif ($fieldname eq "507") {
900 @subfields = ('a', 'b');
902 elsif ($fieldname eq "508") {
905 elsif ($fieldname eq "510") {
906 @subfields = ('a', 'b', 'c', 'x', '3');
908 elsif ($fieldname eq "511") {
911 elsif ($fieldname eq "513") {
912 @subfields = ('a', 'b');
914 elsif ($fieldname eq "514") {
915 @subfields = ('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'm', 'u', 'z');
917 elsif ($fieldname eq "515") {
920 elsif ($fieldname eq "516") {
923 elsif ($fieldname eq "518") {
924 @subfields = ('a', '3');
926 elsif ($fieldname eq "521") {
927 @subfields = ('a', 'b', '3');
929 elsif ($fieldname eq "522") {
932 elsif ($fieldname eq "524") {
933 @subfields = ('a', '2', '3');
935 elsif ($fieldname eq "525") {
938 elsif ($fieldname eq "526") {
939 @subfields = ('a', 'b', 'c', 'd', 'i', 'x', 'z', '5');
941 elsif ($fieldname eq "530") {
942 @subfields = ('a', 'b', 'c', 'd', 'u', '3');
944 elsif ($fieldname eq "533") {
945 @subfields = ('a', 'b', 'c', 'd', 'e', 'f', 'm', 'n', '3');
947 elsif ($fieldname eq "534") {
948 @subfields = ('a', 'b', 'c', 'e', 'f', 'k', 'l', 'm', 'n', 'p', 't', 'x', 'z');
950 elsif ($fieldname eq "535") {
951 @subfields = ('a', 'b', 'c', 'd', 'g', '3');
954 ## loop over all notefields
955 foreach my $notefield (@notefields) {
956 if (defined $notefield) {
957 ## retrieve all available subfield tuples
958 my @notesubfields = $notefield->subfields();
960 ## loop over all subfield tuples
961 foreach my $notetuple (@notesubfields) {
962 ## loop over all subfields to check
963 foreach my $subfield (@subfields) {
964 ## [0] contains subfield code
965 if (@$notetuple[0] eq $subfield) {
966 ## [1] contains value, remove trailing separators
967 print "<marc>field $fieldname subfield $subfield: ", @$notetuple[1], "\r\n" if $marcprint;
968 @$notetuple[1] =~ s% *[,;.:/]*$%%;
969 if (length(@$notetuple[1]) > 0) {
971 push @{$aref}, @$notetuple[1];
981 ##********************************************************************
982 ## print_abstract(): prints abstract fields
983 ## Arguments: list of fields (520)
984 ##********************************************************************
986 # ToDo: take care of repeatable subfields
989 ## we check the following subfields
990 my @subfields = ('a', 'b');
992 ## we generate a list for all useful strings
995 ## loop over all abfields
996 foreach my $abfield (@abfields) {
997 foreach my $field (@subfields) {
998 if ( length( $abfield->subfield($field) ) > 0 ) {
999 my $ab = $abfield->subfield($field);
1001 print "<marc>field 520 subfield $field: $ab\r\n" if $marcprint;
1003 ## strip trailing separators
1004 $ab =~ s% *[;,:./]*$%%;
1006 ## add string to the list
1007 push( @abstrings, $ab );
1012 my $allabs = join "; ", @abstrings;
1014 if (length($allabs) > 0) {
1015 print "N2 - ", $allabs, "\r\n";