t/Matcher.t

   1 #!/usr/bin/perl
   2
   3 # This file is part of Koha.
   4 #
   5 # Koha is free software; you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  17
  18 use Modern::Perl;
  19
  20 use Test::More;
  21 use Test::MockModule;
  22 use Test::Warn;
  23
  24 use MARC::Record;
  25
  26 use Module::Load::Conditional qw/check_install/;
  27
  28 BEGIN {
  29     if ( check_install( module => 'Test::DBIx::Class' ) ) {
  30         plan tests => 12;
  31     } else {
  32         plan skip_all => "Need Test::DBIx::Class"
  33     }
  34 }
  35
  36 use Test::DBIx::Class;
  37
  38 my $db = Test::MockModule->new('Koha::Database');
  39 $db->mock( _new_schema => sub { return Schema(); } );
  40
  41 use_ok('C4::Matcher');
  42
  43 fixtures_ok [
  44     MarcMatcher => [
  45         [ 'matcher_id', 'code', 'description', 'record_type', 'threshold' ],
  46         [ 1,            'ISBN', 'ISBN',        'red',         1 ],
  47         [ 2,            'ISSN', 'ISSN',        'blue',        0 ]
  48     ],
  49 ], 'add fixtures';
  50
  51 my @matchers = C4::Matcher::GetMatcherList();
  52
  53 is( $matchers[0]->{'matcher_id'}, 1, 'First matcher_id value is 1' );
  54
  55 is( $matchers[1]->{'matcher_id'}, 2, 'Second matcher_id value is 2' );
  56
  57 my $matcher_id = C4::Matcher::GetMatcherId('ISBN');
  58
  59 is( $matcher_id, 1, 'testing getmatcherid' );
  60
  61 my $testmatcher;
  62
  63 ok( $testmatcher = C4::Matcher->new( 'red', 1 ), 'testing matcher new' );
  64
  65 ok( $testmatcher = C4::Matcher->new( 'blue', 0 ), 'testing matcher new' );
  66
  67 $testmatcher->threshold(1000);
  68
  69 is( $testmatcher->threshold(), 1000, 'testing threshhold accessor method' );
  70
  71 $testmatcher->_id(53);
  72
  73 is( $testmatcher->_id(), 53, 'testing _id accessor' );
  74
  75 $testmatcher->code('match on ISBN');
  76
  77 is( $testmatcher->code(), 'match on ISBN', 'testing code accessor' );
  78
  79 $testmatcher->description('match on ISSN');
  80
  81 is( $testmatcher->description(), 'match on ISSN', 'testing code accessor' );
  82
  83 subtest '_get_match_keys() tests' => sub {
  84
  85     plan tests => 17;
  86
  87     my $matchpoint = get_title_matchpoint({
  88         length => 0,
  89         norms  => [ 'legacy_default' ],
  90         offset => 0
  91     });
  92
  93     my $record = MARC::Record->new();
  94     $record->append_fields(
  95         MARC::Field->new('100', '1', ' ',
  96                             a => 'King, Stephen',
  97                             d => 'd1947-'),
  98         MARC::Field->new('245', ' ', ' ',
  99                             a => '  .; thE t[]:,aliS(m)/An\'"',
 100                             c => 'Stephen King, Peter Straub.' ),
 101         MARC::Field->new('700', ' ', ' ',
 102                             a => 'Straub, Peter',
 103                             d => '1943-')
 104     );
 105
 106     my @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 107
 108     is( $keys[0], 'THE TALISMAN STEPHEN KING PETER STRAUB',
 109         'Match key correctly calculated with no $norms');
 110
 111     $matchpoint = get_title_matchpoint({
 112         length => 9,
 113         norms  => [ 'legacy_default' ],
 114         offset => 0
 115     });
 116     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 117     is( $keys[0], 'THE',
 118         'Match key correctly calculated with length 9');
 119
 120     $matchpoint = get_title_matchpoint({
 121         length => 9,
 122         norms  => [ 'legacy_default' ],
 123         offset => 1
 124     });
 125     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 126     is( $keys[0], 'THE T',
 127         'Match key correctly calculated with length 9 and offset 1');
 128
 129     $matchpoint = get_title_matchpoint({
 130         length => 9,
 131         norms  => [ 'legacy_default' ],
 132         offset => 2
 133     });
 134     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 135     is( $keys[0], 'THE T',
 136         'Match key correctly calculated with length 9 and offset 2, should not remove space');
 137
 138     $matchpoint = get_authors_matchpoint({
 139         length => 0,
 140         norms  => [ 'legacy_default' ],
 141         offset => 0
 142     });
 143     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 144     is( $keys[0], 'STRAUB PETER KING STEPHEN',
 145         'Match key correctly calculated with multiple components');
 146
 147     $matchpoint = get_authors_matchpoint({
 148         length => 9,
 149         norms  => [ 'legacy_default' ],
 150         offset => 0
 151     });
 152     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 153     is( $keys[0], 'STRAUB P KING STE',
 154         'Match key correctly calculated with multiple components, length 9');
 155
 156     $matchpoint = get_authors_matchpoint({
 157         length => 10,
 158         norms  => [ 'legacy_default' ],
 159         offset => 0
 160     });
 161     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 162     is( $keys[0], 'STRAUB PE KING STEP',
 163         'Match key correctly calculated with multiple components, length 10');
 164
 165     $matchpoint = get_authors_matchpoint({
 166         length => 10,
 167         norms  => [ 'legacy_default' ],
 168         offset => 2
 169     });
 170     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 171     is( $keys[0], 'RAUB PETE NG STEPHE',
 172         'Match key correctly calculated with multiple components, length 10, offset 1');
 173
 174     $matchpoint = get_title_matchpoint({
 175         length => 0,
 176         norms  => [ 'none', 'none' ],
 177         offset => 0
 178     });
 179     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 180     is( $keys[0], '  .; thE t[]:,aliS(m)/An\'" Stephen King, Peter Straub.',
 181         'Match key intact if \'none\' specified, length 0 and offset 0' );
 182
 183     $matchpoint = get_authors_matchpoint({
 184         length => 0,
 185         norms  => [ 'upper_case' ],
 186         offset => 0
 187     });
 188     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 189     is( $keys[0], 'STRAUB, PETER KING, STEPHEN',
 190         'Match key correctly calculated with multiple components, \'upper_case\' norm');
 191
 192     $matchpoint = get_authors_matchpoint({
 193         length => 0,
 194         norms  => [ 'lower_case' ],
 195         offset => 0
 196     });
 197     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 198     is( $keys[0], 'straub, peter king, stephen',
 199         'Match key correctly calculated with multiple components, \'lower_case\' norm');
 200
 201     $matchpoint = get_authors_matchpoint({
 202         length => 0,
 203         norms  => [ 'remove_spaces' ],
 204         offset => 0
 205     });
 206     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 207     is( $keys[0], 'Straub,Peter King,Stephen',
 208         'Match key correctly calculated with multiple components, \'remove_spaces\' norm');
 209
 210     $matchpoint = get_authors_matchpoint({
 211         length => 0,
 212         norms  => [ 'remove_spaces', 'lower_case' ],
 213         offset => 0
 214     });
 215     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 216     is( $keys[0], 'straub,peter king,stephen',
 217         'Match key correctly calculated with multiple components, \'remove_spaces\' and \'lower_case\' norm');
 218
 219     my $norm = 'unknown_norm';
 220     $matchpoint = get_title_matchpoint({
 221         length => 0,
 222         norms  => [ $norm ],
 223         offset => 0
 224     });
 225     warning_is
 226             { @keys = C4::Matcher::_get_match_keys( $record, $matchpoint ) }
 227             qq{Invalid normalization routine required ($norm)},
 228             'Passing an invalid normalization routine name raises a warning';
 229
 230     is( $keys[0], '  .; thE t[]:,aliS(m)/An\'" Stephen King, Peter Straub.',
 231         'Match key intact if invalid normalization routine specified' );
 232
 233     $matchpoint = get_title_matchpoint({
 234         length => 0,
 235         norms  => [ $norm, 'upper_case' ],
 236         offset => 0
 237     });
 238     warning_is
 239             { @keys = C4::Matcher::_get_match_keys( $record, $matchpoint ) }
 240             qq{Invalid normalization routine required ($norm)},
 241             'Passing an invalid normalization routine name raises a warning';
 242
 243     is( $keys[0], '  .; THE T[]:,ALIS(M)/AN\'" STEPHEN KING, PETER STRAUB.',
 244         'Match key correctly normalized if invalid normalization routine specified' );
 245 };
 246
 247 sub get_title_matchpoint {
 248
 249     my $params = shift;
 250
 251     my $length = $params->{length} // 0;
 252     my $norms  = $params->{norms}  // [];
 253     my $offset = $params->{offset} // 0;
 254
 255     my $matchpoint = {
 256         components =>  [
 257             {
 258                 length    => $length,
 259                 norms     => $norms,
 260                 offset    => $offset,
 261                 subfields =>
 262                     {
 263                         a => 1,
 264                         c => 1
 265                     },
 266                 tag => '245'
 267             }
 268         ],
 269         index => "title",
 270         score => 1000
 271     };
 272
 273     return $matchpoint;
 274 }
 275
 276 sub get_authors_matchpoint {
 277
 278     my $params = shift;
 279
 280     my $length = $params->{length} // 0;
 281     my $norms  = $params->{norms}  // [];
 282     my $offset = $params->{offset} // 0;
 283
 284     my $matchpoint = {
 285         components =>  [
 286             {
 287                 length    => $length,
 288                 norms     => $norms,
 289                 offset    => $offset,
 290                 subfields =>
 291                     {
 292                         a => 1
 293                     },
 294                 tag => '700'
 295             },
 296             {
 297                 length    => $length,
 298                 norms     => $norms,
 299                 offset    => $offset,
 300                 subfields =>
 301                     {
 302                         a => 1
 303                     },
 304                 tag => '100'
 305             }
 306         ],
 307         index => "author",
 308         score => 1000
 309     };
 310
 311     return $matchpoint;
 312 }
 313