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
43 # This file is part of Koha.
45 # Koha is free software; you can redistribute it and/or modify it under the
46 # terms of the GNU General Public License as published by the Free Software
47 # Foundation; either version 2 of the License, or (at your option) any later
50 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
51 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
52 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
54 # You should have received a copy of the GNU General Public License along with
55 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
56 # Suite 330, Boston, MA 02111-1307 USA
61 #use warnings; FIXME - Bug 2505
63 use vars qw($VERSION @ISA @EXPORT);
65 # set the version for version checking
70 # only export API methods
77 =head1 marc2bibtex - Convert from UNIMARC to RIS
79 my ($ris) = marc2ris($record);
83 C<$record> - a MARC::Record object
91 my $marcflavour = C4::Context->preference("marcflavour");
92 my $intype = lc($marcflavour);
93 my $marcprint = 0; # Debug flag;
95 # Let's redirect stdout
96 open my $oldout, ">&STDOUT";
99 open STDOUT,'>', \$outvar;
102 ## First we should check the character encoding. This may be
103 ## MARC-8 or UTF-8. The former is indicated by a blank, the latter
104 ## by 'a' at position 09 (zero-based) of the leader
105 my $leader = $record->leader();
106 if ($intype eq "marc21") {
107 if ($leader =~ /^.{9}a/) {
108 print "<marc>---\r\n<marc>UTF-8 data\r\n" if $marcprint;
112 print "<marc>---\r\n<marc>MARC-8 data\r\n" if $marcprint;
115 ## else: other MARC formats do not specify the character encoding
116 ## we assume it's *not* UTF-8
119 &print_typetag($leader);
121 ## retrieve all author fields and collect them in a list
124 if ($intype eq "unimarc") {
125 ## Fields 700, 701, and 702 can contain author names
126 @author_fields = ($record->field('700'), $record->field('701'), $record->field('702'));
128 else { ## marc21, ukmarc
129 ## Field 100 sometimes carries main author
130 ## Field(s) 700 carry added entries - personal names
131 @author_fields = ($record->field('100'), $record->field('700'));
134 ## loop over all author fields
135 foreach my $field (@author_fields) {
136 if (length($field)) {
137 my $author = &get_author($field);
138 print "AU - ",&charconv($author),"\r\n";
142 # ToDo: should we specify anonymous as author if we didn't find
143 # one? or use one of the corporate/meeting names below?
145 ## add corporate names or meeting names as editors ??
148 if ($intype eq "unimarc") {
149 ## Fields 710, 711, and 712 can carry corporate names
150 ## Field(s) 720, 721, 722, 730 have additional candidates
151 @editor_fields = ($record->field('710'), $record->field('711'), $record->field('712'), $record->field('720'), $record->field('721'), $record->field('722'), $record->field('730'));
153 else { ## marc21, ukmarc
154 ## Fields 110 and 111 carry the main entries - corporate name and
155 ## meeting name, respectively
156 ## Field(s) 710, 711 carry added entries - personal names
157 @editor_fields = ($record->field('110'), $record->field('111'), $record->field('710'), $record->field('711'));
160 ## loop over all editor fields
161 foreach my $field (@editor_fields) {
162 if (length($field)) {
163 my $editor = &get_editor($field);
164 print "ED - ",&charconv($editor),"\r\n";
168 ## get info from the title field
169 if ($intype eq "unimarc") {
170 &print_title($record->field('200'));
172 else { ## marc21, ukmarc
173 &print_title($record->field('245'));
177 if ($intype eq "unimarc") {
178 &print_stitle($record->field('225'));
180 else { ## marc21, ukmarc
181 &print_stitle($record->field('490'));
185 if ($intype eq "unimarc") {
186 &print_isbn($record->field('010'));
187 &print_issn($record->field('011'));
189 elsif ($intype eq "ukmarc") {
190 &print_isbn($record->field('021'));
191 ## this is just an assumption
192 &print_issn($record->field('022'));
194 else { ## assume marc21
195 &print_isbn($record->field('020'));
196 &print_issn($record->field('022'));
199 if ($intype eq "marc21") {
200 &print_loc_callno($record->field('050'));
201 &print_dewey($record->field('082'));
203 ## else: unimarc, ukmarc do not seem to store call numbers?
206 if ($intype eq "unimarc") {
207 &print_pubinfo($record->field('210'));
209 else { ## marc21, ukmarc
210 &print_pubinfo($record->field('260'));
213 ## 6XX fields contain KW candidates. We add all of them to a
214 ## hash to eliminate duplicates
217 if ($intype eq "unimarc") {
218 foreach ('600', '601', '602', '604', '605', '606','607', '608', '610', '615', '620', '660'. '661', '670', '675', '676', '680', '686') {
219 &get_keywords(\%kwpool, "$_",$record->field($_));
222 elsif ($intype eq "ukmarc") {
223 foreach ('600', '610', '611', '630', '650', '651','653', '655', '660', '661', '668', '690', '691', '692', '695') {
224 &get_keywords(\%kwpool, "$_",$record->field($_));
227 else { ## assume marc21
228 foreach ('600', '610', '611', '630', '650', '651','653', '654', '655', '656', '657', '658') {
229 &get_keywords(\%kwpool, "$_",$record->field($_));
233 ## print all keywords found in the hash. The value of each hash
234 ## entry is the number of occurrences, but we're not really interested
235 ## in that and rather print the key
236 while (my ($key, $value) = each %kwpool) {
237 print "KW - ", &charconv($key), "\r\n";
240 ## 5XX have various candidates for notes and abstracts. We pool
241 ## all notes-like stuff in one list.
244 ## these fields have notes candidates
245 if ($intype eq "unimarc") {
246 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') {
247 &pool_subx(\@notepool, $_, $record->field($_));
250 elsif ($intype eq "ukmarc") {
251 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') {
252 &pool_subx(\@notepool, $_, $record->field($_));
255 else { ## assume marc21
256 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') {
257 &pool_subx(\@notepool, $_, $record->field($_));
261 my $allnotes = join "; ", @notepool;
263 if (length($allnotes) > 0) {
264 print "N1 - ", &charconv($allnotes), "\r\n";
267 ## 320/520 have the abstract
268 if ($intype eq "unimarc") {
269 &print_abstract($record->field('320'));
271 elsif ($intype eq "ukmarc") {
272 &print_abstract($record->field('512'), $record->field('513'));
274 else { ## assume marc21
275 &print_abstract($record->field('520'));
281 # Let's re-redirect stdout
283 open STDOUT, ">&", $oldout;
290 ##********************************************************************
291 ## print_typetag(): prints the first line of a RIS dataset including
292 ## the preceeding newline
293 ## Argument: the leader of a MARC dataset
294 ## Returns: the value at leader position 06
295 ##********************************************************************
298 ## the keys of typehash are the allowed values at position 06
299 ## of the leader of a MARC record, the values are the RIS types
300 ## that might appropriately represent these types.
334 ## The type of a MARC record is found at position 06 of the leader
335 my $typeofrecord = substr($leader, 6, 1);
337 ## ToDo: for books, field 008 positions 24-27 might have a few more
342 ## the ukmarc here is just a guess
343 if ($intype eq "marc21" || $intype eq "ukmarc") {
344 %typehash = %ustypehash;
346 elsif ($intype eq "unimarc") {
347 %typehash = %unitypehash;
350 ## assume MARC21 as default
351 %typehash = %ustypehash;
354 if (!exists $typehash{$typeofrecord}) {
355 print "TY - BOOK\r\n"; ## most reasonable default
356 warn ("no type found - assume BOOK") if $marcprint;
359 print "TY - $typehash{$typeofrecord}\r\n";
362 ## use $typeofrecord as the return value, just in case
366 ##********************************************************************
367 ## normalize_author(): normalizes an authorname
368 ## Arguments: authorname subfield a
369 ## authorname subfield b
370 ## authorname subfield c
371 ## name type if known: 0=direct order
372 ## 1=only surname or full name in
374 ## 3=family, clan, dynasty name
375 ## Returns: the normalized authorname
376 ##********************************************************************
377 sub normalize_author {
378 my($rawauthora, $rawauthorb, $rawauthorc, $nametype) = @_;
380 if ($nametype == 0) {
381 # ToDo: convert every input to Last[,(F.|First)[ (M.|Middle)[,Suffix]]]
382 warn("name >>$rawauthora<< in direct order - leave as is") if $marcprint;
385 elsif ($nametype == 1) {
386 ## start munging subfield a (the real name part)
387 ## remove spaces after separators
388 $rawauthora =~ s%([,.]+) *%$1%g;
390 ## remove trailing separators after spaces
391 $rawauthora =~ s% *[,;:/]*$%%;
393 ## remove periods after a non-abbreviated name
394 $rawauthora =~ s%(\w{2,})\.%$1%g;
396 ## start munging subfield b (something like the suffix)
397 ## remove trailing separators after spaces
398 $rawauthorb =~ s% *[,;:/]*$%%;
400 ## we currently ignore subfield c until someone complains
401 if (length($rawauthorb) > 0) {
402 return join ",", ($rawauthora, $rawauthorb);
408 elsif ($nametype == 3) {
413 ##********************************************************************
414 ## get_author(): gets authorname info from MARC fields 100, 700
415 ## Argument: field (100 or 700)
416 ## Returns: an author string in the format found in the record
417 ##********************************************************************
419 my ($authorfield) = @_;
422 ## the sequence of the name parts is encoded either in indicator
423 ## 1 (marc21) or 2 (unimarc)
424 if ($intype eq "unimarc") {
427 else { ## assume marc21
431 print "<marc>:Author(Ind$indicator): ", $authorfield->indicator("$indicator"),"\r\n" if $marcprint;
432 print "<marc>:Author(\$a): ", $authorfield->subfield('a'),"\r\n" if $marcprint;
433 print "<marc>:Author(\$b): ", $authorfield->subfield('b'),"\r\n" if $marcprint;
434 print "<marc>:Author(\$c): ", $authorfield->subfield('c'),"\r\n" if $marcprint;
435 print "<marc>:Author(\$h): ", $authorfield->subfield('h'),"\r\n" if $marcprint;
436 if ($intype eq "ukmarc") {
437 my $authorname = $authorfield->subfield('a') . "," . $authorfield->subfield('h');
438 normalize_author($authorname, $authorfield->subfield('b'), $authorfield->subfield('c'), $authorfield->indicator("$indicator"));
441 normalize_author($authorfield->subfield('a'), $authorfield->subfield('b'), $authorfield->subfield('c'), $authorfield->indicator("$indicator"));
445 ##********************************************************************
446 ## get_editor(): gets editor info from MARC fields 110, 111, 710, 711
447 ## Argument: field (110, 111, 710, or 711)
448 ## Returns: an author string in the format found in the record
449 ##********************************************************************
451 my ($editorfield) = @_;
457 print "<marc>Editor(\$a): ", $editorfield->subfield('a'),"\r\n" if $marcprint;
458 print "<marc>Editor(\$b): ", $editorfield->subfield('b'),"\r\n" if $marcprint;
459 print "<marc>editor(\$c): ", $editorfield->subfield('c'),"\r\n" if $marcprint;
460 return $editorfield->subfield('a');
464 ##********************************************************************
465 ## print_title(): gets info from MARC field 245
466 ## Arguments: field (245)
468 ##********************************************************************
470 my ($titlefield) = @_;
472 print "<marc>empty title field (245)\r\n" if $marcprint;
473 warn("empty title field (245)") if $marcprint;
476 print "<marc>Title(\$a): ",$titlefield->subfield('a'),"\r\n" if $marcprint;
477 print "<marc>Title(\$b): ",$titlefield->subfield('b'),"\r\n" if $marcprint;
478 print "<marc>Title(\$c): ",$titlefield->subfield('c'),"\r\n" if $marcprint;
480 ## The title is usually written in a very odd notation. The title
481 ## proper ($a) often ends with a space followed by a separator like
482 ## a slash or a colon. The subtitle ($b) doesn't start with a space
483 ## so simple concatenation looks odd. We have to conditionally remove
484 ## the separator and make sure there's a space between title and
487 my $clean_title = $titlefield->subfield('a');
489 my $clean_subtitle = $titlefield->subfield('b');
490 $clean_title =~ s% *[/:;.]$%%;
491 $clean_subtitle =~ s%^ *(.*) *[/:;.]$%$1%;
493 if (length($clean_title) > 0
494 || (length($clean_subtitle) > 0 && $intype ne "unimarc")) {
495 print "TI - ", &charconv($clean_title);
497 ## subfield $b is relevant only for marc21/ukmarc
498 if (length($clean_subtitle) > 0 && $intype ne "unimarc") {
499 print ": ",&charconv($clean_subtitle);
504 ## The statement of responsibility is just this: horrors. There is
505 ## no formal definition how authors, editors and the like should
506 ## be written and designated. The field is free-form and resistant
507 ## to all parsing efforts, so this information is lost on me
511 ##********************************************************************
512 ## print_stitle(): prints info from series title field
515 ##********************************************************************
517 my ($titlefield) = @_;
520 print "<marc>empty series title field\r\n" if $marcprint;
523 print "<marc>Series title(\$a): ",$titlefield->subfield('a'),"\r\n" if $marcprint;
524 my $clean_title = $titlefield->subfield('a');
526 $clean_title =~ s% *[/:;.]$%%;
528 if (length($clean_title) > 0) {
529 print "T2 - ", &charconv($clean_title),"\r\n";
532 if ($intype eq "unimarc") {
533 print "<marc>Series vol(\$v): ",$titlefield->subfield('v'),"\r\n" if $marcprint;
534 if (length($titlefield->subfield('v')) > 0) {
535 print "VL - ", &charconv($titlefield->subfield('v')),"\r\n";
541 ##********************************************************************
542 ## print_isbn(): gets info from MARC field 020
543 ## Arguments: field (020)
544 ##********************************************************************
548 if (!$isbnfield || length ($isbnfield->subfield('a')) == 0) {
549 print "<marc>no isbn found (020\$a)\r\n" if $marcprint;
550 warn("no isbn found") if $marcprint;
553 if (length ($isbnfield->subfield('a')) < 10) {
554 print "<marc>truncated isbn (020\$a)\r\n" if $marcprint;
555 warn("truncated isbn") if $marcprint;
558 my $isbn = substr($isbnfield->subfield('a'), 0, 10);
559 print "SN - ", &charconv($isbn), "\r\n";
563 ##********************************************************************
564 ## print_issn(): gets info from MARC field 022
565 ## Arguments: field (022)
566 ##********************************************************************
570 if (!$issnfield || length ($issnfield->subfield('a')) == 0) {
571 print "<marc>no issn found (022\$a)\r\n" if $marcprint;
572 warn("no issn found") if $marcprint;
575 if (length ($issnfield->subfield('a')) < 9) {
576 print "<marc>truncated issn (022\$a)\r\n" if $marcprint;
577 warn("truncated issn") if $marcprint;
580 my $issn = substr($issnfield->subfield('a'), 0, 9);
581 print "SN - ", &charconv($issn), "\r\n";
585 ##********************************************************************
586 ## print_loc_callno(): gets info from MARC field 050
587 ## Arguments: field (050)
588 ##********************************************************************
589 sub print_loc_callno {
590 my($callnofield) = @_;
592 if (!$callnofield || length ($callnofield->subfield('a')) == 0) {
593 print "<marc>no LOC call number found (050\$a)\r\n" if $marcprint;
594 warn("no LOC call number found") if $marcprint;
597 print "AV - ", &charconv($callnofield->subfield('a')), " ", &charconv($callnofield->subfield('b')), "\r\n";
601 ##********************************************************************
602 ## print_dewey(): gets info from MARC field 082
603 ## Arguments: field (082)
604 ##********************************************************************
606 my($deweyfield) = @_;
608 if (!$deweyfield || length ($deweyfield->subfield('a')) == 0) {
609 print "<marc>no Dewey number found (082\$a)\r\n" if $marcprint;
610 warn("no Dewey number found") if $marcprint;
613 print "U1 - ", &charconv($deweyfield->subfield('a')), " ", &charconv($deweyfield->subfield('2')), "\r\n";
617 ##********************************************************************
618 ## print_pubinfo(): gets info from MARC field 260
619 ## Arguments: field (260)
620 ##********************************************************************
622 my($pubinfofield) = @_;
624 if (!$pubinfofield) {
625 print "<marc>no publication information found (260)\r\n" if $marcprint;
626 warn("no publication information found") if $marcprint;
629 ## the following information is available in MARC21:
631 ## $b publisher -> PB
633 ## the corresponding subfields for UNIMARC:
635 ## $c publisher -> PB
638 ## all of them are repeatable. We pool all places into a
639 ## comma-separated list in CY. We also pool all publishers
640 ## into a comma-separated list in PB. We break the rule with
641 ## the date field because this wouldn't make much sense. In
642 ## this case, we use the first occurrence for PY, the second
643 ## for Y2, and ignore the rest
645 my @pubsubfields = $pubinfofield->subfields();
651 my $pubsub_publisher;
654 if ($intype eq "unimarc") {
656 $pubsub_publisher = "c";
659 else { ## assume marc21
661 $pubsub_publisher = "b";
665 ## loop over all subfield list entries
666 for my $tuple (@pubsubfields) {
667 ## each tuple consists of the subfield code and the value
668 if (@$tuple[0] eq $pubsub_place) {
669 ## strip any trailing crap
672 ## pool all occurrences in a list
675 elsif (@$tuple[0] eq $pubsub_publisher) {
676 ## strip any trailing crap
679 ## pool all occurrences in a list
680 push (@publishers, $_);
682 elsif (@$tuple[0] eq $pubsub_date) {
683 ## the dates are free-form, so we want to extract
684 ## a four-digit year and leave the rest as
686 $protoyear = @$tuple[1];
687 print "<marc>Year (260\$c): $protoyear\r\n" if $marcprint;
689 ## strip any separator chars at the end
690 $protoyear =~ s% *[\.;:/]*$%%;
692 ## isolate a four-digit year. We discard anything
693 ## preceeding the year, but keep everything after
694 ## the year as other info.
695 $protoyear =~ s%\D*([0-9\-]{4})(.*)%$1///$2%;
697 ## check what we've got. If there is no four-digit
698 ## year, make it up. If digits are replaced by '-',
699 ## replace those with 0s
701 if (index($protoyear, "/") == 4) {
703 ## replace all '-' in the four-digit year
705 substr($protoyear,0,4) =~ s!-!0!g;
709 print "<marc>no four-digit year found, use 0000\r\n" if $marcprint;
710 $protoyear = "0000///$protoyear";
711 warn("no four-digit year found, use 0000") if $marcprint;
714 if ($pycounter == 0 && length($protoyear)) {
715 print "PY - $protoyear\r\n";
717 elsif ($pycounter == 1 && length($_)) {
718 print "Y2 - $protoyear\r\n";
725 ## now dump the collected CY and PB lists
727 print "CY - ", &charconv(join(", ", @cities)), "\r\n";
729 if (@publishers > 0) {
730 print "PB - ", &charconv(join(", ", @publishers)), "\r\n";
735 ##********************************************************************
736 ## get_keywords(): prints info from MARC fields 6XX
737 ## Arguments: list of fields (6XX)
738 ##********************************************************************
740 my($href, $fieldname, @keywords) = @_;
742 ## a list of all possible subfields
743 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');
745 ## loop over all 6XX fields
746 foreach $kwfield (@keywords) {
747 if ($kwfield != undef) {
748 ## authornames get special treatment
749 if ($fieldname eq "600") {
750 my $val = normalize_author($kwfield->subfield('a'), $kwfield->subfield('b'), $kwfield->subfield('c'), $kwfield->indicator('1'));
752 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;
755 ## retrieve all available subfields
756 @kwsubfields = $kwfield->subfields();
758 ## loop over all available subfield tuples
759 foreach $kwtuple (@kwsubfields) {
760 ## loop over all subfields to check
761 foreach $subfield (@subfields) {
762 ## [0] contains subfield code
763 if (@$kwtuple[0] eq $subfield) {
764 ## [1] contains value, remove trailing separators
765 @$kwtuple[1] =~ s% *[,;.:/]*$%%;
766 if (length(@$kwtuple[1]) > 0) {
768 ${$href}{@$kwtuple[1]} += 1;
769 print "<marc>Field $fieldname subfield $subfield:", @$kwtuple[1], "\r\n" if $marcprint;
771 ## we can leave the subfields loop here
781 ##********************************************************************
782 ## pool_subx(): adds contents of several subfields to a list
783 ## Arguments: reference to a list
785 ## list of fields (5XX)
786 ##********************************************************************
788 my($aref, $fieldname, @notefields) = @_;
790 ## we use a list that contains the interesting subfields
792 # ToDo: this is apparently correct only for marc21
795 if ($fieldname eq "500") {
798 elsif ($fieldname eq "501") {
801 elsif ($fieldname eq "502") {
804 elsif ($fieldname eq "504") {
805 @subfields = ('a', 'b');
807 elsif ($fieldname eq "505") {
808 @subfields = ('a', 'g', 'r', 't', 'u');
810 elsif ($fieldname eq "506") {
811 @subfields = ('a', 'b', 'c', 'd', 'e');
813 elsif ($fieldname eq "507") {
814 @subfields = ('a', 'b');
816 elsif ($fieldname eq "508") {
819 elsif ($fieldname eq "510") {
820 @subfields = ('a', 'b', 'c', 'x', '3');
822 elsif ($fieldname eq "511") {
825 elsif ($fieldname eq "513") {
826 @subfields = ('a', 'b');
828 elsif ($fieldname eq "514") {
829 @subfields = ('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'm', 'u', 'z');
831 elsif ($fieldname eq "515") {
834 elsif ($fieldname eq "516") {
837 elsif ($fieldname eq "518") {
838 @subfields = ('a', '3');
840 elsif ($fieldname eq "521") {
841 @subfields = ('a', 'b', '3');
843 elsif ($fieldname eq "522") {
846 elsif ($fieldname eq "524") {
847 @subfields = ('a', '2', '3');
849 elsif ($fieldname eq "525") {
852 elsif ($fieldname eq "526") {
853 @subfields = ('a', 'b', 'c', 'd', 'i', 'x', 'z', '5');
855 elsif ($fieldname eq "530") {
856 @subfields = ('a', 'b', 'c', 'd', 'u', '3');
858 elsif ($fieldname eq "533") {
859 @subfields = ('a', 'b', 'c', 'd', 'e', 'f', 'm', 'n', '3');
861 elsif ($fieldname eq "534") {
862 @subfields = ('a', 'b', 'c', 'e', 'f', 'k', 'l', 'm', 'n', 'p', 't', 'x', 'z');
864 elsif ($fieldname eq "535") {
865 @subfields = ('a', 'b', 'c', 'd', 'g', '3');
868 ## loop over all notefields
869 foreach $notefield (@notefields) {
870 if ($notefield != undef) {
871 ## retrieve all available subfield tuples
872 @notesubfields = $notefield->subfields();
874 ## loop over all subfield tuples
875 foreach $notetuple (@notesubfields) {
876 ## loop over all subfields to check
877 foreach $subfield (@subfields) {
878 ## [0] contains subfield code
879 if (@$notetuple[0] eq $subfield) {
880 ## [1] contains value, remove trailing separators
881 print "<marc>field $fieldname subfield $subfield: ", @$notetuple[1], "\r\n" if $marcprint;
882 @$notetuple[1] =~ s% *[,;.:/]*$%%;
883 if (length(@$notetuple[1]) > 0) {
885 push @{$aref}, @$notetuple[1];
895 ##********************************************************************
896 ## print_abstract(): prints abstract fields
897 ## Arguments: list of fields (520)
898 ##********************************************************************
900 # ToDo: take care of repeatable subfields
903 ## we check the following subfields
904 my @subfields = ('a', 'b');
906 ## we generate a list for all useful strings
909 ## loop over all abfields
910 foreach $abfield (@abfields) {
911 foreach $field (@subfields) {
912 if (length ($abfield->subfield($field)) > 0) {
913 my $ab = $abfield->subfield($field);
915 print "<marc>field 520 subfield $field: $ab\r\n" if $marcprint;
917 ## strip trailing separators
918 $ab =~ s% *[;,:./]*$%%;
920 ## add string to the list
921 push (@abstrings, $ab);
926 my $allabs = join "; ", @abstrings;
928 if (length($allabs) > 0) {
929 print "N2 - ", &charconv($allabs), "\r\n";
934 ##********************************************************************
935 ## charconv(): converts to a different charset based on a global var
938 ##********************************************************************
941 ## return unaltered if already utf-8
944 elsif ($uniout eq "t") {
946 return marc8_to_utf8("@_");
949 ## return unaltered if no utf-8 requested