From 0b96d3f34514c468757a1391081b7f5b2037c3a4 Mon Sep 17 00:00:00 2001
From: David Cook <dcook@prosentient.com.au>
Date: Thu, 17 Dec 2020 04:05:39 +0000
Subject: [PATCH] Bug 26199: Include LDR for match check/match point

This patch adds the ability to specify the LDR instead of a numeric tag
when defining match checks in record matching rules. This is particularly
useful for checking LDR6 "Type of record" when importing records.

Test plan:
0. prove t/Matcher.t

1. Go to http://localhost:8081/cgi-bin/koha/catalogue/detail.pl?biblionumber=1
2. Click "Save" and choose "MARCXML"
3. Copy bib-1.marcxml to bib-1-mod.marcxml
4. Change "01344cam a22003014i 4500" to "01344cmm a22003014i 4500"
5. Go to http://localhost:8081/cgi-bin/koha/admin/matching-rules.pl?op=edit_matching_rule&matcher_id=3
6. Click "Add match check"
7. Fill out the match checks:
Source:
Tag: LDR
Offset: 6
Length: 1
Target:
Tag: LDR
Offset: 6
Length: 1

8. Go to http://localhost:8081/cgi-bin/koha/tools/stage-marc-import.pl
9. Choose "bib-1-mod.marcxml" and click "Upload file"
10. Choose "KohaBiblio (999$c)" for "Record matching rule"
11. Click "Stage for import"
12. Click "Manage staged records" on resulting page
13. Note the "Match type" says "No match"

14. Go to http://localhost:8081/cgi-bin/koha/tools/stage-marc-import.pl
15. Choose "bib-1.marcxml" and click "Upload file"
16. Choose "KohaBiblio (999$c)" for "Record matching rule"
17. Click "Stage for import"
18. Click "Manage staged records" on resulting page
19. Note the Match type says "Match found"
---
 C4/Matcher.pm | 17 +++++++++++++++--
 t/Matcher.t   | 39 ++++++++++++++++++++++++++++++++++++++-
 2 files changed, 53 insertions(+), 3 deletions(-)

diff --git a/C4/Matcher.pm b/C4/Matcher.pm
index 6644ec6a53..923b4accf1 100644
--- a/C4/Matcher.pm
+++ b/C4/Matcher.pm
@@ -812,13 +812,26 @@ sub _get_match_keys {
     for (my $i = 0; $i <= $#{ $matchpoint->{'components'} }; $i++) {
         my $component = $matchpoint->{'components'}->[$i];
         my $j = -1;
-        FIELD: foreach my $field ($source_record->field($component->{'tag'})) {
+
+        my @fields = ();
+        my $tag = $component->{'tag'};
+        if ($tag && $tag eq 'LDR'){
+            $fields[0] = $source_record->leader();
+        }
+        else {
+            @fields = $source_record->field($tag);
+        }
+
+        FIELD: foreach my $field (@fields) {
             $j++;
             last FIELD if $j > 0 and $check_only_first_repeat;
             last FIELD if $i > 0 and $j > $#keys;
 
             my $string;
-            if ( $field->is_control_field() ) {
+            if ( ! ref $field ){
+                $string = "$field";
+            }
+            elsif ( $field->is_control_field() ) {
                 $string = $field->data();
             } else {
                 $string = $field->as_string(
diff --git a/t/Matcher.t b/t/Matcher.t
index e7dbeee6a3..42dc809044 100755
--- a/t/Matcher.t
+++ b/t/Matcher.t
@@ -27,7 +27,7 @@ use Module::Load::Conditional qw/check_install/;
 
 BEGIN {
     if ( check_install( module => 'Test::DBIx::Class' ) ) {
-        plan tests => 12;
+        plan tests => 13;
     } else {
         plan skip_all => "Need Test::DBIx::Class"
     }
@@ -264,6 +264,23 @@ subtest '_get_match_keys() tests' => sub {
 
 };
 
+subtest '_get_match_keys() leader tests' => sub {
+    plan tests => 2;
+    my $record = MARC::Record->new();
+    my $matchpoint = get_leader_matchpoint({
+        length => 1,
+        offset => 6,
+    });
+
+    my @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
+    is( $keys[0], ' ', 'Match key correctly calculated as " " from LDR6 when no leader available');
+
+    $record->leader('01344cam a22003014a 4500');
+
+    @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
+    is( $keys[0], 'a', 'Match key correctly calculated as "a" from LDR6');
+};
+
 sub get_title_matchpoint {
 
     my $params = shift;
@@ -358,3 +375,23 @@ sub get_isbn_matchpoint {
 
     return $matchpoint;
 }
+
+sub get_leader_matchpoint {
+    my $params = shift;
+    my $length = $params->{length} // 0;
+    my $norms  = $params->{norms}  // [];
+    my $offset = $params->{offset} // 0;
+
+    my $matchpoint = {
+        components =>  [
+            {
+                length    => $length,
+                norms     => $norms,
+                offset    => $offset,
+                tag => 'LDR'
+            },
+        ],
+    };
+
+    return $matchpoint;
+}
-- 
2.11.0