4 ## marc2ris: converts MARC21 and UNIMARC datasets to RIS format
5 ## See comments below for compliance with other MARC dialects
7 ## usage: perl marc2ris < infile.marc > outfile.ris
9 ## Dependencies: perl 5.6.0 or later
13 ## markus@mhoenicka.de 2002-11-16
15 ## This program is free software; you can redistribute it and/or modify
16 ## it under the terms of the GNU General Public License as published by
17 ## the Free Software Foundation; either version 2 of the License, or
18 ## (at your option) any later version.
20 ## This program is distributed in the hope that it will be useful,
21 ## but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ## GNU General Public License for more details.
25 ## You should have received a copy of the GNU General Public License
26 ## along with this program; if not, write to the Free Software
27 ## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
29 ## Some background about MARC as understood by this script
30 ## The default input format used in this script is MARC21, which
31 ## superseded USMARC and CANMARC. The specification can be found at:
32 ## http://lcweb.loc.gov/marc/
33 ## UNIMARC follows the specification at:
34 ## http://www.ifla.org/VI/3/p1996-1/sec-uni.htm
35 ## UKMARC support is a bit shaky because there is no specification available
36 ## for free. The wisdom used in this script was taken from a PDF document
37 ## comparing UKMARC to MARC21 found at:
38 ## www.bl.uk/services/bibliographic/marcchange.pdf
41 # Modified 2008 by BibLibre for Koha
42 # Modified 2011 by Catalyst
43 # Modified 2011 by Equinox Software, Inc.
44 # Modified 2016 by Universidad de El Salvador
46 # This file is part of Koha.
48 # Koha is free software; you can redistribute it and/or modify it
49 # under the terms of the GNU General Public License as published by
50 # the Free Software Foundation; either version 3 of the License, or
51 # (at your option) any later version.
53 # Koha is distributed in the hope that it will be useful, but
54 # WITHOUT ANY WARRANTY; without even the implied warranty of
55 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
56 # GNU General Public License for more details.
58 # You should have received a copy of the GNU General Public License
59 # along with Koha; if not, see <http://www.gnu.org/licenses>.
65 use List::MoreUtils qw( uniq );
67 use vars qw(@ISA @EXPORT);
69 use Koha::SimpleMARC qw( read_field );
74 # only export API methods
80 our $marcprint = 0; # Debug flag;
82 =head1 marc2bibtex - Convert from UNIMARC to RIS
84 my ($ris) = marc2ris($record);
88 C<$record> - a MARC::Record object
95 my $marcflavour = C4::Context->preference("marcflavour");
96 my $intype = lc($marcflavour);
98 # Let's redirect stdout
99 open my $oldout, qw{>&}, "STDOUT";
102 open STDOUT,'>:encoding(utf8)', \$outvar;
104 ## First we should check the character encoding. This may be
105 ## MARC-8 or UTF-8. The former is indicated by a blank, the latter
106 ## by 'a' at position 09 (zero-based) of the leader
107 my $leader = $record->leader();
108 if ( $intype eq "marc21" ) {
109 if ( $leader =~ /^.{9}a/ ) {
110 print "<marc>---\r\n<marc>UTF-8 data\r\n" if $marcprint;
113 print "<marc>---\r\n<marc>MARC-8 data\r\n" if $marcprint;
116 ## else: other MARC formats do not specify the character encoding
117 ## we assume it's *not* UTF-8
119 my $ris_additional_fields = C4::Context->yaml_preference('RisExportAdditionalFields');
122 if ( $ris_additional_fields && $ris_additional_fields->{TY} ) {
123 my ( $f, $sf ) = split( /\$/, $ris_additional_fields->{TY} );
124 my ( $type ) = read_field( { record => $record, field => $f, subfield => $sf, field_numbers => [1] } );
126 print "TY - $type\r\n";
129 &print_typetag($leader);
133 &print_typetag($leader);
136 ## retrieve all author fields and collect them in a list
139 if ($intype eq "unimarc") {
140 ## Fields 700, 701, and 702 can contain author names
141 @author_fields = ($record->field('700'), $record->field('701'), $record->field('702'));
143 else { ## marc21, ukmarc
144 ## Field 100 sometimes carries main author
145 ## Field(s) 700 carry added entries - personal names
146 @author_fields = ($record->field('100'), $record->field('700'));
149 ## loop over all author fields
150 foreach my $field (@author_fields) {
151 if (length($field)) {
152 my $author = &get_author($field);
153 print "AU - ",$author,"\r\n";
157 # ToDo: should we specify anonymous as author if we didn't find
158 # one? or use one of the corporate/meeting names below?
160 ## add corporate names or meeting names as editors ??
163 if ($intype eq "unimarc") {
164 ## Fields 710, 711, and 712 can carry corporate names
165 ## Field(s) 720, 721, 722, 730 have additional candidates
166 @editor_fields = ($record->field('710'), $record->field('711'), $record->field('712'), $record->field('720'), $record->field('721'), $record->field('722'), $record->field('730'));
168 else { ## marc21, ukmarc
169 ## Fields 110 and 111 carry the main entries - corporate name and
170 ## meeting name, respectively
171 ## Field(s) 710, 711 carry added entries - personal names
172 @editor_fields = ($record->field('110'), $record->field('111'), $record->field('710'), $record->field('711'));
175 ## loop over all editor fields
176 foreach my $field (@editor_fields) {
177 if (length($field)) {
178 my $editor = &get_editor($field);
179 print "ED - ",$editor,"\r\n";
183 ## get info from the title field
184 if ($intype eq "unimarc") {
185 &print_title($record->field('200'));
187 else { ## marc21, ukmarc
188 &print_title($record->field('245'));
192 if ($intype eq "unimarc") {
193 &print_stitle($record->field('225'));
195 else { ## marc21, ukmarc
196 &print_stitle($record->field('490'));
200 if ($intype eq "unimarc") {
201 &print_isbn($record->field('010'));
202 &print_issn($record->field('011'));
204 elsif ($intype eq "ukmarc") {
205 &print_isbn($record->field('021'));
206 ## this is just an assumption
207 &print_issn($record->field('022'));
209 else { ## assume marc21
210 &print_isbn($record->field('020'));
211 &print_issn($record->field('022'));
214 if ($intype eq "marc21") {
215 &print_loc_callno($record->field('050'));
216 &print_dewey($record->field('082'));
218 ## else: unimarc, ukmarc do not seem to store call numbers?
221 if ($intype eq "unimarc") {
222 &print_pubinfo($record->field('210'));
224 else { ## marc21, ukmarc
225 if ($record->field('264')) {
226 &print_pubinfo($record->field('264'));
229 &print_pubinfo($record->field('260'));
233 ## 6XX fields contain KW candidates. We add all of them to a
236 if ($intype eq "unimarc") {
237 @field_list = ('600', '601', '602', '604', '605', '606','607', '608', '610', '615', '620', '660', '661', '670', '675', '676', '680', '686');
238 } elsif ($intype eq "ukmarc") {
239 @field_list = ('600', '610', '611', '630', '650', '651','653', '655', '660', '661', '668', '690', '691', '692', '695');
240 } else { ## assume marc21
241 @field_list = ('600', '610', '611', '630', '650', '651','653', '654', '655', '656', '657', '658');
245 for my $f ( @field_list ) {
246 my @fields = $record->field($f);
247 push @kwpool, ( get_keywords("$f",$record->field($f)) );
251 @kwpool = uniq @kwpool;
253 for my $kw ( @kwpool ) {
254 print "KW - ", $kw, "\r\n";
257 ## 5XX have various candidates for notes and abstracts. We pool
258 ## all notes-like stuff in one list.
261 ## these fields have notes candidates
262 if ($intype eq "unimarc") {
263 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') {
264 &pool_subx(\@notepool, $_, $record->field($_));
267 elsif ($intype eq "ukmarc") {
268 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') {
269 &pool_subx(\@notepool, $_, $record->field($_));
272 else { ## assume marc21
273 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') {
274 &pool_subx(\@notepool, $_, $record->field($_));
278 my $allnotes = join "; ", @notepool;
280 if (length($allnotes) > 0) {
281 print "N1 - ", $allnotes, "\r\n";
284 ## 320/520 have the abstract
285 if ($intype eq "unimarc") {
286 &print_abstract($record->field('320'));
288 elsif ($intype eq "ukmarc") {
289 &print_abstract($record->field('512'), $record->field('513'));
291 else { ## assume marc21
292 &print_abstract($record->field('520'));
296 if ($record->field('856')) {
297 print_uri($record->field('856'));
300 if ($ris_additional_fields) {
301 foreach my $ris_tag ( keys %$ris_additional_fields ) {
302 next if $ris_tag eq 'TY';
305 ref( $ris_additional_fields->{$ris_tag} ) eq 'ARRAY'
306 ? @{ $ris_additional_fields->{$ris_tag} }
307 : $ris_additional_fields->{$ris_tag};
309 for my $tag (@fields) {
310 my ( $f, $sf ) = split( /\$/, $tag );
311 my @values = read_field( { record => $record, field => $f, subfield => $sf } );
312 foreach my $v (@values) {
313 print "$ris_tag - $v\r\n";
322 # Let's re-redirect stdout
324 open STDOUT, ">&", $oldout;
331 ##********************************************************************
332 ## print_typetag(): prints the first line of a RIS dataset including
333 ## the preceding newline
334 ## Argument: the leader of a MARC dataset
335 ## Returns: the value at leader position 06
336 ##********************************************************************
339 ## the keys of typehash are the allowed values at position 06
340 ## of the leader of a MARC record, the values are the RIS types
341 ## that might appropriately represent these types.
375 ## The type of a MARC record is found at position 06 of the leader
376 my $typeofrecord = defined($leader) && length $leader >=6 ?
377 substr($leader, 6, 1): undef;
378 ## Pos 07 == Bibliographic level
379 my $biblevel = defined($leader) && length $leader >=7 ?
380 substr($leader, 7, 1): '';
382 ## TODO: for books, field 008 positions 24-27 might have a few more
386 my $marcflavour = C4::Context->preference("marcflavour");
387 my $intype = lc($marcflavour);
388 if ($intype eq "unimarc") {
389 %typehash = %unitypehash;
392 %typehash = %ustypehash;
395 if (!defined $typeofrecord || !exists $typehash{$typeofrecord}) {
396 print "TY - GEN\r\n"; ## most reasonable default
397 warn ("no type found - assume GEN") if $marcprint;
398 } elsif ( $typeofrecord =~ "a" ) {
399 if ( $biblevel eq 'a' ) {
400 print "TY - GEN\r\n"; ## monographic component part
401 } elsif ( $biblevel eq 'b' || $biblevel eq 's' ) {
402 print "TY - SER\r\n"; ## serial or serial component part
403 } elsif ( $biblevel eq 'm' ) {
404 print "TY - $typehash{$typeofrecord}\r\n"; ## book
405 } elsif ( $biblevel eq 'c' || $biblevel eq 'd' ) {
406 print "TY - GEN\r\n"; ## collections, part of collections or made-up collections
407 } elsif ( $biblevel eq 'i' ) {
408 print "TY - DATA\r\n"; ## updating loose-leafe as Dataset
411 print "TY - $typehash{$typeofrecord}\r\n";
414 ## use $typeofrecord as the return value, just in case
418 ##********************************************************************
419 ## normalize_author(): normalizes an authorname
420 ## Arguments: authorname subfield a
421 ## authorname subfield b
422 ## authorname subfield c
423 ## name type if known: 0=direct order
424 ## 1=only surname or full name in
426 ## 3=family, clan, dynasty name
427 ## Returns: the normalized authorname
428 ##********************************************************************
429 sub normalize_author {
430 my($rawauthora, $rawauthorb, $rawauthorc, $nametype) = @_;
432 if ($nametype == 0) {
433 # ToDo: convert every input to Last[,(F.|First)[ (M.|Middle)[,Suffix]]]
434 warn("name >>$rawauthora<< in direct order - leave as is") if $marcprint;
437 elsif ($nametype == 1) {
438 ## start munging subfield a (the real name part)
439 ## remove spaces after separators
440 $rawauthora =~ s%([,.]+) *%$1%g;
442 ## remove trailing separators after spaces
443 $rawauthora =~ s% *[,;:/]*$%%;
445 ## remove periods after a non-abbreviated name
446 $rawauthora =~ s%(\w{2,})\.%$1%g;
448 ## start munging subfield b (something like the suffix)
449 ## remove trailing separators after spaces
450 $rawauthorb =~ s% *[,;:/]*$%%;
452 ## we currently ignore subfield c until someone complains
453 if (length($rawauthorb) > 0) {
454 return join ", ", ($rawauthora, $rawauthorb);
460 elsif ($nametype == 3) {
465 ##********************************************************************
466 ## get_author(): gets authorname info from MARC fields 100, 700
467 ## Argument: field (100 or 700)
468 ## Returns: an author string in the format found in the record
469 ##********************************************************************
471 my ($authorfield) = @_;
474 ## the sequence of the name parts is encoded either in indicator
475 ## 1 (marc21) or 2 (unimarc)
476 my $marcflavour = C4::Context->preference("marcflavour");
477 my $intype = lc($marcflavour);
478 if ($intype eq "unimarc") {
481 else { ## assume marc21
485 print "<marc>:Author(Ind$indicator): ", $authorfield->indicator("$indicator"),"\r\n" if $marcprint;
486 print "<marc>:Author(\$a): ", $authorfield->subfield('a'),"\r\n" if $marcprint;
487 print "<marc>:Author(\$b): ", $authorfield->subfield('b'),"\r\n" if $marcprint;
488 print "<marc>:Author(\$c): ", $authorfield->subfield('c'),"\r\n" if $marcprint;
489 print "<marc>:Author(\$h): ", $authorfield->subfield('h'),"\r\n" if $marcprint;
490 if ($intype eq "ukmarc") {
491 my $authorname = $authorfield->subfield('a') . "," . $authorfield->subfield('h');
492 normalize_author($authorname, $authorfield->subfield('b'), $authorfield->subfield('c'), $authorfield->indicator("$indicator"));
495 normalize_author($authorfield->subfield('a') // '', $authorfield->subfield('b') // '', $authorfield->subfield('c') // '', $authorfield->indicator("$indicator"));
499 ##********************************************************************
500 ## get_editor(): gets editor info from MARC fields 110, 111, 710, 711
501 ## Argument: field (110, 111, 710, or 711)
502 ## Returns: an author string in the format found in the record
503 ##********************************************************************
505 my ($editorfield) = @_;
511 print "<marc>Editor(\$a): ", $editorfield->subfield('a'),"\r\n" if $marcprint;
512 print "<marc>Editor(\$b): ", $editorfield->subfield('b'),"\r\n" if $marcprint;
513 print "<marc>editor(\$c): ", $editorfield->subfield('c'),"\r\n" if $marcprint;
514 return $editorfield->subfield('a');
518 ##********************************************************************
519 ## print_title(): gets info from MARC field 245
520 ## Arguments: field (245)
522 ##********************************************************************
524 my ($titlefield) = @_;
526 print "<marc>empty title field (245)\r\n" if $marcprint;
527 warn("empty title field (245)") if $marcprint;
530 print "<marc>Title(\$a): ",$titlefield->subfield('a'),"\r\n" if $marcprint;
531 print "<marc>Title(\$b): ",$titlefield->subfield('b'),"\r\n" if $marcprint;
532 print "<marc>Title(\$c): ",$titlefield->subfield('c'),"\r\n" if $marcprint;
534 ## The title is usually written in a very odd notation. The title
535 ## proper ($a) often ends with a space followed by a separator like
536 ## a slash or a colon. The subtitle ($b) doesn't start with a space
537 ## so simple concatenation looks odd. We have to conditionally remove
538 ## the separator and make sure there's a space between title and
541 my $clean_title = $titlefield->subfield('a');
543 my $clean_subtitle = $titlefield->subfield('b');
544 $clean_subtitle ||= q{};
545 $clean_title =~ s% *[/:;.]$%%;
546 $clean_subtitle =~ s%^ *(.*) *[/:;.]$%$1%;
548 my $marcflavour = C4::Context->preference("marcflavour");
549 my $intype = lc($marcflavour);
550 if (length($clean_title) > 0
551 || (length($clean_subtitle) > 0 && $intype ne "unimarc")) {
552 print "TI - ", $clean_title;
554 ## subfield $b is relevant only for marc21/ukmarc
555 if (length($clean_subtitle) > 0 && $intype ne "unimarc") {
556 print ": ",$clean_subtitle;
561 ## The statement of responsibility is just this: horrors. There is
562 ## no formal definition how authors, editors and the like should
563 ## be written and designated. The field is free-form and resistant
564 ## to all parsing efforts, so this information is lost on me
569 ##********************************************************************
570 ## print_stitle(): prints info from series title field
573 ##********************************************************************
575 my ($titlefield) = @_;
578 print "<marc>empty series title field\r\n" if $marcprint;
581 print "<marc>Series title(\$a): ",$titlefield->subfield('a'),"\r\n" if $marcprint;
582 my $clean_title = $titlefield->subfield('a');
584 $clean_title =~ s% *[/:;.]$%%;
586 if (length($clean_title) > 0) {
587 print "T2 - ", $clean_title,"\r\n";
590 my $marcflavour = C4::Context->preference("marcflavour");
591 my $intype = lc($marcflavour);
592 if ($intype eq "unimarc") {
593 print "<marc>Series vol(\$v): ",$titlefield->subfield('v'),"\r\n" if $marcprint;
594 if (length($titlefield->subfield('v')) > 0) {
595 print "VL - ", $titlefield->subfield('v'),"\r\n";
602 ##********************************************************************
603 ## print_isbn(): gets info from MARC field 020
604 ## Arguments: field (020)
605 ##********************************************************************
609 if (!$isbnfield || length ($isbnfield->subfield('a')) == 0) {
610 print "<marc>no isbn found (020\$a)\r\n" if $marcprint;
611 warn("no isbn found") if $marcprint;
614 if (length ($isbnfield->subfield('a')) < 10) {
615 print "<marc>truncated isbn (020\$a)\r\n" if $marcprint;
616 warn("truncated isbn") if $marcprint;
619 my $isbn = $isbnfield->subfield('a');
620 print "SN - ", $isbn, "\r\n";
624 ##********************************************************************
625 ## print_issn(): gets info from MARC field 022
626 ## Arguments: field (022)
627 ##********************************************************************
631 if (!$issnfield || length ($issnfield->subfield('a')) == 0) {
632 print "<marc>no issn found (022\$a)\r\n" if $marcprint;
633 warn("no issn found") if $marcprint;
636 if (length ($issnfield->subfield('a')) < 9) {
637 print "<marc>truncated issn (022\$a)\r\n" if $marcprint;
638 warn("truncated issn") if $marcprint;
641 my $issn = substr($issnfield->subfield('a'), 0, 9);
642 print "SN - ", $issn, "\r\n";
647 # print_uri() prints info from 856 u
652 foreach my $f856 (@f856s) {
653 if (my $uri = $f856->subfield('u')) {
654 print "UR - ", $uri, "\r\n";
659 ##********************************************************************
660 ## print_loc_callno(): gets info from MARC field 050
661 ## Arguments: field (050)
662 ##********************************************************************
663 sub print_loc_callno {
664 my($callnofield) = @_;
666 if (!$callnofield || length ($callnofield->subfield('a')) == 0) {
667 print "<marc>no LOC call number found (050\$a)\r\n" if $marcprint;
668 warn("no LOC call number found") if $marcprint;
671 print "AV - ", $callnofield->subfield('a'), " ", $callnofield->subfield('b'), "\r\n";
675 ##********************************************************************
676 ## print_dewey(): gets info from MARC field 082
677 ## Arguments: field (082)
678 ##********************************************************************
680 my($deweyfield) = @_;
682 if (!$deweyfield || length ($deweyfield->subfield('a')) == 0) {
683 print "<marc>no Dewey number found (082\$a)\r\n" if $marcprint;
684 warn("no Dewey number found") if $marcprint;
687 print "U1 - ", $deweyfield->subfield('a'), " ", $deweyfield->subfield('2'), "\r\n";
691 ##********************************************************************
692 ## print_pubinfo(): gets info from MARC field 260
693 ## Arguments: field (260)
694 ##********************************************************************
696 my($pubinfofield) = @_;
698 if (!$pubinfofield) {
699 print "<marc>no publication information found (260/264)\r\n" if $marcprint;
700 warn("no publication information found") if $marcprint;
703 ## the following information is available in MARC21:
705 ## $b publisher -> PB
707 ## the corresponding subfields for UNIMARC:
709 ## $c publisher -> PB
712 ## all of them are repeatable. We pool all places into a
713 ## comma-separated list in CY. We also pool all publishers
714 ## into a comma-separated list in PB. We break the rule with
715 ## the date field because this wouldn't make much sense. In
716 ## this case, we use the first occurrence for PY, the second
717 ## for Y2, and ignore the rest
719 my @pubsubfields = $pubinfofield->subfields();
725 my $pubsub_publisher;
728 my $marcflavour = C4::Context->preference("marcflavour");
729 my $intype = lc($marcflavour);
730 if ($intype eq "unimarc") {
732 $pubsub_publisher = "c";
735 else { ## assume marc21
737 $pubsub_publisher = "b";
741 ## loop over all subfield list entries
742 for my $tuple (@pubsubfields) {
743 ## each tuple consists of the subfield code and the value
744 if (@$tuple[0] eq $pubsub_place) {
745 ## strip any trailing crap
748 ## pool all occurrences in a list
751 elsif (@$tuple[0] eq $pubsub_publisher) {
752 ## strip any trailing crap
755 ## pool all occurrences in a list
756 push (@publishers, $_);
758 elsif (@$tuple[0] eq $pubsub_date) {
759 ## the dates are free-form, so we want to extract
760 ## a four-digit year and leave the rest as
762 my $protoyear = @$tuple[1];
763 print "<marc>Year (260\$c): $protoyear\r\n" if $marcprint;
765 ## strip any separator chars at the end
766 $protoyear =~ s% *[\.;:/]*$%%;
768 ## isolate a four-digit year. We discard anything
769 ## preceding the year, but keep everything after
770 ## the year as other info.
771 $protoyear =~ s%\D*([0-9\-]{4})(.*)%$1///$2%;
773 ## check what we've got. If there is no four-digit
774 ## year, make it up. If digits are replaced by '-',
775 ## replace those with 0s
777 if (index($protoyear, "/") == 4) {
779 ## replace all '-' in the four-digit year
781 substr($protoyear,0,4) =~ s!-!0!g;
785 print "<marc>no four-digit year found, use 0000\r\n" if $marcprint;
786 $protoyear = "0000///$protoyear";
787 warn("no four-digit year found, use 0000") if $marcprint;
790 if ($pycounter == 0 && length($protoyear)) {
791 print "PY - $protoyear\r\n";
793 elsif ($pycounter == 1 && length($_)) {
794 print "Y2 - $protoyear\r\n";
801 ## now dump the collected CY and PB lists
803 print "CY - ", join(", ", @cities), "\r\n";
805 if (@publishers > 0) {
806 print "PB - ", join(", ", @publishers), "\r\n";
811 ##********************************************************************
812 ## get_keywords(): prints info from MARC fields 6XX
813 ## Arguments: list of fields (6XX)
814 ##********************************************************************
816 my($fieldname, @keywords) = @_;
819 ## a list of all possible subfields
820 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');
822 ## loop over all 6XX fields
823 foreach my $kwfield (@keywords) {
824 if( defined $kwfield ) {
825 ## authornames get special treatment
826 if ($fieldname eq "600") {
827 my $val = normalize_author($kwfield->subfield('a'), $kwfield->subfield('b'), $kwfield->subfield('c'), $kwfield->indicator('1'));
829 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;
832 ## retrieve all available subfields
833 my @kwsubfields = $kwfield->subfields();
835 ## loop over all available subfield tuples
836 foreach my $kwtuple (@kwsubfields) {
837 ## loop over all subfields to check
838 foreach my $subfield (@subfields) {
839 ## [0] contains subfield code
840 if (@$kwtuple[0] eq $subfield) {
841 ## [1] contains value, remove trailing separators
842 @$kwtuple[1] =~ s% *[,;.:/]*$%%;
843 if (length(@$kwtuple[1]) > 0) {
844 push @kw, @$kwtuple[1];
845 print "<marc>Field $fieldname subfield $subfield:", @$kwtuple[1], "\r\n" if $marcprint;
847 ## we can leave the subfields loop here
858 ##********************************************************************
859 ## pool_subx(): adds contents of several subfields to a list
860 ## Arguments: reference to a list
862 ## list of fields (5XX)
863 ##********************************************************************
865 my($aref, $fieldname, @notefields) = @_;
867 ## we use a list that contains the interesting subfields
869 # ToDo: this is apparently correct only for marc21
872 if ($fieldname eq "500") {
875 elsif ($fieldname eq "501") {
878 elsif ($fieldname eq "502") {
881 elsif ($fieldname eq "504") {
882 @subfields = ('a', 'b');
884 elsif ($fieldname eq "505") {
885 @subfields = ('a', 'g', 'r', 't', 'u');
887 elsif ($fieldname eq "506") {
888 @subfields = ('a', 'b', 'c', 'd', 'e');
890 elsif ($fieldname eq "507") {
891 @subfields = ('a', 'b');
893 elsif ($fieldname eq "508") {
896 elsif ($fieldname eq "510") {
897 @subfields = ('a', 'b', 'c', 'x', '3');
899 elsif ($fieldname eq "511") {
902 elsif ($fieldname eq "513") {
903 @subfields = ('a', 'b');
905 elsif ($fieldname eq "514") {
906 @subfields = ('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'm', 'u', 'z');
908 elsif ($fieldname eq "515") {
911 elsif ($fieldname eq "516") {
914 elsif ($fieldname eq "518") {
915 @subfields = ('a', '3');
917 elsif ($fieldname eq "521") {
918 @subfields = ('a', 'b', '3');
920 elsif ($fieldname eq "522") {
923 elsif ($fieldname eq "524") {
924 @subfields = ('a', '2', '3');
926 elsif ($fieldname eq "525") {
929 elsif ($fieldname eq "526") {
930 @subfields = ('a', 'b', 'c', 'd', 'i', 'x', 'z', '5');
932 elsif ($fieldname eq "530") {
933 @subfields = ('a', 'b', 'c', 'd', 'u', '3');
935 elsif ($fieldname eq "533") {
936 @subfields = ('a', 'b', 'c', 'd', 'e', 'f', 'm', 'n', '3');
938 elsif ($fieldname eq "534") {
939 @subfields = ('a', 'b', 'c', 'e', 'f', 'k', 'l', 'm', 'n', 'p', 't', 'x', 'z');
941 elsif ($fieldname eq "535") {
942 @subfields = ('a', 'b', 'c', 'd', 'g', '3');
945 ## loop over all notefields
946 foreach my $notefield (@notefields) {
947 if (defined $notefield) {
948 ## retrieve all available subfield tuples
949 my @notesubfields = $notefield->subfields();
951 ## loop over all subfield tuples
952 foreach my $notetuple (@notesubfields) {
953 ## loop over all subfields to check
954 foreach my $subfield (@subfields) {
955 ## [0] contains subfield code
956 if (@$notetuple[0] eq $subfield) {
957 ## [1] contains value, remove trailing separators
958 print "<marc>field $fieldname subfield $subfield: ", @$notetuple[1], "\r\n" if $marcprint;
959 @$notetuple[1] =~ s% *[,;.:/]*$%%;
960 if (length(@$notetuple[1]) > 0) {
962 push @{$aref}, @$notetuple[1];
972 ##********************************************************************
973 ## print_abstract(): prints abstract fields
974 ## Arguments: list of fields (520)
975 ##********************************************************************
977 # ToDo: take care of repeatable subfields
980 ## we check the following subfields
981 my @subfields = ('a', 'b');
983 ## we generate a list for all useful strings
986 ## loop over all abfields
987 foreach my $abfield (@abfields) {
988 foreach my $field (@subfields) {
989 if ( length( $abfield->subfield($field) ) > 0 ) {
990 my $ab = $abfield->subfield($field);
992 print "<marc>field 520 subfield $field: $ab\r\n" if $marcprint;
994 ## strip trailing separators
995 $ab =~ s% *[;,:./]*$%%;
997 ## add string to the list
998 push( @abstrings, $ab );
1003 my $allabs = join "; ", @abstrings;
1005 if (length($allabs) > 0) {
1006 print "N2 - ", $allabs, "\r\n";