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'));
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 ##********************************************************************
297 ## the keys of typehash are the allowed values at position 06
298 ## of the leader of a MARC record, the values are the RIS types
299 ## that might appropriately represent these types.
333 ## The type of a MARC record is found at position 06 of the leader
334 my $typeofrecord = substr("@_", 6, 1);
336 ## ToDo: for books, field 008 positions 24-27 might have a few more
341 ## the ukmarc here is just a guess
342 if ($intype eq "marc21" || $intype eq "ukmarc") {
343 $typehash = $ustypehash;
345 elsif ($intype eq "unimarc") {
346 $typehash = $unitypehash;
349 ## assume MARC21 as default
350 $typehash = $ustypehash;
353 if (!exists $typehash{$typeofrecord}) {
354 print "\nTY - BOOK\n"; ## most reasonable default
355 warn ("no type found - assume BOOK");
358 print "\nTY - $typehash{$typeofrecord}\n";
361 ## use $typeofrecord as the return value, just in case
365 ##********************************************************************
366 ## normalize_author(): normalizes an authorname
367 ## Arguments: authorname subfield a
368 ## authorname subfield b
369 ## authorname subfield c
370 ## name type if known: 0=direct order
371 ## 1=only surname or full name in
373 ## 3=family, clan, dynasty name
374 ## Returns: the normalized authorname
375 ##********************************************************************
376 sub normalize_author
{
377 my($rawauthora, $rawauthorb, $rawauthorc, $nametype) = @_;
379 if ($nametype == 0) {
380 # ToDo: convert every input to Last[,(F.|First)[ (M.|Middle)[,Suffix]]]
381 warn("name >>$rawauthora<< in direct order - leave as is");
384 elsif ($nametype == 1) {
385 ## start munging subfield a (the real name part)
386 ## remove spaces after separators
387 $rawauthora =~ s
%([,.]+) *%$1%g;
389 ## remove trailing separators after spaces
390 $rawauthora =~ s
% *[,;:/]*$%%;
392 ## remove periods after a non-abbreviated name
393 $rawauthora =~ s
%(\w
{2,})\
.%$1%g;
395 ## start munging subfield b (something like the suffix)
396 ## remove trailing separators after spaces
397 $rawauthorb =~ s
% *[,;:/]*$%%;
399 ## we currently ignore subfield c until someone complains
400 if (length($rawauthorb) > 0) {
401 return join ",", ($rawauthora, $rawauthorb);
407 elsif ($nametype == 3) {
412 ##********************************************************************
413 ## get_author(): gets authorname info from MARC fields 100, 700
414 ## Argument: field (100 or 700)
415 ## Returns: an author string in the format found in the record
416 ##********************************************************************
418 my ($authorfield) = @_;
421 ## the sequence of the name parts is encoded either in indicator
422 ## 1 (marc21) or 2 (unimarc)
423 if ($intype eq "unimarc") {
426 else { ## assume marc21
430 print "<marc>:Author(Ind$indicator): ", $authorfield->indicator("$indicator"),"\n" if $marcprint;
431 print "<marc>:Author(\$a): ", $authorfield->subfield('a'),"\n" if $marcprint;
432 print "<marc>:Author(\$b): ", $authorfield->subfield('b'),"\n" if $marcprint;
433 print "<marc>:Author(\$c): ", $authorfield->subfield('c'),"\n" if $marcprint;
434 print "<marc>:Author(\$h): ", $authorfield->subfield('h'),"\n" if $marcprint;
435 if ($intype eq "ukmarc") {
436 my $authorname = $authorfield->subfield('a') . "," . $authorfield->subfield('h');
437 normalize_author
($authorname, $authorfield->subfield('b'), $authorfield->subfield('c'), $authorfield->indicator("$indicator"));
440 normalize_author
($authorfield->subfield('a'), $authorfield->subfield('b'), $authorfield->subfield('c'), $authorfield->indicator("$indicator"));
444 ##********************************************************************
445 ## get_editor(): gets editor info from MARC fields 110, 111, 710, 711
446 ## Argument: field (110, 111, 710, or 711)
447 ## Returns: an author string in the format found in the record
448 ##********************************************************************
450 my ($editorfield) = @_;
452 if ($editorfield == undef) {
456 print "<marc>Editor(\$a): ", $editorfield->subfield('a'),"\n" if $marcprint;
457 print "<marc>Editor(\$b): ", $editorfield->subfield('b'),"\n" if $marcprint;
458 print "<marc>editor(\$c): ", $editorfield->subfield('c'),"\n" if $marcprint;
459 return $editorfield->subfield('a');
463 ##********************************************************************
464 ## print_title(): gets info from MARC field 245
465 ## Arguments: field (245)
467 ##********************************************************************
469 my ($titlefield) = @_;
470 if ($titlefield == undef) {
471 print "<marc>empty title field (245)\n" if $marcprint;
472 warn("empty title field (245)");
476 print "<marc>Title(\$a): ",$titlefield->subfield('a'),"\n" if $marcprint;
477 print "<marc>Title(\$b): ",$titlefield->subfield('b'),"\n" if $marcprint;
478 print "<marc>Title(\$c): ",$titlefield->subfield('c'),"\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) = @_;
519 if ($titlefield == undef) {
520 print "<marc>empty series title field\n" if $marcprint;
521 warn("empty series title field");
525 print "<marc>Series title(\$a): ",$titlefield->subfield('a'),"\n" if $marcprint;
526 my $clean_title = $titlefield->subfield('a');
528 $clean_title =~ s
% *[/:;.]$%%;
530 if (length($clean_title) > 0) {
531 print "T2 - ", &charconv
($clean_title);
534 if ($intype eq "unimarc") {
535 print "<marc>Series vol(\$v): ",$titlefield->subfield('v'),"\n" if $marcprint;
536 if (length($titlefield->subfield('v')) > 0) {
537 print "VL - ", &charconv
($titlefield->subfield('v'));
543 ##********************************************************************
544 ## print_isbn(): gets info from MARC field 020
545 ## Arguments: field (020)
546 ##********************************************************************
550 if ($isbnfield == undef ||length ($isbnfield->subfield('a')) == 0) {
551 print "<marc>no isbn found (020\$a)\n" if $marcprint;
552 warn("no isbn found");
555 if (length ($isbnfield->subfield('a')) < 10) {
556 print "<marc>truncated isbn (020\$a)\n" if $marcprint;
557 warn("truncated isbn");
560 my $isbn = substr($isbnfield->subfield('a'), 0, 10);
561 print "SN - ", &charconv
($isbn), "\n";
565 ##********************************************************************
566 ## print_issn(): gets info from MARC field 022
567 ## Arguments: field (022)
568 ##********************************************************************
572 if ($issnfield == undef ||length ($issnfield->subfield('a')) == 0) {
573 print "<marc>no issn found (022\$a)\n" if $marcprint;
574 warn("no issn found");
577 if (length ($issnfield->subfield('a')) < 9) {
578 print "<marc>truncated issn (022\$a)\n" if $marcprint;
579 warn("truncated issn");
582 my $issn = substr($issnfield->subfield('a'), 0, 9);
583 print "SN - ", &charconv
($issn), "\n";
587 ##********************************************************************
588 ## print_loc_callno(): gets info from MARC field 050
589 ## Arguments: field (050)
590 ##********************************************************************
591 sub print_loc_callno
{
592 my($callnofield) = @_;
594 if ($callnofield == undef || length ($callnofield->subfield('a')) == 0) {
595 print "<marc>no LOC call number found (050\$a)\n" if $marcprint;
596 warn("no LOC call number found");
599 print "AV - ", &charconv
($callnofield->subfield('a')), " ", &charconv
($callnofield->subfield('b')), "\n";
603 ##********************************************************************
604 ## print_dewey(): gets info from MARC field 082
605 ## Arguments: field (082)
606 ##********************************************************************
608 my($deweyfield) = @_;
610 if ($deweyfield == undef || length ($deweyfield->subfield('a')) == 0) {
611 print "<marc>no Dewey number found (082\$a)\n" if $marcprint;
612 warn("no Dewey number found");
615 print "U1 - ", &charconv
($deweyfield->subfield('a')), " ", &charconv
($deweyfield->subfield('2')), "\n";
619 ##********************************************************************
620 ## print_pubinfo(): gets info from MARC field 260
621 ## Arguments: field (260)
622 ##********************************************************************
624 my($pubinfofield) = @_;
626 if ($pubinfofield == undef) {
627 print "<marc>no publication information found (260)\n" if $marcprint;
628 warn("no publication information found");
631 ## the following information is available in MARC21:
633 ## $b publisher -> PB
635 ## the corresponding subfields for UNIMARC:
637 ## $c publisher -> PB
640 ## all of them are repeatable. We pool all places into a
641 ## comma-separated list in CY. We also pool all publishers
642 ## into a comma-separated list in PB. We break the rule with
643 ## the date field because this wouldn't make much sense. In
644 ## this case, we use the first occurrence for PY, the second
645 ## for Y2, and ignore the rest
647 my @pubsubfields = $pubinfofield->subfields();
653 my $pubsub_publisher;
656 if ($intype eq "unimarc") {
658 $pubsub_publisher = "c";
661 else { ## assume marc21
663 $pubsub_publisher = "b";
667 ## loop over all subfield list entries
668 for my $tuple (@pubsubfields) {
669 ## each tuple consists of the subfield code and the value
670 if (@
$tuple[0] eq $pubsub_place) {
671 ## strip any trailing crap
674 ## pool all occurrences in a list
677 elsif (@
$tuple[0] eq $pubsub_publisher) {
678 ## strip any trailing crap
681 ## pool all occurrences in a list
682 push (@publishers, $_);
684 elsif (@
$tuple[0] eq $pubsub_date) {
685 ## the dates are free-form, so we want to extract
686 ## a four-digit year and leave the rest as
688 $protoyear = @
$tuple[1];
689 print "<marc>Year (260\$c): $protoyear\n" if $marcprint;
691 ## strip any separator chars at the end
692 $protoyear =~ s
% *[\
.;:/]*$%%;
694 ## isolate a four-digit year. We discard anything
695 ## preceeding the year, but keep everything after
696 ## the year as other info.
697 $protoyear =~ s
%\D
*([0-9\
-]{4})(.*)%$1///$2%;
699 ## check what we've got. If there is no four-digit
700 ## year, make it up. If digits are replaced by '-',
701 ## replace those with 0s
703 if (index($protoyear, "/") == 4) {
705 ## replace all '-' in the four-digit year
707 substr($protoyear,0,4) =~ s!-!0!g;
711 print "<marc>no four-digit year found, use 0000\n" if $marcprint;
712 $protoyear = "0000///$protoyear";
713 warn("no four-digit year found, use 0000");
716 if ($pycounter == 0 && length($protoyear)) {
717 print "PY - $protoyear\n";
719 elsif ($pycounter == 1 && length($_)) {
720 print "Y2 - $protoyear\n";
727 ## now dump the collected CY and PB lists
729 print "CY - ", &charconv
(join(", ", @cities)), "\n";
731 if (@publishers > 0) {
732 print "PB - ", &charconv
(join(", ", @publishers)), "\n";
737 ##********************************************************************
738 ## get_keywords(): prints info from MARC fields 6XX
739 ## Arguments: list of fields (6XX)
740 ##********************************************************************
742 my($href, $fieldname, @keywords) = @_;
744 ## a list of all possible subfields
745 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');
747 ## loop over all 6XX fields
748 foreach $kwfield (@keywords) {
749 if ($kwfield != undef) {
750 ## authornames get special treatment
751 if ($fieldname eq "600") {
752 my $val = normalize_author
($kwfield->subfield('a'), $kwfield->subfield('b'), $kwfield->subfield('c'), $kwfield->indicator('1'));
754 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;
757 ## retrieve all available subfields
758 @kwsubfields = $kwfield->subfields();
760 ## loop over all available subfield tuples
761 foreach $kwtuple (@kwsubfields) {
762 ## loop over all subfields to check
763 foreach $subfield (@subfields) {
764 ## [0] contains subfield code
765 if (@
$kwtuple[0] eq $subfield) {
766 ## [1] contains value, remove trailing separators
767 @
$kwtuple[1] =~ s
% *[,;.:/]*$%%;
768 if (length(@
$kwtuple[1]) > 0) {
770 ${$href}{@
$kwtuple[1]} += 1;
771 print "<marc>Field $fieldname subfield $subfield:", @
$kwtuple[1], "\n" if $marcprint;
773 ## we can leave the subfields loop here
783 ##********************************************************************
784 ## pool_subx(): adds contents of several subfields to a list
785 ## Arguments: reference to a list
787 ## list of fields (5XX)
788 ##********************************************************************
790 my($aref, $fieldname, @notefields) = @_;
792 ## we use a list that contains the interesting subfields
794 # ToDo: this is apparently correct only for marc21
797 if ($fieldname eq "500") {
800 elsif ($fieldname eq "501") {
803 elsif ($fieldname eq "502") {
806 elsif ($fieldname eq "504") {
807 @subfields = ('a', 'b');
809 elsif ($fieldname eq "505") {
810 @subfields = ('a', 'g', 'r', 't', 'u');
812 elsif ($fieldname eq "506") {
813 @subfields = ('a', 'b', 'c', 'd', 'e');
815 elsif ($fieldname eq "507") {
816 @subfields = ('a', 'b');
818 elsif ($fieldname eq "508") {
821 elsif ($fieldname eq "510") {
822 @subfields = ('a', 'b', 'c', 'x', '3');
824 elsif ($fieldname eq "511") {
827 elsif ($fieldname eq "513") {
828 @subfields = ('a', 'b');
830 elsif ($fieldname eq "514") {
831 @subfields = ('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'm', 'u', 'z');
833 elsif ($fieldname eq "515") {
836 elsif ($fieldname eq "516") {
839 elsif ($fieldname eq "518") {
840 @subfields = ('a', '3');
842 elsif ($fieldname eq "521") {
843 @subfields = ('a', 'b', '3');
845 elsif ($fieldname eq "522") {
848 elsif ($fieldname eq "524") {
849 @subfields = ('a', '2', '3');
851 elsif ($fieldname eq "525") {
854 elsif ($fieldname eq "526") {
855 @subfields = ('a', 'b', 'c', 'd', 'i', 'x', 'z', '5');
857 elsif ($fieldname eq "530") {
858 @subfields = ('a', 'b', 'c', 'd', 'u', '3');
860 elsif ($fieldname eq "533") {
861 @subfields = ('a', 'b', 'c', 'd', 'e', 'f', 'm', 'n', '3');
863 elsif ($fieldname eq "534") {
864 @subfields = ('a', 'b', 'c', 'e', 'f', 'k', 'l', 'm', 'n', 'p', 't', 'x', 'z');
866 elsif ($fieldname eq "535") {
867 @subfields = ('a', 'b', 'c', 'd', 'g', '3');
870 ## loop over all notefields
871 foreach $notefield (@notefields) {
872 if ($notefield != undef) {
873 ## retrieve all available subfield tuples
874 @notesubfields = $notefield->subfields();
876 ## loop over all subfield tuples
877 foreach $notetuple (@notesubfields) {
878 ## loop over all subfields to check
879 foreach $subfield (@subfields) {
880 ## [0] contains subfield code
881 if (@
$notetuple[0] eq $subfield) {
882 ## [1] contains value, remove trailing separators
883 print "<marc>field $fieldname subfield $subfield: ", @
$notetuple[1], "\n" if $marcprint;
884 @
$notetuple[1] =~ s
% *[,;.:/]*$%%;
885 if (length(@
$notetuple[1]) > 0) {
887 push @
{$aref}, @
$notetuple[1];
897 ##********************************************************************
898 ## print_abstract(): prints abstract fields
899 ## Arguments: list of fields (520)
900 ##********************************************************************
902 # ToDo: take care of repeatable subfields
905 ## we check the following subfields
906 my @subfields = ('a', 'b');
908 ## we generate a list for all useful strings
911 ## loop over all abfields
912 foreach $abfield (@abfields) {
913 foreach $field (@subfields) {
914 if (length ($abfield->subfield($field)) > 0) {
915 my $ab = $abfield->subfield($field);
917 print "<marc>field 520 subfield $field: $ab\n" if $marcprint;
919 ## strip trailing separators
920 $ab =~ s
% *[;,:./]*$%%;
922 ## add string to the list
923 push (@abstrings, $ab);
928 my $allabs = join "; ", @abstrings;
930 if (length($allabs) > 0) {
931 print "N2 - ", &charconv
($allabs), "\n";
936 ##********************************************************************
937 ## charconv(): converts to a different charset based on a global var
940 ##********************************************************************
943 ## return unaltered if already utf-8
946 elsif ($uniout eq "t") {
948 return marc8_to_utf8
("@_");
951 ## return unaltered if no utf-8 requested