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 = 1; # Debug
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>---\n<marc>UTF-8 data\n" if $marcprint;
112 print "<marc>---\n<marc>MARC-8 data\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),"\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),"\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('210'));
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), "\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), "\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'));
283 # Let's re-redirect stdout
285 open STDOUT, ">&", $oldout;
292 ##********************************************************************
293 ## print_typetag(): prints the first line of a RIS dataset including
294 ## the preceeding newline
295 ## Argument: the leader of a MARC dataset
296 ## Returns: the value at leader position 06
297 ##********************************************************************
299 ## the keys of typehash are the allowed values at position 06
300 ## of the leader of a MARC record, the values are the RIS types
301 ## that might appropriately represent these types.
335 ## The type of a MARC record is found at position 06 of the leader
336 my $typeofrecord = substr("@_", 6, 1);
338 ## ToDo: for books, field 008 positions 24-27 might have a few more
343 ## the ukmarc here is just a guess
344 if ($intype eq "marc21" || $intype eq "ukmarc") {
345 $typehash = $ustypehash;
347 elsif ($intype eq "unimarc") {
348 $typehash = $unitypehash;
351 ## assume MARC21 as default
352 $typehash = $ustypehash;
355 if (!exists $typehash{$typeofrecord}) {
356 print "\nTY - BOOK\n"; ## most reasonable default
357 warn ("no type found - assume BOOK");
360 print "\nTY - $typehash{$typeofrecord}\n";
363 ## use $typeofrecord as the return value, just in case
367 ##********************************************************************
368 ## normalize_author(): normalizes an authorname
369 ## Arguments: authorname subfield a
370 ## authorname subfield b
371 ## authorname subfield c
372 ## name type if known: 0=direct order
373 ## 1=only surname or full name in
375 ## 3=family, clan, dynasty name
376 ## Returns: the normalized authorname
377 ##********************************************************************
378 sub normalize_author {
379 my($rawauthora, $rawauthorb, $rawauthorc, $nametype) = @_;
381 if ($nametype == 0) {
382 # ToDo: convert every input to Last[,(F.|First)[ (M.|Middle)[,Suffix]]]
383 warn("name >>$rawauthora<< in direct order - leave as is");
386 elsif ($nametype == 1) {
387 ## start munging subfield a (the real name part)
388 ## remove spaces after separators
389 $rawauthora =~ s%([,.]+) *%$1%g;
391 ## remove trailing separators after spaces
392 $rawauthora =~ s% *[,;:/]*$%%;
394 ## remove periods after a non-abbreviated name
395 $rawauthora =~ s%(\w{2,})\.%$1%g;
397 ## start munging subfield b (something like the suffix)
398 ## remove trailing separators after spaces
399 $rawauthorb =~ s% *[,;:/]*$%%;
401 ## we currently ignore subfield c until someone complains
402 if (length($rawauthorb) > 0) {
403 return join ",", ($rawauthora, $rawauthorb);
409 elsif ($nametype == 3) {
414 ##********************************************************************
415 ## get_author(): gets authorname info from MARC fields 100, 700
416 ## Argument: field (100 or 700)
417 ## Returns: an author string in the format found in the record
418 ##********************************************************************
420 my ($authorfield) = @_;
423 ## the sequence of the name parts is encoded either in indicator
424 ## 1 (marc21) or 2 (unimarc)
425 if ($intype eq "unimarc") {
428 else { ## assume marc21
432 print "<marc>:Author(Ind$indicator): ", $authorfield->indicator("$indicator"),"\n" if $marcprint;
433 print "<marc>:Author(\$a): ", $authorfield->subfield('a'),"\n" if $marcprint;
434 print "<marc>:Author(\$b): ", $authorfield->subfield('b'),"\n" if $marcprint;
435 print "<marc>:Author(\$c): ", $authorfield->subfield('c'),"\n" if $marcprint;
436 print "<marc>:Author(\$h): ", $authorfield->subfield('h'),"\n" if $marcprint;
437 if ($intype eq "ukmarc") {
438 my $authorname = $authorfield->subfield('a') . "," . $authorfield->subfield('h');
439 normalize_author($authorname, $authorfield->subfield('b'), $authorfield->subfield('c'), $authorfield->indicator("$indicator"));
442 normalize_author($authorfield->subfield('a'), $authorfield->subfield('b'), $authorfield->subfield('c'), $authorfield->indicator("$indicator"));
446 ##********************************************************************
447 ## get_editor(): gets editor info from MARC fields 110, 111, 710, 711
448 ## Argument: field (110, 111, 710, or 711)
449 ## Returns: an author string in the format found in the record
450 ##********************************************************************
452 my ($editorfield) = @_;
454 if ($editorfield == undef) {
458 print "<marc>Editor(\$a): ", $editorfield->subfield('a'),"\n" if $marcprint;
459 print "<marc>Editor(\$b): ", $editorfield->subfield('b'),"\n" if $marcprint;
460 print "<marc>editor(\$c): ", $editorfield->subfield('c'),"\n" if $marcprint;
461 return $editorfield->subfield('a');
465 ##********************************************************************
466 ## print_title(): gets info from MARC field 245
467 ## Arguments: field (245)
469 ##********************************************************************
471 my ($titlefield) = @_;
472 if ($titlefield == undef) {
473 print "<marc>empty title field (245)\n" if $marcprint;
474 warn("empty title field (245)");
478 print "<marc>Title(\$a): ",$titlefield->subfield('a'),"\n" if $marcprint;
479 print "<marc>Title(\$b): ",$titlefield->subfield('b'),"\n" if $marcprint;
480 print "<marc>Title(\$c): ",$titlefield->subfield('c'),"\n" if $marcprint;
482 ## The title is usually written in a very odd notation. The title
483 ## proper ($a) often ends with a space followed by a separator like
484 ## a slash or a colon. The subtitle ($b) doesn't start with a space
485 ## so simple concatenation looks odd. We have to conditionally remove
486 ## the separator and make sure there's a space between title and
489 my $clean_title = $titlefield->subfield('a');
491 my $clean_subtitle = $titlefield->subfield('b');
492 $clean_title =~ s% *[/:;.]$%%;
493 $clean_subtitle =~ s%^ *(.*) *[/:;.]$%$1%;
495 if (length($clean_title) > 0
496 || (length($clean_subtitle) > 0 && $intype ne "unimarc")) {
497 print "TI - ", &charconv($clean_title);
499 ## subfield $b is relevant only for marc21/ukmarc
500 if (length($clean_subtitle) > 0 && $intype ne "unimarc") {
501 print ": ",&charconv($clean_subtitle);
506 ## The statement of responsibility is just this: horrors. There is
507 ## no formal definition how authors, editors and the like should
508 ## be written and designated. The field is free-form and resistant
509 ## to all parsing efforts, so this information is lost on me
513 ##********************************************************************
514 ## print_stitle(): prints info from series title field
517 ##********************************************************************
519 my ($titlefield) = @_;
521 if ($titlefield == undef) {
522 print "<marc>empty series title field\n" if $marcprint;
523 warn("empty series title field");
527 print "<marc>Series title(\$a): ",$titlefield->subfield('a'),"\n" if $marcprint;
528 my $clean_title = $titlefield->subfield('a');
530 $clean_title =~ s% *[/:;.]$%%;
532 if (length($clean_title) > 0) {
533 print "T2 - ", &charconv($clean_title);
536 if ($intype eq "unimarc") {
537 print "<marc>Series vol(\$v): ",$titlefield->subfield('v'),"\n" if $marcprint;
538 if (length($titlefield->subfield('v')) > 0) {
539 print "VL - ", &charconv($titlefield->subfield('v'));
545 ##********************************************************************
546 ## print_isbn(): gets info from MARC field 020
547 ## Arguments: field (020)
548 ##********************************************************************
552 if ($isbnfield == undef ||length ($isbnfield->subfield('a')) == 0) {
553 print "<marc>no isbn found (020\$a)\n" if $marcprint;
554 warn("no isbn found");
557 if (length ($isbnfield->subfield('a')) < 10) {
558 print "<marc>truncated isbn (020\$a)\n" if $marcprint;
559 warn("truncated isbn");
562 my $isbn = substr($isbnfield->subfield('a'), 0, 10);
563 print "SN - ", &charconv($isbn), "\n";
567 ##********************************************************************
568 ## print_issn(): gets info from MARC field 022
569 ## Arguments: field (022)
570 ##********************************************************************
574 if ($issnfield == undef ||length ($issnfield->subfield('a')) == 0) {
575 print "<marc>no issn found (022\$a)\n" if $marcprint;
576 warn("no issn found");
579 if (length ($issnfield->subfield('a')) < 9) {
580 print "<marc>truncated issn (022\$a)\n" if $marcprint;
581 warn("truncated issn");
584 my $issn = substr($issnfield->subfield('a'), 0, 9);
585 print "SN - ", &charconv($issn), "\n";
589 ##********************************************************************
590 ## print_loc_callno(): gets info from MARC field 050
591 ## Arguments: field (050)
592 ##********************************************************************
593 sub print_loc_callno {
594 my($callnofield) = @_;
596 if ($callnofield == undef || length ($callnofield->subfield('a')) == 0) {
597 print "<marc>no LOC call number found (050\$a)\n" if $marcprint;
598 warn("no LOC call number found");
601 print "AV - ", &charconv($callnofield->subfield('a')), " ", &charconv($callnofield->subfield('b')), "\n";
605 ##********************************************************************
606 ## print_dewey(): gets info from MARC field 082
607 ## Arguments: field (082)
608 ##********************************************************************
610 my($deweyfield) = @_;
612 if ($deweyfield == undef || length ($deweyfield->subfield('a')) == 0) {
613 print "<marc>no Dewey number found (082\$a)\n" if $marcprint;
614 warn("no Dewey number found");
617 print "U1 - ", &charconv($deweyfield->subfield('a')), " ", &charconv($deweyfield->subfield('2')), "\n";
621 ##********************************************************************
622 ## print_pubinfo(): gets info from MARC field 260
623 ## Arguments: field (260)
624 ##********************************************************************
626 my($pubinfofield) = @_;
628 if ($pubinfofield == undef) {
629 print "<marc>no publication information found (260)\n" if $marcprint;
630 warn("no publication information found");
633 ## the following information is available in MARC21:
635 ## $b publisher -> PB
637 ## the corresponding subfields for UNIMARC:
639 ## $c publisher -> PB
642 ## all of them are repeatable. We pool all places into a
643 ## comma-separated list in CY. We also pool all publishers
644 ## into a comma-separated list in PB. We break the rule with
645 ## the date field because this wouldn't make much sense. In
646 ## this case, we use the first occurrence for PY, the second
647 ## for Y2, and ignore the rest
649 my @pubsubfields = $pubinfofield->subfields();
655 my $pubsub_publisher;
658 if ($intype eq "unimarc") {
660 $pubsub_publisher = "c";
663 else { ## assume marc21
665 $pubsub_publisher = "b";
669 ## loop over all subfield list entries
670 for my $tuple (@pubsubfields) {
671 ## each tuple consists of the subfield code and the value
672 if (@$tuple[0] eq $pubsub_place) {
673 ## strip any trailing crap
676 ## pool all occurrences in a list
679 elsif (@$tuple[0] eq $pubsub_publisher) {
680 ## strip any trailing crap
683 ## pool all occurrences in a list
684 push (@publishers, $_);
686 elsif (@$tuple[0] eq $pubsub_date) {
687 ## the dates are free-form, so we want to extract
688 ## a four-digit year and leave the rest as
690 $protoyear = @$tuple[1];
691 print "<marc>Year (260\$c): $protoyear\n" if $marcprint;
693 ## strip any separator chars at the end
694 $protoyear =~ s% *[\.;:/]*$%%;
696 ## isolate a four-digit year. We discard anything
697 ## preceeding the year, but keep everything after
698 ## the year as other info.
699 $protoyear =~ s%\D*([0-9\-]{4})(.*)%$1///$2%;
701 ## check what we've got. If there is no four-digit
702 ## year, make it up. If digits are replaced by '-',
703 ## replace those with 0s
705 if (index($protoyear, "/") == 4) {
707 ## replace all '-' in the four-digit year
709 substr($protoyear,0,4) =~ s!-!0!g;
713 print "<marc>no four-digit year found, use 0000\n" if $marcprint;
714 $protoyear = "0000///$protoyear";
715 warn("no four-digit year found, use 0000");
718 if ($pycounter == 0 && length($protoyear)) {
719 print "PY - $protoyear\n";
721 elsif ($pycounter == 1 && length($_)) {
722 print "Y2 - $protoyear\n";
729 ## now dump the collected CY and PB lists
731 print "CY - ", &charconv(join(", ", @cities)), "\n";
733 if (@publishers > 0) {
734 print "PB - ", &charconv(join(", ", @publishers)), "\n";
739 ##********************************************************************
740 ## get_keywords(): prints info from MARC fields 6XX
741 ## Arguments: list of fields (6XX)
742 ##********************************************************************
744 my($href, $fieldname, @keywords) = @_;
746 ## a list of all possible subfields
747 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');
749 ## loop over all 6XX fields
750 foreach $kwfield (@keywords) {
751 if ($kwfield != undef) {
752 ## authornames get special treatment
753 if ($fieldname eq "600") {
754 my $val = normalize_author($kwfield->subfield('a'), $kwfield->subfield('b'), $kwfield->subfield('c'), $kwfield->indicator('1'));
756 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;
759 ## retrieve all available subfields
760 @kwsubfields = $kwfield->subfields();
762 ## loop over all available subfield tuples
763 foreach $kwtuple (@kwsubfields) {
764 ## loop over all subfields to check
765 foreach $subfield (@subfields) {
766 ## [0] contains subfield code
767 if (@$kwtuple[0] eq $subfield) {
768 ## [1] contains value, remove trailing separators
769 @$kwtuple[1] =~ s% *[,;.:/]*$%%;
770 if (length(@$kwtuple[1]) > 0) {
772 ${$href}{@$kwtuple[1]} += 1;
773 print "<marc>Field $fieldname subfield $subfield:", @$kwtuple[1], "\n" if $marcprint;
775 ## we can leave the subfields loop here
785 ##********************************************************************
786 ## pool_subx(): adds contents of several subfields to a list
787 ## Arguments: reference to a list
789 ## list of fields (5XX)
790 ##********************************************************************
792 my($aref, $fieldname, @notefields) = @_;
794 ## we use a list that contains the interesting subfields
796 # ToDo: this is apparently correct only for marc21
799 if ($fieldname eq "500") {
802 elsif ($fieldname eq "501") {
805 elsif ($fieldname eq "502") {
808 elsif ($fieldname eq "504") {
809 @subfields = ('a', 'b');
811 elsif ($fieldname eq "505") {
812 @subfields = ('a', 'g', 'r', 't', 'u');
814 elsif ($fieldname eq "506") {
815 @subfields = ('a', 'b', 'c', 'd', 'e');
817 elsif ($fieldname eq "507") {
818 @subfields = ('a', 'b');
820 elsif ($fieldname eq "508") {
823 elsif ($fieldname eq "510") {
824 @subfields = ('a', 'b', 'c', 'x', '3');
826 elsif ($fieldname eq "511") {
829 elsif ($fieldname eq "513") {
830 @subfields = ('a', 'b');
832 elsif ($fieldname eq "514") {
833 @subfields = ('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'm', 'u', 'z');
835 elsif ($fieldname eq "515") {
838 elsif ($fieldname eq "516") {
841 elsif ($fieldname eq "518") {
842 @subfields = ('a', '3');
844 elsif ($fieldname eq "521") {
845 @subfields = ('a', 'b', '3');
847 elsif ($fieldname eq "522") {
850 elsif ($fieldname eq "524") {
851 @subfields = ('a', '2', '3');
853 elsif ($fieldname eq "525") {
856 elsif ($fieldname eq "526") {
857 @subfields = ('a', 'b', 'c', 'd', 'i', 'x', 'z', '5');
859 elsif ($fieldname eq "530") {
860 @subfields = ('a', 'b', 'c', 'd', 'u', '3');
862 elsif ($fieldname eq "533") {
863 @subfields = ('a', 'b', 'c', 'd', 'e', 'f', 'm', 'n', '3');
865 elsif ($fieldname eq "534") {
866 @subfields = ('a', 'b', 'c', 'e', 'f', 'k', 'l', 'm', 'n', 'p', 't', 'x', 'z');
868 elsif ($fieldname eq "535") {
869 @subfields = ('a', 'b', 'c', 'd', 'g', '3');
872 ## loop over all notefields
873 foreach $notefield (@notefields) {
874 if ($notefield != undef) {
875 ## retrieve all available subfield tuples
876 @notesubfields = $notefield->subfields();
878 ## loop over all subfield tuples
879 foreach $notetuple (@notesubfields) {
880 ## loop over all subfields to check
881 foreach $subfield (@subfields) {
882 ## [0] contains subfield code
883 if (@$notetuple[0] eq $subfield) {
884 ## [1] contains value, remove trailing separators
885 print "<marc>field $fieldname subfield $subfield: ", @$notetuple[1], "\n" if $marcprint;
886 @$notetuple[1] =~ s% *[,;.:/]*$%%;
887 if (length(@$notetuple[1]) > 0) {
889 push @{$aref}, @$notetuple[1];
899 ##********************************************************************
900 ## print_abstract(): prints abstract fields
901 ## Arguments: list of fields (520)
902 ##********************************************************************
904 # ToDo: take care of repeatable subfields
907 ## we check the following subfields
908 my @subfields = ('a', 'b');
910 ## we generate a list for all useful strings
913 ## loop over all abfields
914 foreach $abfield (@abfields) {
915 foreach $field (@subfields) {
916 if (length ($abfield->subfield($field)) > 0) {
917 my $ab = $abfield->subfield($field);
919 print "<marc>field 520 subfield $field: $ab\n" if $marcprint;
921 ## strip trailing separators
922 $ab =~ s% *[;,:./]*$%%;
924 ## add string to the list
925 push (@abstrings, $ab);
930 my $allabs = join "; ", @abstrings;
932 if (length($allabs) > 0) {
933 print "N2 - ", &charconv($allabs), "\n";
938 ##********************************************************************
939 ## charconv(): converts to a different charset based on a global var
942 ##********************************************************************
945 ## return unaltered if already utf-8
948 elsif ($uniout eq "t") {
950 warn "marc8_to_utf8";
951 return marc8_to_utf8("@_");
954 ## return unaltered if no utf-8 requested