From 386b4b15a15d4ef1798087ac6ed303db9f55755b Mon Sep 17 00:00:00 2001
From: Galen Charlton <galen.charlton@liblime.com>
Date: Mon, 7 Jul 2008 17:17:05 -0500
Subject: [PATCH] bug 2315: no crash if subfield code is a metacharacter

When generating the display form of a heading that
happens to (invalidly) have a regular expression
metacharacter as a subfield label, do not crash.

An example of such a heading field is:

  <datafield tag="650" ind1=" " ind2="0">
    <subfield code="a">Dalziel, Andrew (Fictitious character</subfield>
    <subfield code=")">xFiction.</subfield>
  </datafield>

The error message associated with the crash is:

  Unmatched ) in regex; marked by <-- HERE in m/) <-- HERE / at
  /home/koha-pro/kohaclone/C4/Heading/MARC21.pm line 220.

Signed-off-by: Joshua Ferraro <jmf@liblime.com>
---
 C4/Heading/MARC21.pm             |  3 ++-
 t/lib/KohaTest/Heading.pm        | 27 +++++++++++++++++++++
 t/lib/KohaTest/Heading/MARC21.pm | 41 ++++++++++++++++++++++++++++++++
 3 files changed, 70 insertions(+), 1 deletion(-)
 create mode 100644 t/lib/KohaTest/Heading.pm
 create mode 100644 t/lib/KohaTest/Heading/MARC21.pm

diff --git a/C4/Heading/MARC21.pm b/C4/Heading/MARC21.pm
index 4b328282af..f6e712af9e 100644
--- a/C4/Heading/MARC21.pm
+++ b/C4/Heading/MARC21.pm
@@ -216,8 +216,9 @@ sub _get_display_heading {
     my $first = 1;
     for (my $i = 0; $i <= $#subfields; $i++) {
         my $code = $subfields[$i]->[0];
+        my $code_re = quotemeta $code;
         my $value = $subfields[$i]->[1];
-        next unless $subfields =~ qr/$code/;
+        next unless $subfields =~ qr/$code_re/;
         if ($first) {
             $first = 0;
             $heading = $value;
diff --git a/t/lib/KohaTest/Heading.pm b/t/lib/KohaTest/Heading.pm
new file mode 100644
index 0000000000..4f781a2ff7
--- /dev/null
+++ b/t/lib/KohaTest/Heading.pm
@@ -0,0 +1,27 @@
+package KohaTest::Heading;
+use base qw( KohaTest );
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use C4::Heading;
+sub testing_class { 'C4::Heading' };
+
+
+sub methods : Test( 1 ) {
+    my $self = shift;
+    my @methods = qw( 
+                    new_from_bib_field
+                    display_form
+                    authorities
+                    preferred_authorities
+                    _query_limiters
+                    _marc_format_handler
+                );
+    
+    can_ok( $self->testing_class, @methods );    
+}
+
+1;
diff --git a/t/lib/KohaTest/Heading/MARC21.pm b/t/lib/KohaTest/Heading/MARC21.pm
new file mode 100644
index 0000000000..41cd4d32e7
--- /dev/null
+++ b/t/lib/KohaTest/Heading/MARC21.pm
@@ -0,0 +1,41 @@
+package KohaTest::Heading::MARC21;
+use base qw( KohaTest::Heading );
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use C4::Heading;
+use C4::Heading::MARC21;
+
+use MARC::Field;
+
+sub testing_class { 'C4::Heading::MARC21' };
+
+sub methods : Test( 1 ) {
+    my $self = shift;
+    my @methods = qw( 
+                    new
+                    valid_bib_heading_tag
+                    parse_heading
+                    _get_subject_thesaurus
+                    _get_search_heading
+                    _get_display_heading
+                );
+    
+    can_ok( $self->testing_class, @methods );    
+}
+
+sub bug2315 : Test( 1 ) {
+
+    my $subject_heading = MARC::Field->new(650, ' ', '0', 
+                                                a   => "Dalziel, Andrew (Fictitious character",
+                                                ')' => "Fiction."
+                                           );
+    my $display_form = C4::Heading::MARC21::_get_display_heading($subject_heading, 'a');
+    is($display_form, "Dalziel, Andrew (Fictitious character", "bug 2315: no crash if heading subfield has metacharacter");
+
+}
+
+1;
-- 
2.39.5