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 =head2 marc2bibtex - Convert from UNIMARC to RIS
81 my ($ris) = marc2ris($record);
87 C<$record> - a MARC::Record object
99 my $marcflavour = C4::Context->preference("marcflavour");
100 my $intype = lc($marcflavour);
101 my $marcprint = 1; # Debug
103 # Let's redirect stdout
104 open my $oldout, ">&STDOUT";
107 open STDOUT,'>', \$outvar;
110 ## First we should check the character encoding. This may be
111 ## MARC-8 or UTF-8. The former is indicated by a blank, the latter
112 ## by 'a' at position 09 (zero-based) of the leader
113 my $leader = $record->leader();
114 if ($intype eq "marc21") {
115 if ($leader =~ /^.{9}a/) {
116 print "<marc>---\n<marc>UTF-8 data\n" if $marcprint;
120 print "<marc>---\n<marc>MARC-8 data\n" if $marcprint;
123 ## else: other MARC formats do not specify the character encoding
124 ## we assume it's *not* UTF-8
127 &print_typetag($leader);
129 ## retrieve all author fields and collect them in a list
132 if ($intype eq "unimarc") {
133 ## Fields 700, 701, and 702 can contain author names
134 @author_fields = ($record->field('700'), $record->field('701'), $record->field('702'));
136 else { ## marc21, ukmarc
137 ## Field 100 sometimes carries main author
138 ## Field(s) 700 carry added entries - personal names
139 @author_fields = ($record->field('100'), $record->field('700'));
142 ## loop over all author fields
143 foreach my $field (@author_fields) {
144 if (length($field)) {
145 my $author = &get_author($field);
146 print "AU - ",&charconv($author),"\n";
150 # ToDo: should we specify anonymous as author if we didn't find
151 # one? or use one of the corporate/meeting names below?
153 ## add corporate names or meeting names as editors ??
156 if ($intype eq "unimarc") {
157 ## Fields 710, 711, and 712 can carry corporate names
158 ## Field(s) 720, 721, 722, 730 have additional candidates
159 @editor_fields = ($record->field('710'), $record->field('711'), $record->field('712'), $record->field('720'), $record->field('721'), $record->field('722'), $record->field('730'));
161 else { ## marc21, ukmarc
162 ## Fields 110 and 111 carry the main entries - corporate name and
163 ## meeting name, respectively
164 ## Field(s) 710, 711 carry added entries - personal names
165 @editor_fields = ($record->field('110'), $record->field('111'), $record->field('710'), $record->field('711'));
168 ## loop over all editor fields
169 foreach my $field (@editor_fields) {
170 if (length($field)) {
171 my $editor = &get_editor($field);
172 print "ED - ",&charconv($editor),"\n";
176 ## get info from the title field
177 if ($intype eq "unimarc") {
178 &print_title($record->field('200'));
180 else { ## marc21, ukmarc
181 &print_title($record->field('245'));
185 if ($intype eq "unimarc") {
186 &print_stitle($record->field('225'));
188 else { ## marc21, ukmarc
189 &print_stitle($record->field('210'));
193 if ($intype eq "unimarc") {
194 &print_isbn($record->field('010'));
195 &print_issn($record->field('011'));
197 elsif ($intype eq "ukmarc") {
198 &print_isbn($record->field('021'));
199 ## this is just an assumption
200 &print_issn($record->field('022'));
202 else { ## assume marc21
203 &print_isbn($record->field('020'));
204 &print_issn($record->field('022'));
207 if ($intype eq "marc21") {
208 &print_loc_callno($record->field('050'));
209 &print_dewey($record->field('082'));
211 ## else: unimarc, ukmarc do not seem to store call numbers?
214 if ($intype eq "unimarc") {
215 &print_pubinfo($record->field('210'));
217 else { ## marc21, ukmarc
218 &print_pubinfo($record->field('260'));
221 ## 6XX fields contain KW candidates. We add all of them to a
222 ## hash to eliminate duplicates
225 if ($intype eq "unimarc") {
226 foreach ('600', '601', '602', '604', '605', '606','607', '608', '610', '615', '620', '660'. '661', '670', '675', '676', '680', '686') {
227 &get_keywords(\%kwpool, "$_",$record->field($_));
230 elsif ($intype eq "ukmarc") {
231 foreach ('600', '610', '611', '630', '650', '651','653', '655', '660', '661', '668', '690', '691', '692', '695') {
232 &get_keywords(\%kwpool, "$_",$record->field($_));
235 else { ## assume marc21
236 foreach ('600', '610', '611', '630', '650', '651','653', '654', '655', '656', '657', '658') {
237 &get_keywords(\%kwpool, "$_",$record->field($_));
241 ## print all keywords found in the hash. The value of each hash
242 ## entry is the number of occurrences, but we're not really interested
243 ## in that and rather print the key
244 while (my ($key, $value) = each %kwpool) {
245 print "KW - ", &charconv($key), "\n";
248 ## 5XX have various candidates for notes and abstracts. We pool
249 ## all notes-like stuff in one list.
252 ## these fields have notes candidates
253 if ($intype eq "unimarc") {
254 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') {
255 &pool_subx(\@notepool, $_, $record->field($_));
258 elsif ($intype eq "ukmarc") {
259 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') {
260 &pool_subx(\@notepool, $_, $record->field($_));
263 else { ## assume marc21
264 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') {
265 &pool_subx(\@notepool, $_, $record->field($_));
269 my $allnotes = join "; ", @notepool;
271 if (length($allnotes) > 0) {
272 print "N1 - ", &charconv($allnotes), "\n";
275 ## 320/520 have the abstract
276 if ($intype eq "unimarc") {
277 &print_abstract($record->field('320'));
279 elsif ($intype eq "ukmarc") {
280 &print_abstract($record->field('512'), $record->field('513'));
282 else { ## assume marc21
283 &print_abstract($record->field('520'));
291 # Let's re-redirect stdout
293 open STDOUT, ">&", $oldout;
300 ##********************************************************************
301 ## print_typetag(): prints the first line of a RIS dataset including
302 ## the preceeding newline
303 ## Argument: the leader of a MARC dataset
304 ## Returns: the value at leader position 06
305 ##********************************************************************
307 ## the keys of typehash are the allowed values at position 06
308 ## of the leader of a MARC record, the values are the RIS types
309 ## that might appropriately represent these types.
343 ## The type of a MARC record is found at position 06 of the leader
344 my $typeofrecord = substr("@_", 6, 1);
346 ## ToDo: for books, field 008 positions 24-27 might have a few more
351 ## the ukmarc here is just a guess
352 if ($intype eq "marc21" || $intype eq "ukmarc") {
353 $typehash = $ustypehash;
355 elsif ($intype eq "unimarc") {
356 $typehash = $unitypehash;
359 ## assume MARC21 as default
360 $typehash = $ustypehash;
363 if (!exists $typehash{$typeofrecord}) {
364 print "\nTY - BOOK\n"; ## most reasonable default
365 warn ("no type found - assume BOOK");
368 print "\nTY - $typehash{$typeofrecord}\n";
371 ## use $typeofrecord as the return value, just in case
375 ##********************************************************************
376 ## normalize_author(): normalizes an authorname
377 ## Arguments: authorname subfield a
378 ## authorname subfield b
379 ## authorname subfield c
380 ## name type if known: 0=direct order
381 ## 1=only surname or full name in
383 ## 3=family, clan, dynasty name
384 ## Returns: the normalized authorname
385 ##********************************************************************
386 sub normalize_author {
387 my($rawauthora, $rawauthorb, $rawauthorc, $nametype) = @_;
389 if ($nametype == 0) {
390 # ToDo: convert every input to Last[,(F.|First)[ (M.|Middle)[,Suffix]]]
391 warn("name >>$rawauthora<< in direct order - leave as is");
394 elsif ($nametype == 1) {
395 ## start munging subfield a (the real name part)
396 ## remove spaces after separators
397 $rawauthora =~ s%([,.]+) *%$1%g;
399 ## remove trailing separators after spaces
400 $rawauthora =~ s% *[,;:/]*$%%;
402 ## remove periods after a non-abbreviated name
403 $rawauthora =~ s%(\w{2,})\.%$1%g;
405 ## start munging subfield b (something like the suffix)
406 ## remove trailing separators after spaces
407 $rawauthorb =~ s% *[,;:/]*$%%;
409 ## we currently ignore subfield c until someone complains
410 if (length($rawauthorb) > 0) {
411 return join ",", ($rawauthora, $rawauthorb);
417 elsif ($nametype == 3) {
422 ##********************************************************************
423 ## get_author(): gets authorname info from MARC fields 100, 700
424 ## Argument: field (100 or 700)
425 ## Returns: an author string in the format found in the record
426 ##********************************************************************
428 my ($authorfield) = @_;
431 ## the sequence of the name parts is encoded either in indicator
432 ## 1 (marc21) or 2 (unimarc)
433 if ($intype eq "unimarc") {
436 else { ## assume marc21
440 print "<marc>:Author(Ind$indicator): ", $authorfield->indicator("$indicator"),"\n" if $marcprint;
441 print "<marc>:Author(\$a): ", $authorfield->subfield('a'),"\n" if $marcprint;
442 print "<marc>:Author(\$b): ", $authorfield->subfield('b'),"\n" if $marcprint;
443 print "<marc>:Author(\$c): ", $authorfield->subfield('c'),"\n" if $marcprint;
444 print "<marc>:Author(\$h): ", $authorfield->subfield('h'),"\n" if $marcprint;
445 if ($intype eq "ukmarc") {
446 my $authorname = $authorfield->subfield('a') . "," . $authorfield->subfield('h');
447 normalize_author($authorname, $authorfield->subfield('b'), $authorfield->subfield('c'), $authorfield->indicator("$indicator"));
450 normalize_author($authorfield->subfield('a'), $authorfield->subfield('b'), $authorfield->subfield('c'), $authorfield->indicator("$indicator"));
454 ##********************************************************************
455 ## get_editor(): gets editor info from MARC fields 110, 111, 710, 711
456 ## Argument: field (110, 111, 710, or 711)
457 ## Returns: an author string in the format found in the record
458 ##********************************************************************
460 my ($editorfield) = @_;
462 if ($editorfield == undef) {
466 print "<marc>Editor(\$a): ", $editorfield->subfield('a'),"\n" if $marcprint;
467 print "<marc>Editor(\$b): ", $editorfield->subfield('b'),"\n" if $marcprint;
468 print "<marc>editor(\$c): ", $editorfield->subfield('c'),"\n" if $marcprint;
469 return $editorfield->subfield('a');
473 ##********************************************************************
474 ## print_title(): gets info from MARC field 245
475 ## Arguments: field (245)
477 ##********************************************************************
479 my ($titlefield) = @_;
480 if ($titlefield == undef) {
481 print "<marc>empty title field (245)\n" if $marcprint;
482 warn("empty title field (245)");
486 print "<marc>Title(\$a): ",$titlefield->subfield('a'),"\n" if $marcprint;
487 print "<marc>Title(\$b): ",$titlefield->subfield('b'),"\n" if $marcprint;
488 print "<marc>Title(\$c): ",$titlefield->subfield('c'),"\n" if $marcprint;
490 ## The title is usually written in a very odd notation. The title
491 ## proper ($a) often ends with a space followed by a separator like
492 ## a slash or a colon. The subtitle ($b) doesn't start with a space
493 ## so simple concatenation looks odd. We have to conditionally remove
494 ## the separator and make sure there's a space between title and
497 my $clean_title = $titlefield->subfield('a');
499 my $clean_subtitle = $titlefield->subfield('b');
500 $clean_title =~ s% *[/:;.]$%%;
501 $clean_subtitle =~ s%^ *(.*) *[/:;.]$%$1%;
503 if (length($clean_title) > 0
504 || (length($clean_subtitle) > 0 && $intype ne "unimarc")) {
505 print "TI - ", &charconv($clean_title);
507 ## subfield $b is relevant only for marc21/ukmarc
508 if (length($clean_subtitle) > 0 && $intype ne "unimarc") {
509 print ": ",&charconv($clean_subtitle);
514 ## The statement of responsibility is just this: horrors. There is
515 ## no formal definition how authors, editors and the like should
516 ## be written and designated. The field is free-form and resistant
517 ## to all parsing efforts, so this information is lost on me
521 ##********************************************************************
522 ## print_stitle(): prints info from series title field
525 ##********************************************************************
527 my ($titlefield) = @_;
529 if ($titlefield == undef) {
530 print "<marc>empty series title field\n" if $marcprint;
531 warn("empty series title field");
535 print "<marc>Series title(\$a): ",$titlefield->subfield('a'),"\n" if $marcprint;
536 my $clean_title = $titlefield->subfield('a');
538 $clean_title =~ s% *[/:;.]$%%;
540 if (length($clean_title) > 0) {
541 print "T2 - ", &charconv($clean_title);
544 if ($intype eq "unimarc") {
545 print "<marc>Series vol(\$v): ",$titlefield->subfield('v'),"\n" if $marcprint;
546 if (length($titlefield->subfield('v')) > 0) {
547 print "VL - ", &charconv($titlefield->subfield('v'));
553 ##********************************************************************
554 ## print_isbn(): gets info from MARC field 020
555 ## Arguments: field (020)
556 ##********************************************************************
560 if ($isbnfield == undef ||length ($isbnfield->subfield('a')) == 0) {
561 print "<marc>no isbn found (020\$a)\n" if $marcprint;
562 warn("no isbn found");
565 if (length ($isbnfield->subfield('a')) < 10) {
566 print "<marc>truncated isbn (020\$a)\n" if $marcprint;
567 warn("truncated isbn");
570 my $isbn = substr($isbnfield->subfield('a'), 0, 10);
571 print "SN - ", &charconv($isbn), "\n";
575 ##********************************************************************
576 ## print_issn(): gets info from MARC field 022
577 ## Arguments: field (022)
578 ##********************************************************************
582 if ($issnfield == undef ||length ($issnfield->subfield('a')) == 0) {
583 print "<marc>no issn found (022\$a)\n" if $marcprint;
584 warn("no issn found");
587 if (length ($issnfield->subfield('a')) < 9) {
588 print "<marc>truncated issn (022\$a)\n" if $marcprint;
589 warn("truncated issn");
592 my $issn = substr($issnfield->subfield('a'), 0, 9);
593 print "SN - ", &charconv($issn), "\n";
597 ##********************************************************************
598 ## print_loc_callno(): gets info from MARC field 050
599 ## Arguments: field (050)
600 ##********************************************************************
601 sub print_loc_callno {
602 my($callnofield) = @_;
604 if ($callnofield == undef || length ($callnofield->subfield('a')) == 0) {
605 print "<marc>no LOC call number found (050\$a)\n" if $marcprint;
606 warn("no LOC call number found");
609 print "AV - ", &charconv($callnofield->subfield('a')), " ", &charconv($callnofield->subfield('b')), "\n";
613 ##********************************************************************
614 ## print_dewey(): gets info from MARC field 082
615 ## Arguments: field (082)
616 ##********************************************************************
618 my($deweyfield) = @_;
620 if ($deweyfield == undef || length ($deweyfield->subfield('a')) == 0) {
621 print "<marc>no Dewey number found (082\$a)\n" if $marcprint;
622 warn("no Dewey number found");
625 print "U1 - ", &charconv($deweyfield->subfield('a')), " ", &charconv($deweyfield->subfield('2')), "\n";
629 ##********************************************************************
630 ## print_pubinfo(): gets info from MARC field 260
631 ## Arguments: field (260)
632 ##********************************************************************
634 my($pubinfofield) = @_;
636 if ($pubinfofield == undef) {
637 print "<marc>no publication information found (260)\n" if $marcprint;
638 warn("no publication information found");
641 ## the following information is available in MARC21:
643 ## $b publisher -> PB
645 ## the corresponding subfields for UNIMARC:
647 ## $c publisher -> PB
650 ## all of them are repeatable. We pool all places into a
651 ## comma-separated list in CY. We also pool all publishers
652 ## into a comma-separated list in PB. We break the rule with
653 ## the date field because this wouldn't make much sense. In
654 ## this case, we use the first occurrence for PY, the second
655 ## for Y2, and ignore the rest
657 my @pubsubfields = $pubinfofield->subfields();
663 my $pubsub_publisher;
666 if ($intype eq "unimarc") {
668 $pubsub_publisher = "c";
671 else { ## assume marc21
673 $pubsub_publisher = "b";
677 ## loop over all subfield list entries
678 for my $tuple (@pubsubfields) {
679 ## each tuple consists of the subfield code and the value
680 if (@$tuple[0] eq $pubsub_place) {
681 ## strip any trailing crap
684 ## pool all occurrences in a list
687 elsif (@$tuple[0] eq $pubsub_publisher) {
688 ## strip any trailing crap
691 ## pool all occurrences in a list
692 push (@publishers, $_);
694 elsif (@$tuple[0] eq $pubsub_date) {
695 ## the dates are free-form, so we want to extract
696 ## a four-digit year and leave the rest as
698 $protoyear = @$tuple[1];
699 print "<marc>Year (260\$c): $protoyear\n" if $marcprint;
701 ## strip any separator chars at the end
702 $protoyear =~ s% *[\.;:/]*$%%;
704 ## isolate a four-digit year. We discard anything
705 ## preceeding the year, but keep everything after
706 ## the year as other info.
707 $protoyear =~ s%\D*([0-9\-]{4})(.*)%$1///$2%;
709 ## check what we've got. If there is no four-digit
710 ## year, make it up. If digits are replaced by '-',
711 ## replace those with 0s
713 if (index($protoyear, "/") == 4) {
715 ## replace all '-' in the four-digit year
717 substr($protoyear,0,4) =~ s!-!0!g;
721 print "<marc>no four-digit year found, use 0000\n" if $marcprint;
722 $protoyear = "0000///$protoyear";
723 warn("no four-digit year found, use 0000");
726 if ($pycounter == 0 && length($protoyear)) {
727 print "PY - $protoyear\n";
729 elsif ($pycounter == 1 && length($_)) {
730 print "Y2 - $protoyear\n";
737 ## now dump the collected CY and PB lists
739 print "CY - ", &charconv(join(", ", @cities)), "\n";
741 if (@publishers > 0) {
742 print "PB - ", &charconv(join(", ", @publishers)), "\n";
747 ##********************************************************************
748 ## get_keywords(): prints info from MARC fields 6XX
749 ## Arguments: list of fields (6XX)
750 ##********************************************************************
752 my($href, $fieldname, @keywords) = @_;
754 ## a list of all possible subfields
755 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');
757 ## loop over all 6XX fields
758 foreach $kwfield (@keywords) {
759 if ($kwfield != undef) {
760 ## authornames get special treatment
761 if ($fieldname eq "600") {
762 my $val = normalize_author($kwfield->subfield('a'), $kwfield->subfield('b'), $kwfield->subfield('c'), $kwfield->indicator('1'));
764 print "<marc>Field $kwfield subfield a:", $kwfield->subfield('a'), "\n<marc>Field $kwfield subfield b:", $kwfield->subfield('b'), "\n<marc>Field $kwfield subfield c:", $kwfield->subfield('c'), "\n" if $marcprint;
767 ## retrieve all available subfields
768 @kwsubfields = $kwfield->subfields();
770 ## loop over all available subfield tuples
771 foreach $kwtuple (@kwsubfields) {
772 ## loop over all subfields to check
773 foreach $subfield (@subfields) {
774 ## [0] contains subfield code
775 if (@$kwtuple[0] eq $subfield) {
776 ## [1] contains value, remove trailing separators
777 @$kwtuple[1] =~ s% *[,;.:/]*$%%;
778 if (length(@$kwtuple[1]) > 0) {
780 ${$href}{@$kwtuple[1]} += 1;
781 print "<marc>Field $fieldname subfield $subfield:", @$kwtuple[1], "\n" if $marcprint;
783 ## we can leave the subfields loop here
793 ##********************************************************************
794 ## pool_subx(): adds contents of several subfields to a list
795 ## Arguments: reference to a list
797 ## list of fields (5XX)
798 ##********************************************************************
800 my($aref, $fieldname, @notefields) = @_;
802 ## we use a list that contains the interesting subfields
804 # ToDo: this is apparently correct only for marc21
807 if ($fieldname eq "500") {
810 elsif ($fieldname eq "501") {
813 elsif ($fieldname eq "502") {
816 elsif ($fieldname eq "504") {
817 @subfields = ('a', 'b');
819 elsif ($fieldname eq "505") {
820 @subfields = ('a', 'g', 'r', 't', 'u');
822 elsif ($fieldname eq "506") {
823 @subfields = ('a', 'b', 'c', 'd', 'e');
825 elsif ($fieldname eq "507") {
826 @subfields = ('a', 'b');
828 elsif ($fieldname eq "508") {
831 elsif ($fieldname eq "510") {
832 @subfields = ('a', 'b', 'c', 'x', '3');
834 elsif ($fieldname eq "511") {
837 elsif ($fieldname eq "513") {
838 @subfields = ('a', 'b');
840 elsif ($fieldname eq "514") {
841 @subfields = ('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'm', 'u', 'z');
843 elsif ($fieldname eq "515") {
846 elsif ($fieldname eq "516") {
849 elsif ($fieldname eq "518") {
850 @subfields = ('a', '3');
852 elsif ($fieldname eq "521") {
853 @subfields = ('a', 'b', '3');
855 elsif ($fieldname eq "522") {
858 elsif ($fieldname eq "524") {
859 @subfields = ('a', '2', '3');
861 elsif ($fieldname eq "525") {
864 elsif ($fieldname eq "526") {
865 @subfields = ('a', 'b', 'c', 'd', 'i', 'x', 'z', '5');
867 elsif ($fieldname eq "530") {
868 @subfields = ('a', 'b', 'c', 'd', 'u', '3');
870 elsif ($fieldname eq "533") {
871 @subfields = ('a', 'b', 'c', 'd', 'e', 'f', 'm', 'n', '3');
873 elsif ($fieldname eq "534") {
874 @subfields = ('a', 'b', 'c', 'e', 'f', 'k', 'l', 'm', 'n', 'p', 't', 'x', 'z');
876 elsif ($fieldname eq "535") {
877 @subfields = ('a', 'b', 'c', 'd', 'g', '3');
880 ## loop over all notefields
881 foreach $notefield (@notefields) {
882 if ($notefield != undef) {
883 ## retrieve all available subfield tuples
884 @notesubfields = $notefield->subfields();
886 ## loop over all subfield tuples
887 foreach $notetuple (@notesubfields) {
888 ## loop over all subfields to check
889 foreach $subfield (@subfields) {
890 ## [0] contains subfield code
891 if (@$notetuple[0] eq $subfield) {
892 ## [1] contains value, remove trailing separators
893 print "<marc>field $fieldname subfield $subfield: ", @$notetuple[1], "\n" if $marcprint;
894 @$notetuple[1] =~ s% *[,;.:/]*$%%;
895 if (length(@$notetuple[1]) > 0) {
897 push @{$aref}, @$notetuple[1];
907 ##********************************************************************
908 ## print_abstract(): prints abstract fields
909 ## Arguments: list of fields (520)
910 ##********************************************************************
912 # ToDo: take care of repeatable subfields
915 ## we check the following subfields
916 my @subfields = ('a', 'b');
918 ## we generate a list for all useful strings
921 ## loop over all abfields
922 foreach $abfield (@abfields) {
923 foreach $field (@subfields) {
924 if (length ($abfield->subfield($field)) > 0) {
925 my $ab = $abfield->subfield($field);
927 print "<marc>field 520 subfield $field: $ab\n" if $marcprint;
929 ## strip trailing separators
930 $ab =~ s% *[;,:./]*$%%;
932 ## add string to the list
933 push (@abstrings, $ab);
938 my $allabs = join "; ", @abstrings;
940 if (length($allabs) > 0) {
941 print "N2 - ", &charconv($allabs), "\n";
946 ##********************************************************************
947 ## charconv(): converts to a different charset based on a global var
950 ##********************************************************************
953 ## return unaltered if already utf-8
956 elsif ($uniout eq "t") {
958 warn "marc8_to_utf8";
959 return marc8_to_utf8("@_");
962 ## return unaltered if no utf-8 requested