Attachment 34442 Details for Bug 2505 – Update to C4::Ris.pm

[patch] Update to C4::Ris.pm

0001-Bug-2505-Apply-strict-and-warning-declarations-Patch.patch (text/plain), 15.06 KB, created by Andrew Maguire on 2014-12-15 21:52:46 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Andrew Maguire

Created: 2014-12-15 21:52:46 UTC

Size: 15.06 KB

patch

obsolete

>From effe572090077e2b413cec44f8738f24fe7dc59a Mon Sep 17 00:00:00 2001
>From: Andrew Maguire <ajm1170@gmail.com>
>Date: Mon, 15 Dec 2014 21:35:43 +0000
>Subject: [PATCH] Bug 2505: Apply strict and warning declarations - Patch to
> C4::Ris.pm
>
>C4::Ris.pm module now conforms to strict and warning declaration
>with no change to functionally.
>There may be a change to the AU output with some whitespace being
>removed. This is due to the author output now being normalised
>correctly.
>
>Patch includes some additional Unit tests.
>
>Note: the charconv() function is a no-op, please check what
>should happen if database is in MARC8 (non-UTF) format.
>
>Test Plan:
>1) Select a publication
>2) Click Save Record -> RIS and save the file as bib-1.ris
>3) Check Apache opac-error.log contains no warnings
>4) Apply Patch
>5) Click Save Record -> RIS and save the file as bib-2.ris
>6) Check Apache opac-error.log contains no warnings
>7) Files bib-1.ris and bib-2.ris should be identical,
>   except for AU which may change in whitespace content.
>8) Run t/Ris.t and 11 tests should pass.
>---
> C4/Ris.pm |  122 +++++++++++++++++++++++++++++++++++-------------------------
> t/Ris.t   |   38 ++++++++++++++++--
> 2 files changed, 104 insertions(+), 56 deletions(-)
>
>diff --git a/C4/Ris.pm b/C4/Ris.pm
>index d601c96..a12508b 100644
>--- a/C4/Ris.pm
>+++ b/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 "<marc>---\r\n<marc>UTF-8 data\r\n" if $marcprint;
>-		$utf = 1;
>+		$UTF = 1;
> 	    }
> 	    else {
> 		print "<marc>---\r\n<marc>MARC-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 "<marc>:Author(Ind$indicator): ", $authorfield->indicator("$indicator"),"\r\n" if $marcprint;
>-    print "<marc>:Author(\$a): ", $authorfield->subfield('a'),"\r\n" if $marcprint;
>-    print "<marc>:Author(\$b): ", $authorfield->subfield('b'),"\r\n" if $marcprint;
>-    print "<marc>:Author(\$c): ", $authorfield->subfield('c'),"\r\n" if $marcprint;
>-    print "<marc>: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 "<marc>:Author(Ind$indicator): $i\r\n" if $marcprint;
>+    print "<marc>:Author(\$a): ", $a, "\r\n" if $marcprint;
>+    print "<marc>:Author(\$b): ", $b, "\r\n" if $marcprint;
>+    print "<marc>:Author(\$c): ", $c, "\r\n" if $marcprint;
>+    print "<marc>: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 "<marc>empty title field (245)\r\n" if $marcprint;
> 	warn("empty title field (245)") if $marcprint;
>+	return undef;
>     }
>     else {
> 	print "<marc>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 "<marc>empty series title field\r\n" if $marcprint;
>+	return undef;
>     }
>     else {
> 	print "<marc>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 "<marc>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 "<marc>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 "<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;
>+		print "<marc>Field $kwfield subfield a:", $a, "\r\n<marc>Field $kwfield subfield b:", $b, "\r\n<marc>Field $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 "<marc>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 @_;
>     }
>diff --git a/t/Ris.t b/t/Ris.t
>index b4126c5..44fb9c7 100755
>--- a/t/Ris.t
>+++ b/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 <http://www.gnu.org/licenses>.
> 
>-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;
>-- 
>1.7.6.1
>

Actions: View | Diff | Splinter Review

Attachments on bug 2505: 686 | 687 | 688 | 689 | 690 | 691 | 692 | 693 | 694 | 695 | 696 | 697 | 698 | 699 | 700 | 701 | 702 | 703 | 704 | 705 | 706 | 707 | 708 | 709 | 2223 | 3884 | 4574 | 8209 | 8317 | 8322 | 8373 | 9034 | 9035 | 9036 | 34442