t/db_dependent/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 use MARC::Record;
  20 use Test::More tests => 3;
  21 use Test::Warn;
  22
  23 use t::lib::TestBuilder;
  24 use t::lib::Mocks;
  25
  26 use Koha::Database;
  27 use C4::Matcher qw( GetMatcherList GetMatcherId );
  28
  29 my $schema  = Koha::Database->new->schema;
  30 my $builder = t::lib::TestBuilder->new;
  31 $schema->storage->txn_begin;
  32
  33 subtest 'GetMatcherList' => sub {
  34     plan tests => 9;
  35
  36     $schema->resultset('MarcMatcher')->delete_all;
  37     my $matcher1 = $builder->build({ source => 'MarcMatcher',
  38         value => { code => 'ISBN', description => 'ISBN', record_type => 'red', threshold => 1 },
  39     });
  40     my $matcher2 = $builder->build({ source => 'MarcMatcher',
  41         value => { code => 'ISSN', description => 'ISSN', record_type => 'blue', threshold => 0 },
  42     });
  43
  44     my @matchers = C4::Matcher::GetMatcherList();
  45     is( $matchers[0]->{'matcher_id'}, $matcher1->{matcher_id}, 'First matcher_id value' );
  46     is( $matchers[1]->{'matcher_id'}, $matcher2->{matcher_id}, 'Second matcher_id value' );
  47
  48     my $matcher_id = C4::Matcher::GetMatcherId('ISBN');
  49     is( $matcher_id, $matcher1->{matcher_id}, 'testing getmatcherid' );
  50
  51     my $testmatcher;
  52     ok( $testmatcher = C4::Matcher->new( 'red', 1 ), 'testing matcher new' );
  53     ok( $testmatcher = C4::Matcher->new( 'blue', 0 ), 'testing matcher new' );
  54
  55     $testmatcher->threshold(1000);
  56     is( $testmatcher->threshold(), 1000, 'testing threshhold accessor method' );
  57
  58     $testmatcher->_id(53);
  59     is( $testmatcher->_id(), 53, 'testing _id accessor' );
  60
  61     $testmatcher->code('match on ISBN');
  62     is( $testmatcher->code(), 'match on ISBN', 'testing code accessor' );
  63
  64     $testmatcher->description('match on ISSN');
  65     is( $testmatcher->description(), 'match on ISSN', 'testing code accessor' );
  66 };
  67
  68 subtest '_get_match_keys() tests' => sub {
  69     plan tests => 21;
  70
  71     my $matchpoint = get_title_matchpoint({
  72         length => 0,
  73         norms  => [ 'legacy_default' ],
  74         offset => 0
  75     });
  76
  77     my $record = MARC::Record->new();
  78     $record->append_fields(
  79         MARC::Field->new('020', '1', ' ',
  80                             a => '978-1451697216 (alk. paper)'),
  81         MARC::Field->new('020', '1', ' ',
  82                             a => '145169721X (alk. paper)'),
  83         MARC::Field->new('020', '1', ' ',
  84                             a => '1NOTISBN3'),
  85         MARC::Field->new('100', '1', ' ',
  86                             a => 'King, Stephen',
  87                             d => 'd1947-'),
  88         MARC::Field->new('245', ' ', ' ',
  89                             a => '  .; thE t[]:,aliS(m)/An\'"',
  90                             c => 'Stephen King, Peter Straub.' ),
  91         MARC::Field->new('700', ' ', ' ',
  92                             a => 'Straub, Peter',
  93                             d => '1943-')
  94     );
  95
  96     my @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
  97
  98     is( $keys[0], 'THE TALISMAN STEPHEN KING PETER STRAUB',
  99         'Match key correctly calculated with no $norms');
 100
 101     $matchpoint = get_title_matchpoint({
 102         length => 9,
 103         norms  => [ 'legacy_default' ],
 104         offset => 0
 105     });
 106     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 107     is( $keys[0], 'THE',
 108         'Match key correctly calculated with length 9');
 109
 110     $matchpoint = get_title_matchpoint({
 111         length => 9,
 112         norms  => [ 'legacy_default' ],
 113         offset => 1
 114     });
 115     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 116     is( $keys[0], 'THE T',
 117         'Match key correctly calculated with length 9 and offset 1');
 118
 119     $matchpoint = get_title_matchpoint({
 120         length => 9,
 121         norms  => [ 'legacy_default' ],
 122         offset => 2
 123     });
 124     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 125     is( $keys[0], 'THE T',
 126         'Match key correctly calculated with length 9 and offset 2, should not remove space');
 127
 128     $matchpoint = get_authors_matchpoint({
 129         length => 0,
 130         norms  => [ 'legacy_default' ],
 131         offset => 0
 132     });
 133     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 134     is( $keys[0], 'STRAUB PETER KING STEPHEN',
 135         'Match key correctly calculated with multiple components');
 136
 137     $matchpoint = get_authors_matchpoint({
 138         length => 9,
 139         norms  => [ 'legacy_default' ],
 140         offset => 0
 141     });
 142     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 143     is( $keys[0], 'STRAUB P KING STE',
 144         'Match key correctly calculated with multiple components, length 9');
 145
 146     $matchpoint = get_authors_matchpoint({
 147         length => 10,
 148         norms  => [ 'legacy_default' ],
 149         offset => 0
 150     });
 151     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 152     is( $keys[0], 'STRAUB PE KING STEP',
 153         'Match key correctly calculated with multiple components, length 10');
 154
 155     $matchpoint = get_authors_matchpoint({
 156         length => 10,
 157         norms  => [ 'legacy_default' ],
 158         offset => 2
 159     });
 160     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 161     is( $keys[0], 'RAUB PETE NG STEPHE',
 162         'Match key correctly calculated with multiple components, length 10, offset 1');
 163
 164     $matchpoint = get_title_matchpoint({
 165         length => 0,
 166         norms  => [ 'none', 'none' ],
 167         offset => 0
 168     });
 169     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 170     is( $keys[0], '  .; thE t[]:,aliS(m)/An\'" Stephen King, Peter Straub.',
 171         'Match key intact if \'none\' specified, length 0 and offset 0' );
 172
 173     $matchpoint = get_authors_matchpoint({
 174         length => 0,
 175         norms  => [ 'upper_case' ],
 176         offset => 0
 177     });
 178     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 179     is( $keys[0], 'STRAUB, PETER KING, STEPHEN',
 180         'Match key correctly calculated with multiple components, \'upper_case\' norm');
 181
 182     $matchpoint = get_authors_matchpoint({
 183         length => 0,
 184         norms  => [ 'lower_case' ],
 185         offset => 0
 186     });
 187     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 188     is( $keys[0], 'straub, peter king, stephen',
 189         'Match key correctly calculated with multiple components, \'lower_case\' norm');
 190
 191     $matchpoint = get_authors_matchpoint({
 192         length => 0,
 193         norms  => [ 'remove_spaces' ],
 194         offset => 0
 195     });
 196     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 197     is( $keys[0], 'Straub,Peter King,Stephen',
 198         'Match key correctly calculated with multiple components, \'remove_spaces\' norm');
 199
 200     $matchpoint = get_authors_matchpoint({
 201         length => 0,
 202         norms  => [ 'remove_spaces', 'lower_case' ],
 203         offset => 0
 204     });
 205     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 206     is( $keys[0], 'straub,peter king,stephen',
 207         'Match key correctly calculated with multiple components, \'remove_spaces\' and \'lower_case\' norm');
 208
 209     my $norm = 'unknown_norm';
 210     $matchpoint = get_title_matchpoint({
 211         length => 0,
 212         norms  => [ $norm ],
 213         offset => 0
 214     });
 215     warning_is
 216             { @keys = C4::Matcher::_get_match_keys( $record, $matchpoint ) }
 217             qq{Invalid normalization routine required ($norm)},
 218             'Passing an invalid normalization routine name raises a warning';
 219
 220     is( $keys[0], '  .; thE t[]:,aliS(m)/An\'" Stephen King, Peter Straub.',
 221         'Match key intact if invalid normalization routine specified' );
 222
 223     $matchpoint = get_title_matchpoint({
 224         length => 0,
 225         norms  => [ $norm, 'upper_case' ],
 226         offset => 0
 227     });
 228     warning_is
 229             { @keys = C4::Matcher::_get_match_keys( $record, $matchpoint ) }
 230             qq{Invalid normalization routine required ($norm)},
 231             'Passing an invalid normalization routine name raises a warning';
 232
 233     is( $keys[0], '  .; THE T[]:,ALIS(M)/AN\'" STEPHEN KING, PETER STRAUB.',
 234         'Match key correctly normalized if invalid normalization routine specified' );
 235
 236     $matchpoint = get_isbn_matchpoint({
 237         length => 0,
 238         norms  => [ 'ISBN' ],
 239         offset => 0
 240     });
 241     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 242     is( $keys[0], '9781451697216',
 243         'Match key correctly calculated as ISBN13 when ISBN normalizer used');
 244     is( $keys[1], '9781451697216',
 245         'Match key correctly calculated as ISBN13 when ISBN normalizer used');
 246     is( $keys[2], '1NOTISBN3',
 247         'Match key passed through if not an isbn when ISBN normalizer used');
 248
 249     $matchpoint = get_title_matchpoint({
 250         length => 0,
 251         offset => 0
 252     });
 253     delete $matchpoint->{component}->{subfields};
 254     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 255     is( $keys[0], '  .; thE t[]:,aliS(m)/An\'" Stephen King, Peter Straub.', "Match key correctly returns whole field if no subfields specified" )
 256 };
 257
 258 subtest '_get_match_keys() leader tests' => sub {
 259     plan tests => 2;
 260     my $record = MARC::Record->new();
 261     my $matchpoint = get_leader_matchpoint({
 262         length => 1,
 263         offset => 6,
 264     });
 265
 266     my @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 267     is( $keys[0], ' ', 'Match key correctly calculated as " " from LDR6 when no leader available');
 268
 269     $record->leader('01344cam a22003014a 4500');
 270
 271     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 272     is( $keys[0], 'a', 'Match key correctly calculated as "a" from LDR6');
 273 };
 274
 275 sub get_title_matchpoint {
 276     my $params = shift;
 277
 278     my $length = $params->{length} // 0;
 279     my $norms  = $params->{norms}  // [];
 280     my $offset = $params->{offset} // 0;
 281
 282     my $matchpoint = {
 283         components =>  [
 284             {
 285                 length    => $length,
 286                 norms     => $norms,
 287                 offset    => $offset,
 288                 subfields =>
 289                     {
 290                         a => 1,
 291                         c => 1
 292                     },
 293                 tag => '245'
 294             }
 295         ],
 296         index => "title",
 297         score => 1000
 298     };
 299
 300     return $matchpoint;
 301 }
 302
 303 sub get_authors_matchpoint {
 304     my $params = shift;
 305
 306     my $length = $params->{length} // 0;
 307     my $norms  = $params->{norms}  // [];
 308     my $offset = $params->{offset} // 0;
 309
 310     my $matchpoint = {
 311         components =>  [
 312             {
 313                 length    => $length,
 314                 norms     => $norms,
 315                 offset    => $offset,
 316                 subfields =>
 317                     {
 318                         a => 1
 319                     },
 320                 tag => '700'
 321             },
 322             {
 323                 length    => $length,
 324                 norms     => $norms,
 325                 offset    => $offset,
 326                 subfields =>
 327                     {
 328                         a => 1
 329                     },
 330                 tag => '100'
 331             }
 332         ],
 333         index => "author",
 334         score => 1000
 335     };
 336
 337     return $matchpoint;
 338 }
 339
 340 sub get_isbn_matchpoint {
 341     my $params = shift;
 342
 343     my $length = $params->{length} // 0;
 344     my $norms  = $params->{norms}  // [];
 345     my $offset = $params->{offset} // 0;
 346
 347     my $matchpoint = {
 348         components =>  [
 349             {
 350                 length    => $length,
 351                 norms     => $norms,
 352                 offset    => $offset,
 353                 subfields =>
 354                     {
 355                         a => 1
 356                     },
 357                 tag => '020'
 358             },
 359         ],
 360         index => "isbn",
 361         score => 1000
 362     };
 363
 364     return $matchpoint;
 365 }
 366
 367 sub get_leader_matchpoint {
 368     my $params = shift;
 369     my $length = $params->{length} // 0;
 370     my $norms  = $params->{norms}  // [];
 371     my $offset = $params->{offset} // 0;
 372
 373     my $matchpoint = {
 374         components =>  [
 375             {
 376                 length    => $length,
 377                 norms     => $norms,
 378                 offset    => $offset,
 379                 tag => 'LDR'
 380             },
 381         ],
 382     };
 383
 384     return $matchpoint;
 385 }
 386
 387 $schema->storage->txn_rollback;