@@ -, +, @@ C4::Ris.pm except for AU which may change in whitespace content. --- C4/Ris.pm | 122 +++++++++++++++++++++++++++++++++++------------------------- t/Ris.t | 38 ++++++++++++++++-- 2 files changed, 104 insertions(+), 56 deletions(-) --- a/C4/Ris.pm +++ a/C4/Ris.pm @@ -59,8 +59,8 @@ package C4::Ris; # # -#use strict; -#use warnings; +use strict; +use warnings; use vars qw($VERSION @ISA @EXPORT); @@ -75,6 +75,11 @@ $VERSION = 3.07.00.049; &marc2ris ); +# Debug flag, set to 1 to obtain additional debugging +my $marcprint = 0; + +# Switch to record whether UTF enabled +my $UTF = 0; =head1 marc2bibtex - Convert from UNIMARC to RIS @@ -92,7 +97,6 @@ sub marc2ris { my $marcflavour = C4::Context->preference("marcflavour"); my $intype = lc($marcflavour); - my $marcprint = 0; # Debug flag; # Let's redirect stdout open my $oldout, ">&STDOUT"; @@ -108,7 +112,7 @@ sub marc2ris { if ($intype eq "marc21") { if ($leader =~ /^.{9}a/) { print "---\r\nUTF-8 data\r\n" if $marcprint; - $utf = 1; + $UTF = 1; } else { print "---\r\nMARC-8 data\r\n" if $marcprint; @@ -118,7 +122,7 @@ sub marc2ris { ## we assume it's *not* UTF-8 ## start RIS dataset - &print_typetag($leader); + &print_typetag($intype, $leader); ## retrieve all author fields and collect them in a list my @author_fields; @@ -136,7 +140,7 @@ sub marc2ris { ## loop over all author fields foreach my $field (@author_fields) { if (length($field)) { - my $author = &get_author($field); + my $author = &get_author($intype, $field); print "AU - ",&charconv($author),"\r\n"; } } @@ -169,18 +173,18 @@ sub marc2ris { ## get info from the title field if ($intype eq "unimarc") { - &print_title($record->field('200')); + &print_title($intype, $record->field('200')); } else { ## marc21, ukmarc - &print_title($record->field('245')); + &print_title($intype, $record->field('245')); } ## series title if ($intype eq "unimarc") { - &print_stitle($record->field('225')); + &print_stitle($intype, $record->field('225')); } else { ## marc21, ukmarc - &print_stitle($record->field('490')); + &print_stitle($intype, $record->field('490')); } ## ISBN/ISSN @@ -206,14 +210,14 @@ sub marc2ris { ## publication info if ($intype eq "unimarc") { - &print_pubinfo($record->field('210')); + &print_pubinfo($intype, $record->field('210')); } else { ## marc21, ukmarc if ($record->field('264')) { - &print_pubinfo($record->field('264')); + &print_pubinfo($intype, $record->field('264')); } else { - &print_pubinfo($record->field('260')); + &print_pubinfo($intype, $record->field('260')); } } @@ -302,11 +306,13 @@ sub marc2ris { ##******************************************************************** ## print_typetag(): prints the first line of a RIS dataset including ## the preceeding newline -## Argument: the leader of a MARC dataset +## Arguments: MARC flavour type, the leader of a MARC dataset ## Returns: the value at leader position 06 ##******************************************************************** sub print_typetag { - my ($leader)= @_; + my ($intype, $leader)= @_; + return undef unless $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. @@ -389,7 +395,7 @@ sub print_typetag { sub normalize_author { my($rawauthora, $rawauthorb, $rawauthorc, $nametype) = @_; - if ($nametype == 0) { + if (! defined($nametype) || $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; @@ -407,6 +413,7 @@ sub normalize_author { ## start munging subfield b (something like the suffix) ## remove trailing separators after spaces + $rawauthorb = "" unless defined($rawauthorb); $rawauthorb =~ s% *[,;:/]*$%%; ## we currently ignore subfield c until someone complains @@ -424,11 +431,11 @@ sub normalize_author { ##******************************************************************** ## get_author(): gets authorname info from MARC fields 100, 700 -## Argument: field (100 or 700) +## Argument: MARC flavour type, field (100 or 700) ## Returns: an author string in the format found in the record ##******************************************************************** sub get_author { - my ($authorfield) = @_; + my ($intype, $authorfield) = @_; my ($indicator); ## the sequence of the name parts is encoded either in indicator @@ -440,18 +447,21 @@ sub get_author { $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")); - } - else { - normalize_author($authorfield->subfield('a'), $authorfield->subfield('b'), $authorfield->subfield('c'), $authorfield->indicator("$indicator")); - } + # Must call subfield in scalar context before passing into normalize_author() + my $i = $authorfield->indicator("$indicator"); + my $a = $authorfield->subfield('a'); + my $b = $authorfield->subfield('b'); + my $c = $authorfield->subfield('c'); + my $h = $authorfield->subfield('h'); + + print ":Author(Ind$indicator): $i\r\n" if $marcprint; + print ":Author(\$a): ", $a, "\r\n" if $marcprint; + print ":Author(\$b): ", $b, "\r\n" if $marcprint; + print ":Author(\$c): ", $c, "\r\n" if $marcprint; + print ":Author(\$h): ", $h, "\r\n" if $marcprint; + + my $authorname = $intype eq "ukmarc" ? $a . "," . $h : $a; + normalize_author($authorname, $b, $c, $i); } ##******************************************************************** @@ -474,15 +484,16 @@ sub get_editor { } ##******************************************************************** -## print_title(): gets info from MARC field 245 -## Arguments: field (245) +## print_title(): gets info from MARC field 245 or 200 +## Arguments: MARC flavour type, field (245 or 200) ## Returns: ##******************************************************************** sub print_title { - my ($titlefield) = @_; + my ($intype, $titlefield) = @_; if (!$titlefield) { print "empty title field (245)\r\n" if $marcprint; warn("empty title field (245)") if $marcprint; + return undef; } else { print "Title(\$a): ",$titlefield->subfield('a'),"\r\n" if $marcprint; @@ -496,9 +507,9 @@ sub print_title { ## the separator and make sure there's a space between title and ## subtitle - my $clean_title = $titlefield->subfield('a'); + my $clean_title = $titlefield->subfield('a') || ""; - my $clean_subtitle = $titlefield->subfield('b'); + my $clean_subtitle = $titlefield->subfield('b') || ""; $clean_title =~ s% *[/:;.]$%%; $clean_subtitle =~ s%^ *(.*) *[/:;.]$%$1%; @@ -522,18 +533,19 @@ sub print_title { ##******************************************************************** ## print_stitle(): prints info from series title field -## Arguments: field +## Arguments: MARC flavour type, field ## Returns: ##******************************************************************** sub print_stitle { - my ($titlefield) = @_; + my ($intype, $titlefield) = @_; if (!$titlefield) { print "empty series title field\r\n" if $marcprint; + return undef; } else { print "Series title(\$a): ",$titlefield->subfield('a'),"\r\n" if $marcprint; - my $clean_title = $titlefield->subfield('a'); + my $clean_title = $titlefield->subfield('a') || ""; $clean_title =~ s% *[/:;.]$%%; @@ -640,11 +652,11 @@ sub print_dewey { } ##******************************************************************** -## print_pubinfo(): gets info from MARC field 260 -## Arguments: field (260) +## print_pubinfo(): gets info from MARC field 210, 260 or 264 +## Arguments: MARC flavour type, field (210 or 260 or 264) ##******************************************************************** sub print_pubinfo { - my($pubinfofield) = @_; + my($intype, $pubinfofield) = @_; if (!$pubinfofield) { print "no publication information found (260/264)\r\n" if $marcprint; @@ -708,7 +720,7 @@ sub print_pubinfo { ## the dates are free-form, so we want to extract ## a four-digit year and leave the rest as ## "other info" - $protoyear = @$tuple[1]; + my $protoyear = @$tuple[1]; print "Year (260\$c): $protoyear\r\n" if $marcprint; ## strip any separator chars at the end @@ -769,16 +781,21 @@ sub get_keywords { ## loop over all 6XX fields foreach my $kwfield (@keywords) { - if ($kwfield != undef) { + if ( defined($kwfield) ) { ## authornames get special treatment if ($fieldname eq "600") { - my $val = normalize_author($kwfield->subfield('a'), $kwfield->subfield('b'), $kwfield->subfield('c'), $kwfield->indicator('1')); + # Must call subfield in scalar context before passing into normalize_author() + my $a = $kwfield->subfield('a'); + my $b = $kwfield->subfield('b'); + my $c = $kwfield->subfield('c'); + + my $val = normalize_author($a, $b, $c, $kwfield->indicator('1')); ${$href}{$val} += 1; - 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; + print "Field $kwfield subfield a:", $a, "\r\nField $kwfield subfield b:", $b, "\r\nField $kwfield subfield c:", $c, "\r\n" if $marcprint; } else { ## retrieve all available subfields - @kwsubfields = $kwfield->subfields(); + my @kwsubfields = $kwfield->subfields(); ## loop over all available subfield tuples foreach my $kwtuple (@kwsubfields) { @@ -892,9 +909,9 @@ sub pool_subx { ## loop over all notefields foreach my $notefield (@notefields) { - if ($notefield != undef) { + if ( defined($notefield) ) { ## retrieve all available subfield tuples - @notesubfields = $notefield->subfields(); + my @notesubfields = $notefield->subfields(); ## loop over all subfield tuples foreach my $notetuple (@notesubfields) { @@ -935,7 +952,7 @@ sub print_abstract { foreach my $abfield (@abfields) { foreach my $field (@subfields) { if ( length( $abfield->subfield($field) ) > 0 ) { - my $ab = $abfield->subfield($field); + my $ab = $abfield->subfield($field) || ""; print "field 520 subfield $field: $ab\r\n" if $marcprint; @@ -959,12 +976,15 @@ sub print_abstract { ##******************************************************************** -## charconv(): converts to a different charset based on a global var +## charconv(): converts to a different charset based on a global var, $UTF ## Arguments: string ## Returns: string ##******************************************************************** sub charconv { - if ($utf) { + # FIXME $uniout is not referred to anywhere else in koha source. + # TODO Initialise it for now, check RIS output using a non-UTF database + my $uniout = ""; + if ($UTF) { ## return unaltered if already utf-8 return @_; } --- a/t/Ris.t +++ a/t/Ris.t @@ -1,22 +1,50 @@ #!/usr/bin/perl # -# This Koha test module is a stub! -# Add more tests here!!! +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# Koha 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 +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . -use strict; -use warnings; +use Modern::Perl; -use Test::More tests => 6; +use Test::More tests => 11; BEGIN { use_ok('C4::Ris'); } +# print*() functions is(C4::Ris::print_typetag(),undef,'test printing typetag'); is(C4::Ris::print_title(),undef, 'test printing title when print_title is nil'); is(C4::Ris::print_stitle(),undef, 'test printing info from series title field when its nil'); +# author functions +my $authora = "Writer, A. "; +my $authorb = "Second, B. "; +is(C4::Ris::normalize_author($authora), "Writer, A. ", 'normalize author using undefined type (unchanged) with subfield a'); + +is(C4::Ris::normalize_author($authora, undef, undef, 0), "Writer, A. ", 'normalize author using type 0 (unchanged) with subfield a'); + +is(C4::Ris::normalize_author($authora, undef, undef, 3), "Writer, A. ", 'normalize author using type 3 (unchanged) with subfield a'); + +is(C4::Ris::normalize_author($authora, undef, undef, 1), "Writer,A.", 'normalize author using type 1 (cleaned) with subfield a'); + +is(C4::Ris::normalize_author($authora, $authorb, undef, 1), "Writer,A.,Second, B.", 'normalize author using type 1 (cleaned) with subfield a and b'); + +# charconv() function ok((C4::Ris::charconv('hello world'))[0] eq 'hello world', 'testing that it returns what you entered'); ok(C4::Ris::charconv() == 0, 'testing when charconv is nil'); + +1; --