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 => 20;
  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 };
 266
 267 sub get_title_matchpoint {
 268
 269     my $params = shift;
 270
 271     my $length = $params->{length} // 0;
 272     my $norms  = $params->{norms}  // [];
 273     my $offset = $params->{offset} // 0;
 274
 275     my $matchpoint = {
 276         components =>  [
 277             {
 278                 length    => $length,
 279                 norms     => $norms,
 280                 offset    => $offset,
 281                 subfields =>
 282                     {
 283                         a => 1,
 284                         c => 1
 285                     },
 286                 tag => '245'
 287             }
 288         ],
 289         index => "title",
 290         score => 1000
 291     };
 292
 293     return $matchpoint;
 294 }
 295
 296 sub get_authors_matchpoint {
 297
 298     my $params = shift;
 299
 300     my $length = $params->{length} // 0;
 301     my $norms  = $params->{norms}  // [];
 302     my $offset = $params->{offset} // 0;
 303
 304     my $matchpoint = {
 305         components =>  [
 306             {
 307                 length    => $length,
 308                 norms     => $norms,
 309                 offset    => $offset,
 310                 subfields =>
 311                     {
 312                         a => 1
 313                     },
 314                 tag => '700'
 315             },
 316             {
 317                 length    => $length,
 318                 norms     => $norms,
 319                 offset    => $offset,
 320                 subfields =>
 321                     {
 322                         a => 1
 323                     },
 324                 tag => '100'
 325             }
 326         ],
 327         index => "author",
 328         score => 1000
 329     };
 330
 331     return $matchpoint;
 332 }
 333
 334 sub get_isbn_matchpoint {
 335
 336     my $params = shift;
 337
 338     my $length = $params->{length} // 0;
 339     my $norms  = $params->{norms}  // [];
 340     my $offset = $params->{offset} // 0;
 341
 342     my $matchpoint = {
 343         components =>  [
 344             {
 345                 length    => $length,
 346                 norms     => $norms,
 347                 offset    => $offset,
 348                 subfields =>
 349                     {
 350                         a => 1
 351                     },
 352                 tag => '020'
 353             },
 354         ],
 355         index => "isbn",
 356         score => 1000
 357     };
 358
 359     return $matchpoint;
 360 }