From bbd551d966ddf29885ecb6c14aa7bf5675c1b273 Mon Sep 17 00:00:00 2001 From: Kyle M Hall Date: Fri, 23 Jan 2015 07:20:42 -0500 Subject: [PATCH] Bug 12357 - Tidy Ris.pm --- C4/Ris.pm | 1148 ++++++++++++++++++++++++++++++++----------------------------- 1 files changed, 594 insertions(+), 554 deletions(-) diff --git a/C4/Ris.pm b/C4/Ris.pm index f212ca2..921cc9d 100644 --- a/C4/Ris.pm +++ b/C4/Ris.pm @@ -16,7 +16,7 @@ package C4::Ris; ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation; either version 2 of the License, or ## (at your option) any later version. -## +## ## This program is distributed in the hope that it will be useful, ## but WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the @@ -37,7 +37,6 @@ package C4::Ris; ## comparing UKMARC to MARC21 found at: ## www.bl.uk/services/bibliographic/marcchange.pdf - # Modified 2008 by BibLibre for Koha # Modified 2011 by Catalyst # Modified 2011 by Equinox Software, Inc. @@ -83,7 +82,6 @@ our $intype; our $marcprint; our $protoyear; - =head1 marc2bibtex - Convert from UNIMARC to RIS my ($ris) = marc2ris($record); @@ -99,14 +97,14 @@ sub marc2ris { my $output; my $marcflavour = C4::Context->preference("marcflavour"); - my $intype = lc($marcflavour); - my $marcprint = 0; # Debug flag; + my $intype = lc($marcflavour); + my $marcprint = 0; # Debug flag; # Let's redirect stdout open my $oldout, ">&STDOUT"; my $outvar; close STDOUT; - open STDOUT,'>', \$outvar; + open STDOUT, '>', \$outvar; ## First we should check the character encoding. This may be ## MARC-8 or UTF-8. The former is indicated by a blank, the latter @@ -138,7 +136,7 @@ sub marc2ris { ## start RIS dataset if ( $ris_additional_fields && $ris_additional_fields->{TY} ) { my ( $f, $sf ) = split( /\$/, $ris_additional_fields->{TY} ); - my ( $type ) = read_field( { record => $record, field => $f, subfield => $sf, field_numbers => [1] } ); + my ($type) = read_field( { record => $record, field => $f, subfield => $sf, field_numbers => [1] } ); if ($type) { print "TY - $type\r\n"; } @@ -150,168 +148,192 @@ sub marc2ris { &print_typetag($leader); } - ## retrieve all author fields and collect them in a list - my @author_fields; - - if ($intype eq "unimarc") { - ## Fields 700, 701, and 702 can contain author names - @author_fields = ($record->field('700'), $record->field('701'), $record->field('702')); - } - else { ## marc21, ukmarc - ## Field 100 sometimes carries main author - ## Field(s) 700 carry added entries - personal names - @author_fields = ($record->field('100'), $record->field('700')); - } - - ## loop over all author fields - foreach my $field (@author_fields) { - if (length($field)) { - my $author = &get_author($field); - print "AU - ",&charconv($author),"\r\n"; - } - } - - # ToDo: should we specify anonymous as author if we didn't find - # one? or use one of the corporate/meeting names below? - - ## add corporate names or meeting names as editors ?? - my @editor_fields; - - if ($intype eq "unimarc") { - ## Fields 710, 711, and 712 can carry corporate names - ## Field(s) 720, 721, 722, 730 have additional candidates - @editor_fields = ($record->field('710'), $record->field('711'), $record->field('712'), $record->field('720'), $record->field('721'), $record->field('722'), $record->field('730')); - } - else { ## marc21, ukmarc - ## Fields 110 and 111 carry the main entries - corporate name and - ## meeting name, respectively - ## Field(s) 710, 711 carry added entries - personal names - @editor_fields = ($record->field('110'), $record->field('111'), $record->field('710'), $record->field('711')); - } - - ## loop over all editor fields - foreach my $field (@editor_fields) { - if (length($field)) { - my $editor = &get_editor($field); - print "ED - ",&charconv($editor),"\r\n"; - } - } - - ## get info from the title field - if ($intype eq "unimarc") { - &print_title($record->field('200')); - } - else { ## marc21, ukmarc - &print_title($record->field('245')); - } - - ## series title - if ($intype eq "unimarc") { - &print_stitle($record->field('225')); - } - else { ## marc21, ukmarc - &print_stitle($record->field('490')); - } - - ## ISBN/ISSN - if ($intype eq "unimarc") { - &print_isbn($record->field('010')); - &print_issn($record->field('011')); - } - elsif ($intype eq "ukmarc") { - &print_isbn($record->field('021')); - ## this is just an assumption - &print_issn($record->field('022')); - } - else { ## assume marc21 - &print_isbn($record->field('020')); - &print_issn($record->field('022')); - } - - if ($intype eq "marc21") { - &print_loc_callno($record->field('050')); - &print_dewey($record->field('082')); - } - ## else: unimarc, ukmarc do not seem to store call numbers? - - ## publication info - if ($intype eq "unimarc") { - &print_pubinfo($record->field('210')); - } - else { ## marc21, ukmarc - if ($record->field('264')) { - &print_pubinfo($record->field('264')); - } - else { - &print_pubinfo($record->field('260')); - } - } + ## retrieve all author fields and collect them in a list + my @author_fields; + + if ( $intype eq "unimarc" ) { + ## Fields 700, 701, and 702 can contain author names + @author_fields = ( $record->field('700'), $record->field('701'), $record->field('702') ); + } + else { ## marc21, ukmarc + ## Field 100 sometimes carries main author + ## Field(s) 700 carry added entries - personal names + @author_fields = ( $record->field('100'), $record->field('700') ); + } + + ## loop over all author fields + foreach my $field (@author_fields) { + if ( length($field) ) { + my $author = &get_author($field); + print "AU - ", &charconv($author), "\r\n"; + } + } + + # ToDo: should we specify anonymous as author if we didn't find + # one? or use one of the corporate/meeting names below? - ## 6XX fields contain KW candidates. We add all of them to a + ## add corporate names or meeting names as editors ?? + my @editor_fields; + + if ( $intype eq "unimarc" ) { + ## Fields 710, 711, and 712 can carry corporate names + ## Field(s) 720, 721, 722, 730 have additional candidates + @editor_fields = ( + $record->field('710'), $record->field('711'), $record->field('712'), $record->field('720'), + $record->field('721'), $record->field('722'), $record->field('730') + ); + } + else { ## marc21, ukmarc + ## Fields 110 and 111 carry the main entries - corporate name and + ## meeting name, respectively + ## Field(s) 710, 711 carry added entries - personal names + @editor_fields = ( $record->field('110'), $record->field('111'), $record->field('710'), $record->field('711') ); + } + + ## loop over all editor fields + foreach my $field (@editor_fields) { + if ( length($field) ) { + my $editor = &get_editor($field); + print "ED - ", &charconv($editor), "\r\n"; + } + } + + ## get info from the title field + if ( $intype eq "unimarc" ) { + &print_title( $record->field('200') ); + } + else { ## marc21, ukmarc + &print_title( $record->field('245') ); + } + + ## series title + if ( $intype eq "unimarc" ) { + &print_stitle( $record->field('225') ); + } + else { ## marc21, ukmarc + &print_stitle( $record->field('490') ); + } + + ## ISBN/ISSN + if ( $intype eq "unimarc" ) { + &print_isbn( $record->field('010') ); + &print_issn( $record->field('011') ); + } + elsif ( $intype eq "ukmarc" ) { + &print_isbn( $record->field('021') ); + ## this is just an assumption + &print_issn( $record->field('022') ); + } + else { ## assume marc21 + &print_isbn( $record->field('020') ); + &print_issn( $record->field('022') ); + } + + if ( $intype eq "marc21" ) { + &print_loc_callno( $record->field('050') ); + &print_dewey( $record->field('082') ); + } + ## else: unimarc, ukmarc do not seem to store call numbers? + + ## publication info + if ( $intype eq "unimarc" ) { + &print_pubinfo( $record->field('210') ); + } + else { ## marc21, ukmarc + if ( $record->field('264') ) { + &print_pubinfo( $record->field('264') ); + } + else { + &print_pubinfo( $record->field('260') ); + } + } + + ## 6XX fields contain KW candidates. We add all of them to a my @field_list; - if ($intype eq "unimarc") { - @field_list = ('600', '601', '602', '604', '605', '606','607', '608', '610', '615', '620', '660'. '661', '670', '675', '676', '680', '686'); - } elsif ($intype eq "ukmarc") { - @field_list = ('600', '610', '611', '630', '650', '651','653', '655', '660', '661', '668', '690', '691', '692', '695'); - } else { ## assume marc21 - @field_list = ('600', '610', '611', '630', '650', '651','653', '654', '655', '656', '657', '658'); + if ( $intype eq "unimarc" ) { + @field_list = ( + '600', '601', '602', '604', '605', '606', + '607', '608', '610', '615', '620', '660' . '661', + '670', '675', '676', '680', '686' + ); + } + elsif ( $intype eq "ukmarc" ) { + @field_list = + ( '600', '610', '611', '630', '650', '651', '653', '655', '660', '661', '668', '690', '691', '692', '695' ); + } + else { ## assume marc21 + @field_list = ( '600', '610', '611', '630', '650', '651', '653', '654', '655', '656', '657', '658' ); } my @kwpool; - for my $f ( @field_list ) { + for my $f (@field_list) { my @fields = $record->field($f); - push @kwpool, ( get_keywords("$f",$record->field($f)) ); + push @kwpool, ( get_keywords( "$f", $record->field($f) ) ); } # Remove duplicate @kwpool = uniq @kwpool; - for my $kw ( @kwpool ) { + for my $kw (@kwpool) { print "KW - ", &charconv($kw), "\r\n"; } - ## 5XX have various candidates for notes and abstracts. We pool - ## all notes-like stuff in one list. - my @notepool; + ## 5XX have various candidates for notes and abstracts. We pool + ## all notes-like stuff in one list. + my @notepool; - ## these fields have notes candidates - if ($intype eq "unimarc") { - 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') { - &pool_subx(\@notepool, $_, $record->field($_)); - } - } - elsif ($intype eq "ukmarc") { - 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') { - &pool_subx(\@notepool, $_, $record->field($_)); + ## these fields have notes candidates + if ( $intype eq "unimarc" ) { + 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' + ) + { + &pool_subx( \@notepool, $_, $record->field($_) ); + } + } + elsif ( $intype eq "ukmarc" ) { + 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' + ) + { + &pool_subx( \@notepool, $_, $record->field($_) ); } - } - else { ## assume marc21 - 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') { - &pool_subx(\@notepool, $_, $record->field($_)); - } - } - - my $allnotes = join "; ", @notepool; - - if (length($allnotes) > 0) { - print "N1 - ", &charconv($allnotes), "\r\n"; - } - - ## 320/520 have the abstract - if ($intype eq "unimarc") { - &print_abstract($record->field('320')); - } - elsif ($intype eq "ukmarc") { - &print_abstract($record->field('512'), $record->field('513')); - } - else { ## assume marc21 - &print_abstract($record->field('520')); - } - + } + else { ## assume marc21 + 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' + ) + { + &pool_subx( \@notepool, $_, $record->field($_) ); + } + } + + my $allnotes = join "; ", @notepool; + + if ( length($allnotes) > 0 ) { + print "N1 - ", &charconv($allnotes), "\r\n"; + } + + ## 320/520 have the abstract + if ( $intype eq "unimarc" ) { + &print_abstract( $record->field('320') ); + } + elsif ( $intype eq "ukmarc" ) { + &print_abstract( $record->field('512'), $record->field('513') ); + } + else { ## assume marc21 + &print_abstract( $record->field('520') ); + } + # 856u has the URI - if ($record->field('856')) { - print_uri($record->field('856')); + if ( $record->field('856') ) { + print_uri( $record->field('856') ); } if ($ris_additional_fields) { @@ -333,88 +355,87 @@ sub marc2ris { } } - ## end RIS dataset - print "ER - \r\n"; + ## end RIS dataset + print "ER - \r\n"; # Let's re-redirect stdout close STDOUT; open STDOUT, ">&", $oldout; - + return $outvar; } - ##******************************************************************** ## print_typetag(): prints the first line of a RIS dataset including ## the preceeding newline ## Argument: the leader of a MARC dataset -## Returns: the value at leader position 06 +## Returns: the value at leader position 06 ##******************************************************************** sub print_typetag { - my ($leader)= @_; + my ($leader) = @_; ## the keys of typehash are the allowed values at position 06 ## of the leader of a MARC record, the values are the RIS types ## that might appropriately represent these types. my %ustypehash = ( - "a" => "BOOK", - "c" => "MUSIC", - "d" => "MUSIC", - "e" => "MAP", - "f" => "MAP", - "g" => "ADVS", - "i" => "SOUND", - "j" => "SOUND", - "k" => "ART", - "m" => "DATA", - "o" => "GEN", - "p" => "GEN", - "r" => "ART", - "t" => "GEN", - ); - + "a" => "BOOK", + "c" => "MUSIC", + "d" => "MUSIC", + "e" => "MAP", + "f" => "MAP", + "g" => "ADVS", + "i" => "SOUND", + "j" => "SOUND", + "k" => "ART", + "m" => "DATA", + "o" => "GEN", + "p" => "GEN", + "r" => "ART", + "t" => "GEN", + ); + my %unitypehash = ( - "a" => "BOOK", - "b" => "BOOK", - "c" => "MUSIC", - "d" => "MUSIC", - "e" => "MAP", - "f" => "MAP", - "g" => "ADVS", - "i" => "SOUND", - "j" => "SOUND", - "k" => "ART", - "l" => "ELEC", - "m" => "ADVS", - "r" => "ART", - ); - + "a" => "BOOK", + "b" => "BOOK", + "c" => "MUSIC", + "d" => "MUSIC", + "e" => "MAP", + "f" => "MAP", + "g" => "ADVS", + "i" => "SOUND", + "j" => "SOUND", + "k" => "ART", + "l" => "ELEC", + "m" => "ADVS", + "r" => "ART", + ); + ## The type of a MARC record is found at position 06 of the leader - my $typeofrecord = substr($leader, 6, 1); + my $typeofrecord = substr( $leader, 6, 1 ); ## ToDo: for books, field 008 positions 24-27 might have a few more ## hints my %typehash; - + ## the ukmarc here is just a guess - if ($intype eq "marc21" || $intype eq "ukmarc") { - %typehash = %ustypehash; + if ( $intype eq "marc21" || $intype eq "ukmarc" ) { + %typehash = %ustypehash; } - elsif ($intype eq "unimarc") { - %typehash = %unitypehash; + elsif ( $intype eq "unimarc" ) { + %typehash = %unitypehash; } else { - ## assume MARC21 as default - %typehash = %ustypehash; + ## assume MARC21 as default + %typehash = %ustypehash; } - if (!exists $typehash{$typeofrecord}) { - print "TY - BOOK\r\n"; ## most reasonable default - warn ("no type found - assume BOOK") if $marcprint; + if ( !exists $typehash{$typeofrecord} ) { + print "TY - BOOK\r\n"; ## most reasonable default + warn("no type found - assume BOOK") if $marcprint; } else { - print "TY - $typehash{$typeofrecord}\r\n"; + print "TY - $typehash{$typeofrecord}\r\n"; } ## use $typeofrecord as the return value, just in case @@ -433,38 +454,39 @@ sub print_typetag { ## Returns: the normalized authorname ##******************************************************************** sub normalize_author { - my($rawauthora, $rawauthorb, $rawauthorc, $nametype) = @_; + my ( $rawauthora, $rawauthorb, $rawauthorc, $nametype ) = @_; + + if ( $nametype == 0 ) { - if ($nametype == 0) { - # ToDo: convert every input to Last[,(F.|First)[ (M.|Middle)[,Suffix]]] - warn("name >>$rawauthora<< in direct order - leave as is") if $marcprint; - return $rawauthora; + # ToDo: convert every input to Last[,(F.|First)[ (M.|Middle)[,Suffix]]] + warn("name >>$rawauthora<< in direct order - leave as is") if $marcprint; + return $rawauthora; } - elsif ($nametype == 1) { - ## start munging subfield a (the real name part) - ## remove spaces after separators - $rawauthora =~ s%([,.]+) *%$1%g; + elsif ( $nametype == 1 ) { + ## start munging subfield a (the real name part) + ## remove spaces after separators + $rawauthora =~ s%([,.]+) *%$1%g; - ## remove trailing separators after spaces - $rawauthora =~ s% *[,;:/]*$%%; + ## remove trailing separators after spaces + $rawauthora =~ s% *[,;:/]*$%%; - ## remove periods after a non-abbreviated name - $rawauthora =~ s%(\w{2,})\.%$1%g; + ## remove periods after a non-abbreviated name + $rawauthora =~ s%(\w{2,})\.%$1%g; - ## start munging subfield b (something like the suffix) - ## remove trailing separators after spaces - $rawauthorb =~ s% *[,;:/]*$%%; + ## start munging subfield b (something like the suffix) + ## remove trailing separators after spaces + $rawauthorb =~ s% *[,;:/]*$%%; - ## we currently ignore subfield c until someone complains - if (length($rawauthorb) > 0) { - return join ",", ($rawauthora, $rawauthorb); - } - else { - return $rawauthora; - } + ## we currently ignore subfield c until someone complains + if ( length($rawauthorb) > 0 ) { + return join ",", ( $rawauthora, $rawauthorb ); + } + else { + return $rawauthora; + } } - elsif ($nametype == 3) { - return $rawauthora; + elsif ( $nametype == 3 ) { + return $rawauthora; } } @@ -479,24 +501,33 @@ sub get_author { ## the sequence of the name parts is encoded either in indicator ## 1 (marc21) or 2 (unimarc) - if ($intype eq "unimarc") { - $indicator = 2; + if ( $intype eq "unimarc" ) { + $indicator = 2; } - else { ## assume marc21 - $indicator = 1; + else { ## assume marc21 + $indicator = 1; } - print ":Author(Ind$indicator): ", $authorfield->indicator("$indicator"),"\r\n" if $marcprint; - print ":Author(\$a): ", $authorfield->subfield('a'),"\r\n" if $marcprint; - print ":Author(\$b): ", $authorfield->subfield('b'),"\r\n" if $marcprint; - print ":Author(\$c): ", $authorfield->subfield('c'),"\r\n" if $marcprint; - print ":Author(\$h): ", $authorfield->subfield('h'),"\r\n" if $marcprint; - if ($intype eq "ukmarc") { - my $authorname = $authorfield->subfield('a') . "," . $authorfield->subfield('h'); - normalize_author($authorname, $authorfield->subfield('b'), $authorfield->subfield('c'), $authorfield->indicator("$indicator")); + print ":Author(Ind$indicator): ", $authorfield->indicator("$indicator"), "\r\n" if $marcprint; + print ":Author(\$a): ", $authorfield->subfield('a'), "\r\n" if $marcprint; + print ":Author(\$b): ", $authorfield->subfield('b'), "\r\n" if $marcprint; + print ":Author(\$c): ", $authorfield->subfield('c'), "\r\n" if $marcprint; + print ":Author(\$h): ", $authorfield->subfield('h'), "\r\n" if $marcprint; + + if ( $intype eq "ukmarc" ) { + my $authorname = $authorfield->subfield('a') . "," . $authorfield->subfield('h'); + normalize_author( + $authorname, + $authorfield->subfield('b'), + $authorfield->subfield('c'), + $authorfield->indicator("$indicator") + ); } else { - normalize_author($authorfield->subfield('a'), $authorfield->subfield('b'), $authorfield->subfield('c'), $authorfield->indicator("$indicator")); + normalize_author( + $authorfield->subfield('a'), $authorfield->subfield('b'), + $authorfield->subfield('c'), $authorfield->indicator("$indicator") + ); } } @@ -508,92 +539,93 @@ sub get_author { sub get_editor { my ($editorfield) = @_; - if (!$editorfield) { - return; + if ( !$editorfield ) { + return; } else { - print "Editor(\$a): ", $editorfield->subfield('a'),"\r\n" if $marcprint; - print "Editor(\$b): ", $editorfield->subfield('b'),"\r\n" if $marcprint; - print "editor(\$c): ", $editorfield->subfield('c'),"\r\n" if $marcprint; - return $editorfield->subfield('a'); + print "Editor(\$a): ", $editorfield->subfield('a'), "\r\n" if $marcprint; + print "Editor(\$b): ", $editorfield->subfield('b'), "\r\n" if $marcprint; + print "editor(\$c): ", $editorfield->subfield('c'), "\r\n" if $marcprint; + return $editorfield->subfield('a'); } } ##******************************************************************** ## print_title(): gets info from MARC field 245 ## Arguments: field (245) -## Returns: +## Returns: ##******************************************************************** sub print_title { my ($titlefield) = @_; - if (!$titlefield) { - print "empty title field (245)\r\n" if $marcprint; - warn("empty title field (245)") if $marcprint; + if ( !$titlefield ) { + print "empty title field (245)\r\n" if $marcprint; + warn("empty title field (245)") if $marcprint; } else { - print "Title(\$a): ",$titlefield->subfield('a'),"\r\n" if $marcprint; - print "Title(\$b): ",$titlefield->subfield('b'),"\r\n" if $marcprint; - print "Title(\$c): ",$titlefield->subfield('c'),"\r\n" if $marcprint; - - ## The title is usually written in a very odd notation. The title - ## proper ($a) often ends with a space followed by a separator like - ## a slash or a colon. The subtitle ($b) doesn't start with a space - ## so simple concatenation looks odd. We have to conditionally remove - ## the separator and make sure there's a space between title and - ## subtitle - - my $clean_title = $titlefield->subfield('a'); - - my $clean_subtitle = $titlefield->subfield('b'); -$clean_subtitle ||= q{}; - $clean_title =~ s% *[/:;.]$%%; - $clean_subtitle =~ s%^ *(.*) *[/:;.]$%$1%; - - if (length($clean_title) > 0 - || (length($clean_subtitle) > 0 && $intype ne "unimarc")) { - print "TI - ", &charconv($clean_title); - - ## subfield $b is relevant only for marc21/ukmarc - if (length($clean_subtitle) > 0 && $intype ne "unimarc") { - print ": ",&charconv($clean_subtitle); - } - print "\r\n"; - } - - ## The statement of responsibility is just this: horrors. There is - ## no formal definition how authors, editors and the like should - ## be written and designated. The field is free-form and resistant - ## to all parsing efforts, so this information is lost on me + print "Title(\$a): ", $titlefield->subfield('a'), "\r\n" if $marcprint; + print "Title(\$b): ", $titlefield->subfield('b'), "\r\n" if $marcprint; + print "Title(\$c): ", $titlefield->subfield('c'), "\r\n" if $marcprint; + + ## The title is usually written in a very odd notation. The title + ## proper ($a) often ends with a space followed by a separator like + ## a slash or a colon. The subtitle ($b) doesn't start with a space + ## so simple concatenation looks odd. We have to conditionally remove + ## the separator and make sure there's a space between title and + ## subtitle + + my $clean_title = $titlefield->subfield('a'); + + my $clean_subtitle = $titlefield->subfield('b'); + $clean_subtitle ||= q{}; + $clean_title =~ s% *[/:;.]$%%; + $clean_subtitle =~ s%^ *(.*) *[/:;.]$%$1%; + + if ( length($clean_title) > 0 + || ( length($clean_subtitle) > 0 && $intype ne "unimarc" ) ) + { + print "TI - ", &charconv($clean_title); + + ## subfield $b is relevant only for marc21/ukmarc + if ( length($clean_subtitle) > 0 && $intype ne "unimarc" ) { + print ": ", &charconv($clean_subtitle); + } + print "\r\n"; + } + + ## The statement of responsibility is just this: horrors. There is + ## no formal definition how authors, editors and the like should + ## be written and designated. The field is free-form and resistant + ## to all parsing efforts, so this information is lost on me } } ##******************************************************************** ## print_stitle(): prints info from series title field -## Arguments: field -## Returns: +## Arguments: field +## Returns: ##******************************************************************** sub print_stitle { my ($titlefield) = @_; - if (!$titlefield) { - print "empty series title field\r\n" if $marcprint; + if ( !$titlefield ) { + print "empty series title field\r\n" if $marcprint; } else { - print "Series title(\$a): ",$titlefield->subfield('a'),"\r\n" if $marcprint; - my $clean_title = $titlefield->subfield('a'); + print "Series title(\$a): ", $titlefield->subfield('a'), "\r\n" if $marcprint; + my $clean_title = $titlefield->subfield('a'); - $clean_title =~ s% *[/:;.]$%%; + $clean_title =~ s% *[/:;.]$%%; - if (length($clean_title) > 0) { - print "T2 - ", &charconv($clean_title),"\r\n"; - } + if ( length($clean_title) > 0 ) { + print "T2 - ", &charconv($clean_title), "\r\n"; + } - if ($intype eq "unimarc") { - print "Series vol(\$v): ",$titlefield->subfield('v'),"\r\n" if $marcprint; - if (length($titlefield->subfield('v')) > 0) { - print "VL - ", &charconv($titlefield->subfield('v')),"\r\n"; - } - } + if ( $intype eq "unimarc" ) { + print "Series vol(\$v): ", $titlefield->subfield('v'), "\r\n" if $marcprint; + if ( length( $titlefield->subfield('v') ) > 0 ) { + print "VL - ", &charconv( $titlefield->subfield('v') ), "\r\n"; + } + } } } @@ -602,20 +634,20 @@ sub print_stitle { ## Arguments: field (020) ##******************************************************************** sub print_isbn { - my($isbnfield) = @_; + my ($isbnfield) = @_; - if (!$isbnfield || length ($isbnfield->subfield('a')) == 0) { - print "no isbn found (020\$a)\r\n" if $marcprint; - warn("no isbn found") if $marcprint; + if ( !$isbnfield || length( $isbnfield->subfield('a') ) == 0 ) { + print "no isbn found (020\$a)\r\n" if $marcprint; + warn("no isbn found") if $marcprint; } else { - if (length ($isbnfield->subfield('a')) < 10) { - print "truncated isbn (020\$a)\r\n" if $marcprint; - warn("truncated isbn") if $marcprint; - } + if ( length( $isbnfield->subfield('a') ) < 10 ) { + print "truncated isbn (020\$a)\r\n" if $marcprint; + warn("truncated isbn") if $marcprint; + } - my $isbn = substr($isbnfield->subfield('a'), 0, 10); - print "SN - ", &charconv($isbn), "\r\n"; + my $isbn = substr( $isbnfield->subfield('a'), 0, 10 ); + print "SN - ", &charconv($isbn), "\r\n"; } } @@ -624,32 +656,32 @@ sub print_isbn { ## Arguments: field (022) ##******************************************************************** sub print_issn { - my($issnfield) = @_; + my ($issnfield) = @_; - if (!$issnfield || length ($issnfield->subfield('a')) == 0) { - print "no issn found (022\$a)\r\n" if $marcprint; - warn("no issn found") if $marcprint; + if ( !$issnfield || length( $issnfield->subfield('a') ) == 0 ) { + print "no issn found (022\$a)\r\n" if $marcprint; + warn("no issn found") if $marcprint; } else { - if (length ($issnfield->subfield('a')) < 9) { - print "truncated issn (022\$a)\r\n" if $marcprint; - warn("truncated issn") if $marcprint; - } + if ( length( $issnfield->subfield('a') ) < 9 ) { + print "truncated issn (022\$a)\r\n" if $marcprint; + warn("truncated issn") if $marcprint; + } - my $issn = substr($issnfield->subfield('a'), 0, 9); - print "SN - ", &charconv($issn), "\r\n"; + my $issn = substr( $issnfield->subfield('a'), 0, 9 ); + print "SN - ", &charconv($issn), "\r\n"; } } ### -# print_uri() prints info from 856 u +# print_uri() prints info from 856 u ### sub print_uri { my @f856s = @_; foreach my $f856 (@f856s) { - if (my $uri = $f856->subfield('u')) { - print "UR - ", charconv($uri), "\r\n"; + if ( my $uri = $f856->subfield('u') ) { + print "UR - ", charconv($uri), "\r\n"; } } } @@ -659,14 +691,14 @@ sub print_uri { ## Arguments: field (050) ##******************************************************************** sub print_loc_callno { - my($callnofield) = @_; + my ($callnofield) = @_; - if (!$callnofield || length ($callnofield->subfield('a')) == 0) { - print "no LOC call number found (050\$a)\r\n" if $marcprint; - warn("no LOC call number found") if $marcprint; + if ( !$callnofield || length( $callnofield->subfield('a') ) == 0 ) { + print "no LOC call number found (050\$a)\r\n" if $marcprint; + warn("no LOC call number found") if $marcprint; } else { - print "AV - ", &charconv($callnofield->subfield('a')), " ", &charconv($callnofield->subfield('b')), "\r\n"; + print "AV - ", &charconv( $callnofield->subfield('a') ), " ", &charconv( $callnofield->subfield('b') ), "\r\n"; } } @@ -675,14 +707,14 @@ sub print_loc_callno { ## Arguments: field (082) ##******************************************************************** sub print_dewey { - my($deweyfield) = @_; + my ($deweyfield) = @_; - if (!$deweyfield || length ($deweyfield->subfield('a')) == 0) { - print "no Dewey number found (082\$a)\r\n" if $marcprint; - warn("no Dewey number found") if $marcprint; + if ( !$deweyfield || length( $deweyfield->subfield('a') ) == 0 ) { + print "no Dewey number found (082\$a)\r\n" if $marcprint; + warn("no Dewey number found") if $marcprint; } else { - print "U1 - ", &charconv($deweyfield->subfield('a')), " ", &charconv($deweyfield->subfield('2')), "\r\n"; + print "U1 - ", &charconv( $deweyfield->subfield('a') ), " ", &charconv( $deweyfield->subfield('2') ), "\r\n"; } } @@ -691,116 +723,116 @@ sub print_dewey { ## Arguments: field (260) ##******************************************************************** sub print_pubinfo { - my($pubinfofield) = @_; + my ($pubinfofield) = @_; - if (!$pubinfofield) { - print "no publication information found (260/264)\r\n" if $marcprint; - warn("no publication information found") if $marcprint; + if ( !$pubinfofield ) { + print "no publication information found (260/264)\r\n" if $marcprint; + warn("no publication information found") if $marcprint; } else { - ## the following information is available in MARC21: - ## $a place -> CY - ## $b publisher -> PB - ## $c date -> PY - ## the corresponding subfields for UNIMARC: - ## $a place -> CY - ## $c publisher -> PB - ## $d date -> PY - - ## all of them are repeatable. We pool all places into a - ## comma-separated list in CY. We also pool all publishers - ## into a comma-separated list in PB. We break the rule with - ## the date field because this wouldn't make much sense. In - ## this case, we use the first occurrence for PY, the second - ## for Y2, and ignore the rest - - my @pubsubfields = $pubinfofield->subfields(); - my @cities; - my @publishers; - my $pycounter = 0; - - my $pubsub_place; - my $pubsub_publisher; - my $pubsub_date; - - if ($intype eq "unimarc") { - $pubsub_place = "a"; - $pubsub_publisher = "c"; - $pubsub_date = "d"; - } - else { ## assume marc21 - $pubsub_place = "a"; - $pubsub_publisher = "b"; - $pubsub_date = "c"; - } - - ## loop over all subfield list entries - for my $tuple (@pubsubfields) { - ## each tuple consists of the subfield code and the value - if (@$tuple[0] eq $pubsub_place) { - ## strip any trailing crap - $_ = @$tuple[1]; - s% *[,;:/]$%%; - ## pool all occurrences in a list - push (@cities, $_); - } - elsif (@$tuple[0] eq $pubsub_publisher) { - ## strip any trailing crap - $_ = @$tuple[1]; - s% *[,;:/]$%%; - ## pool all occurrences in a list - push (@publishers, $_); - } - elsif (@$tuple[0] eq $pubsub_date) { - ## the dates are free-form, so we want to extract - ## a four-digit year and leave the rest as - ## "other info" - $protoyear = @$tuple[1]; - print "Year (260\$c): $protoyear\r\n" if $marcprint; - - ## strip any separator chars at the end - $protoyear =~ s% *[\.;:/]*$%%; - - ## isolate a four-digit year. We discard anything - ## preceeding the year, but keep everything after - ## the year as other info. - $protoyear =~ s%\D*([0-9\-]{4})(.*)%$1///$2%; - - ## check what we've got. If there is no four-digit - ## year, make it up. If digits are replaced by '-', - ## replace those with 0s - - if (index($protoyear, "/") == 4) { - ## have year info - ## replace all '-' in the four-digit year - ## by '0' - substr($protoyear,0,4) =~ s!-!0!g; - } - else { - ## have no year info - print "no four-digit year found, use 0000\r\n" if $marcprint; - $protoyear = "0000///$protoyear"; - warn("no four-digit year found, use 0000") if $marcprint; - } - - if ($pycounter == 0 && length($protoyear)) { - print "PY - $protoyear\r\n"; - } - elsif ($pycounter == 1 && length($_)) { - print "Y2 - $protoyear\r\n"; - } - ## else: discard - } - ## else: discard - } - - ## now dump the collected CY and PB lists - if (@cities > 0) { - print "CY - ", &charconv(join(", ", @cities)), "\r\n"; - } - if (@publishers > 0) { - print "PB - ", &charconv(join(", ", @publishers)), "\r\n"; - } + ## the following information is available in MARC21: + ## $a place -> CY + ## $b publisher -> PB + ## $c date -> PY + ## the corresponding subfields for UNIMARC: + ## $a place -> CY + ## $c publisher -> PB + ## $d date -> PY + + ## all of them are repeatable. We pool all places into a + ## comma-separated list in CY. We also pool all publishers + ## into a comma-separated list in PB. We break the rule with + ## the date field because this wouldn't make much sense. In + ## this case, we use the first occurrence for PY, the second + ## for Y2, and ignore the rest + + my @pubsubfields = $pubinfofield->subfields(); + my @cities; + my @publishers; + my $pycounter = 0; + + my $pubsub_place; + my $pubsub_publisher; + my $pubsub_date; + + if ( $intype eq "unimarc" ) { + $pubsub_place = "a"; + $pubsub_publisher = "c"; + $pubsub_date = "d"; + } + else { ## assume marc21 + $pubsub_place = "a"; + $pubsub_publisher = "b"; + $pubsub_date = "c"; + } + + ## loop over all subfield list entries + for my $tuple (@pubsubfields) { + ## each tuple consists of the subfield code and the value + if ( @$tuple[0] eq $pubsub_place ) { + ## strip any trailing crap + $_ = @$tuple[1]; + s% *[,;:/]$%%; + ## pool all occurrences in a list + push( @cities, $_ ); + } + elsif ( @$tuple[0] eq $pubsub_publisher ) { + ## strip any trailing crap + $_ = @$tuple[1]; + s% *[,;:/]$%%; + ## pool all occurrences in a list + push( @publishers, $_ ); + } + elsif ( @$tuple[0] eq $pubsub_date ) { + ## the dates are free-form, so we want to extract + ## a four-digit year and leave the rest as + ## "other info" + $protoyear = @$tuple[1]; + print "Year (260\$c): $protoyear\r\n" if $marcprint; + + ## strip any separator chars at the end + $protoyear =~ s% *[\.;:/]*$%%; + + ## isolate a four-digit year. We discard anything + ## preceeding the year, but keep everything after + ## the year as other info. + $protoyear =~ s%\D*([0-9\-]{4})(.*)%$1///$2%; + + ## check what we've got. If there is no four-digit + ## year, make it up. If digits are replaced by '-', + ## replace those with 0s + + if ( index( $protoyear, "/" ) == 4 ) { + ## have year info + ## replace all '-' in the four-digit year + ## by '0' + substr( $protoyear, 0, 4 ) =~ s!-!0!g; + } + else { + ## have no year info + print "no four-digit year found, use 0000\r\n" if $marcprint; + $protoyear = "0000///$protoyear"; + warn("no four-digit year found, use 0000") if $marcprint; + } + + if ( $pycounter == 0 && length($protoyear) ) { + print "PY - $protoyear\r\n"; + } + elsif ( $pycounter == 1 && length($_) ) { + print "Y2 - $protoyear\r\n"; + } + ## else: discard + } + ## else: discard + } + + ## now dump the collected CY and PB lists + if ( @cities > 0 ) { + print "CY - ", &charconv( join( ", ", @cities ) ), "\r\n"; + } + if ( @publishers > 0 ) { + print "PB - ", &charconv( join( ", ", @publishers ) ), "\r\n"; + } } } @@ -809,44 +841,53 @@ sub print_pubinfo { ## Arguments: list of fields (6XX) ##******************************************************************** sub get_keywords { - my($fieldname, @keywords) = @_; + my ( $fieldname, @keywords ) = @_; my @kw; ## a list of all possible subfields - 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'); + 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' + ); ## loop over all 6XX fields foreach my $kwfield (@keywords) { - if ($kwfield != undef) { - ## authornames get special treatment - if ($fieldname eq "600") { - my $val = normalize_author($kwfield->subfield('a'), $kwfield->subfield('b'), $kwfield->subfield('c'), $kwfield->indicator('1')); - push @kw, $val; - print "Field $kwfield subfield a:", $kwfield->subfield('a'), "\r\nField $kwfield subfield b:", $kwfield->subfield('b'), "\r\nField $kwfield subfield c:", $kwfield->subfield('c'), "\r\n" if $marcprint; - } - else { - ## retrieve all available subfields - my @kwsubfields = $kwfield->subfields(); - - ## loop over all available subfield tuples - foreach my $kwtuple (@kwsubfields) { - ## loop over all subfields to check - foreach my $subfield (@subfields) { - ## [0] contains subfield code - if (@$kwtuple[0] eq $subfield) { - ## [1] contains value, remove trailing separators - @$kwtuple[1] =~ s% *[,;.:/]*$%%; - if (length(@$kwtuple[1]) > 0) { - push @kw, @$kwtuple[1]; - print "Field $fieldname subfield $subfield:", @$kwtuple[1], "\r\n" if $marcprint; - } - ## we can leave the subfields loop here - last; - } - } - } - } - } + if ( $kwfield != undef ) { + ## authornames get special treatment + if ( $fieldname eq "600" ) { + my $val = normalize_author( + $kwfield->subfield('a'), $kwfield->subfield('b'), + $kwfield->subfield('c'), $kwfield->indicator('1') + ); + push @kw, $val; + print "Field $kwfield subfield a:", $kwfield->subfield('a'), + "\r\nField $kwfield subfield b:", $kwfield->subfield('b'), + "\r\nField $kwfield subfield c:", $kwfield->subfield('c'), "\r\n" + if $marcprint; + } + else { + ## retrieve all available subfields + my @kwsubfields = $kwfield->subfields(); + + ## loop over all available subfield tuples + foreach my $kwtuple (@kwsubfields) { + ## loop over all subfields to check + foreach my $subfield (@subfields) { + ## [0] contains subfield code + if ( @$kwtuple[0] eq $subfield ) { + ## [1] contains value, remove trailing separators + @$kwtuple[1] =~ s% *[,;.:/]*$%%; + if ( length( @$kwtuple[1] ) > 0 ) { + push @kw, @$kwtuple[1]; + print "Field $fieldname subfield $subfield:", @$kwtuple[1], "\r\n" if $marcprint; + } + ## we can leave the subfields loop here + last; + } + } + } + } + } } return @kw; } @@ -858,110 +899,110 @@ sub get_keywords { ## list of fields (5XX) ##******************************************************************** sub pool_subx { - my($aref, $fieldname, @notefields) = @_; + my ( $aref, $fieldname, @notefields ) = @_; ## we use a list that contains the interesting subfields ## for each field # ToDo: this is apparently correct only for marc21 my @subfields; - if ($fieldname eq "500") { - @subfields = ('a'); + if ( $fieldname eq "500" ) { + @subfields = ('a'); + } + elsif ( $fieldname eq "501" ) { + @subfields = ('a'); } - elsif ($fieldname eq "501") { - @subfields = ('a'); + elsif ( $fieldname eq "502" ) { + @subfields = ('a'); } - elsif ($fieldname eq "502") { - @subfields = ('a'); - } - elsif ($fieldname eq "504") { - @subfields = ('a', 'b'); + elsif ( $fieldname eq "504" ) { + @subfields = ( 'a', 'b' ); } - elsif ($fieldname eq "505") { - @subfields = ('a', 'g', 'r', 't', 'u'); + elsif ( $fieldname eq "505" ) { + @subfields = ( 'a', 'g', 'r', 't', 'u' ); } - elsif ($fieldname eq "506") { - @subfields = ('a', 'b', 'c', 'd', 'e'); + elsif ( $fieldname eq "506" ) { + @subfields = ( 'a', 'b', 'c', 'd', 'e' ); } - elsif ($fieldname eq "507") { - @subfields = ('a', 'b'); + elsif ( $fieldname eq "507" ) { + @subfields = ( 'a', 'b' ); } - elsif ($fieldname eq "508") { - @subfields = ('a'); + elsif ( $fieldname eq "508" ) { + @subfields = ('a'); } - elsif ($fieldname eq "510") { - @subfields = ('a', 'b', 'c', 'x', '3'); + elsif ( $fieldname eq "510" ) { + @subfields = ( 'a', 'b', 'c', 'x', '3' ); } - elsif ($fieldname eq "511") { - @subfields = ('a'); + elsif ( $fieldname eq "511" ) { + @subfields = ('a'); } - elsif ($fieldname eq "513") { - @subfields = ('a', 'b'); + elsif ( $fieldname eq "513" ) { + @subfields = ( 'a', 'b' ); } - elsif ($fieldname eq "514") { - @subfields = ('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'm', 'u', 'z'); + elsif ( $fieldname eq "514" ) { + @subfields = ( 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'm', 'u', 'z' ); } - elsif ($fieldname eq "515") { - @subfields = ('a'); + elsif ( $fieldname eq "515" ) { + @subfields = ('a'); } - elsif ($fieldname eq "516") { - @subfields = ('a'); + elsif ( $fieldname eq "516" ) { + @subfields = ('a'); } - elsif ($fieldname eq "518") { - @subfields = ('a', '3'); + elsif ( $fieldname eq "518" ) { + @subfields = ( 'a', '3' ); } - elsif ($fieldname eq "521") { - @subfields = ('a', 'b', '3'); + elsif ( $fieldname eq "521" ) { + @subfields = ( 'a', 'b', '3' ); } - elsif ($fieldname eq "522") { - @subfields = ('a'); + elsif ( $fieldname eq "522" ) { + @subfields = ('a'); } - elsif ($fieldname eq "524") { - @subfields = ('a', '2', '3'); + elsif ( $fieldname eq "524" ) { + @subfields = ( 'a', '2', '3' ); } - elsif ($fieldname eq "525") { - @subfields = ('a'); + elsif ( $fieldname eq "525" ) { + @subfields = ('a'); } - elsif ($fieldname eq "526") { - @subfields = ('a', 'b', 'c', 'd', 'i', 'x', 'z', '5'); + elsif ( $fieldname eq "526" ) { + @subfields = ( 'a', 'b', 'c', 'd', 'i', 'x', 'z', '5' ); } - elsif ($fieldname eq "530") { - @subfields = ('a', 'b', 'c', 'd', 'u', '3'); + elsif ( $fieldname eq "530" ) { + @subfields = ( 'a', 'b', 'c', 'd', 'u', '3' ); } - elsif ($fieldname eq "533") { - @subfields = ('a', 'b', 'c', 'd', 'e', 'f', 'm', 'n', '3'); + elsif ( $fieldname eq "533" ) { + @subfields = ( 'a', 'b', 'c', 'd', 'e', 'f', 'm', 'n', '3' ); } - elsif ($fieldname eq "534") { - @subfields = ('a', 'b', 'c', 'e', 'f', 'k', 'l', 'm', 'n', 'p', 't', 'x', 'z'); + elsif ( $fieldname eq "534" ) { + @subfields = ( 'a', 'b', 'c', 'e', 'f', 'k', 'l', 'm', 'n', 'p', 't', 'x', 'z' ); } - elsif ($fieldname eq "535") { - @subfields = ('a', 'b', 'c', 'd', 'g', '3'); + elsif ( $fieldname eq "535" ) { + @subfields = ( 'a', 'b', 'c', 'd', 'g', '3' ); } ## loop over all notefields foreach my $notefield (@notefields) { - if (defined $notefield) { - ## retrieve all available subfield tuples - my @notesubfields = $notefield->subfields(); - - ## loop over all subfield tuples - foreach my $notetuple (@notesubfields) { - ## loop over all subfields to check - foreach my $subfield (@subfields) { - ## [0] contains subfield code - if (@$notetuple[0] eq $subfield) { - ## [1] contains value, remove trailing separators - print "field $fieldname subfield $subfield: ", @$notetuple[1], "\r\n" if $marcprint; - @$notetuple[1] =~ s% *[,;.:/]*$%%; - if (length(@$notetuple[1]) > 0) { - ## add to list - push @{$aref}, @$notetuple[1]; - } - last; - } - } - } - } + if ( defined $notefield ) { + ## retrieve all available subfield tuples + my @notesubfields = $notefield->subfields(); + + ## loop over all subfield tuples + foreach my $notetuple (@notesubfields) { + ## loop over all subfields to check + foreach my $subfield (@subfields) { + ## [0] contains subfield code + if ( @$notetuple[0] eq $subfield ) { + ## [1] contains value, remove trailing separators + print "field $fieldname subfield $subfield: ", @$notetuple[1], "\r\n" if $marcprint; + @$notetuple[1] =~ s% *[,;.:/]*$%%; + if ( length( @$notetuple[1] ) > 0 ) { + ## add to list + push @{$aref}, @$notetuple[1]; + } + last; + } + } + } + } } } @@ -970,11 +1011,12 @@ sub pool_subx { ## Arguments: list of fields (520) ##******************************************************************** sub print_abstract { + # ToDo: take care of repeatable subfields - my(@abfields) = @_; + my (@abfields) = @_; ## we check the following subfields - my @subfields = ('a', 'b'); + my @subfields = ( 'a', 'b' ); ## we generate a list for all useful strings my @abstrings; @@ -998,14 +1040,12 @@ sub print_abstract { my $allabs = join "; ", @abstrings; - if (length($allabs) > 0) { - print "N2 - ", &charconv($allabs), "\r\n"; + if ( length($allabs) > 0 ) { + print "N2 - ", &charconv($allabs), "\r\n"; } } - - ##******************************************************************** ## charconv(): converts to a different charset based on a global var ## Arguments: string @@ -1013,16 +1053,16 @@ sub print_abstract { ##******************************************************************** sub charconv { if ($utf) { - ## return unaltered if already utf-8 - return @_; + ## return unaltered if already utf-8 + return @_; } - elsif (my $uniout eq "t") { - ## convert to utf-8 - return marc8_to_utf8("@_"); + elsif ( my $uniout eq "t" ) { + ## convert to utf-8 + return marc8_to_utf8("@_"); } else { - ## return unaltered if no utf-8 requested - return @_; + ## return unaltered if no utf-8 requested + return @_; } } 1; -- 1.7.2.5