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 => 13;
  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', qw( GetMatcherList GetMatcherId ));
  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 => 21;
  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('020', '1', ' ',
  96                             a => '978-1451697216 (alk. paper)'),
  97         MARC::Field->new('020', '1', ' ',
  98                             a => '145169721X (alk. paper)'),
  99         MARC::Field->new('020', '1', ' ',
 100                             a => '1NOTISBN3'),
 101         MARC::Field->new('100', '1', ' ',
 102                             a => 'King, Stephen',
 103                             d => 'd1947-'),
 104         MARC::Field->new('245', ' ', ' ',
 105                             a => '  .; thE t[]:,aliS(m)/An\'"',
 106                             c => 'Stephen King, Peter Straub.' ),
 107         MARC::Field->new('700', ' ', ' ',
 108                             a => 'Straub, Peter',
 109                             d => '1943-')
 110     );
 111
 112     my @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 113
 114     is( $keys[0], 'THE TALISMAN STEPHEN KING PETER STRAUB',
 115         'Match key correctly calculated with no $norms');
 116
 117     $matchpoint = get_title_matchpoint({
 118         length => 9,
 119         norms  => [ 'legacy_default' ],
 120         offset => 0
 121     });
 122     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 123     is( $keys[0], 'THE',
 124         'Match key correctly calculated with length 9');
 125
 126     $matchpoint = get_title_matchpoint({
 127         length => 9,
 128         norms  => [ 'legacy_default' ],
 129         offset => 1
 130     });
 131     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 132     is( $keys[0], 'THE T',
 133         'Match key correctly calculated with length 9 and offset 1');
 134
 135     $matchpoint = get_title_matchpoint({
 136         length => 9,
 137         norms  => [ 'legacy_default' ],
 138         offset => 2
 139     });
 140     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 141     is( $keys[0], 'THE T',
 142         'Match key correctly calculated with length 9 and offset 2, should not remove space');
 143
 144     $matchpoint = get_authors_matchpoint({
 145         length => 0,
 146         norms  => [ 'legacy_default' ],
 147         offset => 0
 148     });
 149     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 150     is( $keys[0], 'STRAUB PETER KING STEPHEN',
 151         'Match key correctly calculated with multiple components');
 152
 153     $matchpoint = get_authors_matchpoint({
 154         length => 9,
 155         norms  => [ 'legacy_default' ],
 156         offset => 0
 157     });
 158     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 159     is( $keys[0], 'STRAUB P KING STE',
 160         'Match key correctly calculated with multiple components, length 9');
 161
 162     $matchpoint = get_authors_matchpoint({
 163         length => 10,
 164         norms  => [ 'legacy_default' ],
 165         offset => 0
 166     });
 167     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 168     is( $keys[0], 'STRAUB PE KING STEP',
 169         'Match key correctly calculated with multiple components, length 10');
 170
 171     $matchpoint = get_authors_matchpoint({
 172         length => 10,
 173         norms  => [ 'legacy_default' ],
 174         offset => 2
 175     });
 176     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 177     is( $keys[0], 'RAUB PETE NG STEPHE',
 178         'Match key correctly calculated with multiple components, length 10, offset 1');
 179
 180     $matchpoint = get_title_matchpoint({
 181         length => 0,
 182         norms  => [ 'none', 'none' ],
 183         offset => 0
 184     });
 185     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 186     is( $keys[0], '  .; thE t[]:,aliS(m)/An\'" Stephen King, Peter Straub.',
 187         'Match key intact if \'none\' specified, length 0 and offset 0' );
 188
 189     $matchpoint = get_authors_matchpoint({
 190         length => 0,
 191         norms  => [ 'upper_case' ],
 192         offset => 0
 193     });
 194     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 195     is( $keys[0], 'STRAUB, PETER KING, STEPHEN',
 196         'Match key correctly calculated with multiple components, \'upper_case\' norm');
 197
 198     $matchpoint = get_authors_matchpoint({
 199         length => 0,
 200         norms  => [ 'lower_case' ],
 201         offset => 0
 202     });
 203     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 204     is( $keys[0], 'straub, peter king, stephen',
 205         'Match key correctly calculated with multiple components, \'lower_case\' norm');
 206
 207     $matchpoint = get_authors_matchpoint({
 208         length => 0,
 209         norms  => [ 'remove_spaces' ],
 210         offset => 0
 211     });
 212     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 213     is( $keys[0], 'Straub,Peter King,Stephen',
 214         'Match key correctly calculated with multiple components, \'remove_spaces\' norm');
 215
 216     $matchpoint = get_authors_matchpoint({
 217         length => 0,
 218         norms  => [ 'remove_spaces', 'lower_case' ],
 219         offset => 0
 220     });
 221     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 222     is( $keys[0], 'straub,peter king,stephen',
 223         'Match key correctly calculated with multiple components, \'remove_spaces\' and \'lower_case\' norm');
 224
 225     my $norm = 'unknown_norm';
 226     $matchpoint = get_title_matchpoint({
 227         length => 0,
 228         norms  => [ $norm ],
 229         offset => 0
 230     });
 231     warning_is
 232             { @keys = C4::Matcher::_get_match_keys( $record, $matchpoint ) }
 233             qq{Invalid normalization routine required ($norm)},
 234             'Passing an invalid normalization routine name raises a warning';
 235
 236     is( $keys[0], '  .; thE t[]:,aliS(m)/An\'" Stephen King, Peter Straub.',
 237         'Match key intact if invalid normalization routine specified' );
 238
 239     $matchpoint = get_title_matchpoint({
 240         length => 0,
 241         norms  => [ $norm, 'upper_case' ],
 242         offset => 0
 243     });
 244     warning_is
 245             { @keys = C4::Matcher::_get_match_keys( $record, $matchpoint ) }
 246             qq{Invalid normalization routine required ($norm)},
 247             'Passing an invalid normalization routine name raises a warning';
 248
 249     is( $keys[0], '  .; THE T[]:,ALIS(M)/AN\'" STEPHEN KING, PETER STRAUB.',
 250         'Match key correctly normalized if invalid normalization routine specified' );
 251
 252     $matchpoint = get_isbn_matchpoint({
 253         length => 0,
 254         norms  => [ 'ISBN' ],
 255         offset => 0
 256     });
 257     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 258     is( $keys[0], '9781451697216',
 259         'Match key correctly calculated as ISBN13 when ISBN normalizer used');
 260     is( $keys[1], '9781451697216',
 261         'Match key correctly calculated as ISBN13 when ISBN normalizer used');
 262     is( $keys[2], '1NOTISBN3',
 263         'Match key passed through if not an isbn when ISBN normalizer used');
 264
 265     $matchpoint = get_title_matchpoint({
 266         length => 0,
 267         offset => 0
 268     });
 269     delete $matchpoint->{component}->{subfields};
 270     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 271     is( $keys[0], '  .; thE t[]:,aliS(m)/An\'" Stephen King, Peter Straub.', "Match key correctly returns whole field if no subfields specified" )
 272 };
 273
 274 subtest '_get_match_keys() leader tests' => sub {
 275     plan tests => 2;
 276     my $record = MARC::Record->new();
 277     my $matchpoint = get_leader_matchpoint({
 278         length => 1,
 279         offset => 6,
 280     });
 281
 282     my @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 283     is( $keys[0], ' ', 'Match key correctly calculated as " " from LDR6 when no leader available');
 284
 285     $record->leader('01344cam a22003014a 4500');
 286
 287     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 288     is( $keys[0], 'a', 'Match key correctly calculated as "a" from LDR6');
 289 };
 290
 291 sub get_title_matchpoint {
 292
 293     my $params = shift;
 294
 295     my $length = $params->{length} // 0;
 296     my $norms  = $params->{norms}  // [];
 297     my $offset = $params->{offset} // 0;
 298
 299     my $matchpoint = {
 300         components =>  [
 301             {
 302                 length    => $length,
 303                 norms     => $norms,
 304                 offset    => $offset,
 305                 subfields =>
 306                     {
 307                         a => 1,
 308                         c => 1
 309                     },
 310                 tag => '245'
 311             }
 312         ],
 313         index => "title",
 314         score => 1000
 315     };
 316
 317     return $matchpoint;
 318 }
 319
 320 sub get_authors_matchpoint {
 321
 322     my $params = shift;
 323
 324     my $length = $params->{length} // 0;
 325     my $norms  = $params->{norms}  // [];
 326     my $offset = $params->{offset} // 0;
 327
 328     my $matchpoint = {
 329         components =>  [
 330             {
 331                 length    => $length,
 332                 norms     => $norms,
 333                 offset    => $offset,
 334                 subfields =>
 335                     {
 336                         a => 1
 337                     },
 338                 tag => '700'
 339             },
 340             {
 341                 length    => $length,
 342                 norms     => $norms,
 343                 offset    => $offset,
 344                 subfields =>
 345                     {
 346                         a => 1
 347                     },
 348                 tag => '100'
 349             }
 350         ],
 351         index => "author",
 352         score => 1000
 353     };
 354
 355     return $matchpoint;
 356 }
 357
 358 sub get_isbn_matchpoint {
 359
 360     my $params = shift;
 361
 362     my $length = $params->{length} // 0;
 363     my $norms  = $params->{norms}  // [];
 364     my $offset = $params->{offset} // 0;
 365
 366     my $matchpoint = {
 367         components =>  [
 368             {
 369                 length    => $length,
 370                 norms     => $norms,
 371                 offset    => $offset,
 372                 subfields =>
 373                     {
 374                         a => 1
 375                     },
 376                 tag => '020'
 377             },
 378         ],
 379         index => "isbn",
 380         score => 1000
 381     };
 382
 383     return $matchpoint;
 384 }
 385
 386 sub get_leader_matchpoint {
 387     my $params = shift;
 388     my $length = $params->{length} // 0;
 389     my $norms  = $params->{norms}  // [];
 390     my $offset = $params->{offset} // 0;
 391
 392     my $matchpoint = {
 393         components =>  [
 394             {
 395                 length    => $length,
 396                 norms     => $norms,
 397                 offset    => $offset,
 398                 tag => 'LDR'
 399             },
 400         ],
 401     };
 402
 403     return $matchpoint;
 404 }