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_ok('C4::Matcher');
  37
  38 use Test::DBIx::Class {
  39     schema_class => 'Koha::Schema',
  40     connect_info => ['dbi:SQLite:dbname=:memory:','',''],
  41     connect_opts => { name_sep => '.', quote_char => '`', },
  42     fixture_class => '::Populate',
  43 }, 'MarcMatcher' ;
  44
  45 fixtures_ok [
  46     MarcMatcher => [
  47         [ 'matcher_id', 'code', 'description', 'record_type', 'threshold' ],
  48         [ 1,            'ISBN', 'ISBN',        'red',         1 ],
  49         [ 2,            'ISSN', 'ISSN',        'blue',        0 ]
  50     ],
  51 ], 'add fixtures';
  52
  53 my $db = Test::MockModule->new('Koha::Database');
  54 $db->mock( _new_schema => sub { return Schema(); } );
  55
  56 my @matchers = C4::Matcher::GetMatcherList();
  57
  58 is( $matchers[0]->{'matcher_id'}, 1, 'First matcher_id value is 1' );
  59
  60 is( $matchers[1]->{'matcher_id'}, 2, 'Second matcher_id value is 2' );
  61
  62 my $matcher_id = C4::Matcher::GetMatcherId('ISBN');
  63
  64 is( $matcher_id, 1, 'testing getmatcherid' );
  65
  66 my $testmatcher;
  67
  68 ok( $testmatcher = C4::Matcher->new( 'red', 1 ), 'testing matcher new' );
  69
  70 ok( $testmatcher = C4::Matcher->new( 'blue', 0 ), 'testing matcher new' );
  71
  72 $testmatcher->threshold(1000);
  73
  74 is( $testmatcher->threshold(), 1000, 'testing threshhold accessor method' );
  75
  76 $testmatcher->_id(53);
  77
  78 is( $testmatcher->_id(), 53, 'testing _id accessor' );
  79
  80 $testmatcher->code('match on ISBN');
  81
  82 is( $testmatcher->code(), 'match on ISBN', 'testing code accessor' );
  83
  84 $testmatcher->description('match on ISSN');
  85
  86 is( $testmatcher->description(), 'match on ISSN', 'testing code accessor' );
  87
  88 subtest '_get_match_keys() tests' => sub {
  89
  90     plan tests => 17;
  91
  92     my $matchpoint = get_title_matchpoint({
  93         length => 0,
  94         norms  => [ 'legacy_default' ],
  95         offset => 0
  96     });
  97
  98     my $record = MARC::Record->new();
  99     $record->append_fields(
 100         MARC::Field->new('100', '1', ' ',
 101                             a => 'King, Stephen',
 102                             d => 'd1947-'),
 103         MARC::Field->new('245', ' ', ' ',
 104                             a => '  .; thE t[]:,aliS(m)/An\'"',
 105                             c => 'Stephen King, Peter Straub.' ),
 106         MARC::Field->new('700', ' ', ' ',
 107                             a => 'Straub, Peter',
 108                             d => '1943-')
 109     );
 110
 111     my @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 112
 113     is( $keys[0], 'THE TALISMAN STEPHEN KING PETER STRAUB',
 114         'Match key correctly calculated with no $norms');
 115
 116     $matchpoint = get_title_matchpoint({
 117         length => 9,
 118         norms  => [ 'legacy_default' ],
 119         offset => 0
 120     });
 121     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 122     is( $keys[0], 'THE',
 123         'Match key correctly calculated with length 9');
 124
 125     $matchpoint = get_title_matchpoint({
 126         length => 9,
 127         norms  => [ 'legacy_default' ],
 128         offset => 1
 129     });
 130     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 131     is( $keys[0], 'THE T',
 132         'Match key correctly calculated with length 9 and offset 1');
 133
 134     $matchpoint = get_title_matchpoint({
 135         length => 9,
 136         norms  => [ 'legacy_default' ],
 137         offset => 2
 138     });
 139     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 140     is( $keys[0], 'THE T',
 141         'Match key correctly calculated with length 9 and offset 2, should not remove space');
 142
 143     $matchpoint = get_authors_matchpoint({
 144         length => 0,
 145         norms  => [ 'legacy_default' ],
 146         offset => 0
 147     });
 148     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 149     is( $keys[0], 'STRAUB PETER KING STEPHEN',
 150         'Match key correctly calculated with multiple components');
 151
 152     $matchpoint = get_authors_matchpoint({
 153         length => 9,
 154         norms  => [ 'legacy_default' ],
 155         offset => 0
 156     });
 157     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 158     is( $keys[0], 'STRAUB P KING STE',
 159         'Match key correctly calculated with multiple components, length 9');
 160
 161     $matchpoint = get_authors_matchpoint({
 162         length => 10,
 163         norms  => [ 'legacy_default' ],
 164         offset => 0
 165     });
 166     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 167     is( $keys[0], 'STRAUB PE KING STEP',
 168         'Match key correctly calculated with multiple components, length 10');
 169
 170     $matchpoint = get_authors_matchpoint({
 171         length => 10,
 172         norms  => [ 'legacy_default' ],
 173         offset => 2
 174     });
 175     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 176     is( $keys[0], 'RAUB PETE NG STEPHE',
 177         'Match key correctly calculated with multiple components, length 10, offset 1');
 178
 179     $matchpoint = get_title_matchpoint({
 180         length => 0,
 181         norms  => [ 'none', 'none' ],
 182         offset => 0
 183     });
 184     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 185     is( $keys[0], '  .; thE t[]:,aliS(m)/An\'" Stephen King, Peter Straub.',
 186         'Match key intact if \'none\' specified, length 0 and offset 0' );
 187
 188     $matchpoint = get_authors_matchpoint({
 189         length => 0,
 190         norms  => [ 'upper_case' ],
 191         offset => 0
 192     });
 193     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 194     is( $keys[0], 'STRAUB, PETER KING, STEPHEN',
 195         'Match key correctly calculated with multiple components, \'upper_case\' norm');
 196
 197     $matchpoint = get_authors_matchpoint({
 198         length => 0,
 199         norms  => [ 'lower_case' ],
 200         offset => 0
 201     });
 202     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 203     is( $keys[0], 'straub, peter king, stephen',
 204         'Match key correctly calculated with multiple components, \'lower_case\' norm');
 205
 206     $matchpoint = get_authors_matchpoint({
 207         length => 0,
 208         norms  => [ 'remove_spaces' ],
 209         offset => 0
 210     });
 211     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 212     is( $keys[0], 'Straub,Peter King,Stephen',
 213         'Match key correctly calculated with multiple components, \'remove_spaces\' norm');
 214
 215     $matchpoint = get_authors_matchpoint({
 216         length => 0,
 217         norms  => [ 'remove_spaces', 'lower_case' ],
 218         offset => 0
 219     });
 220     @keys = C4::Matcher::_get_match_keys( $record, $matchpoint );
 221     is( $keys[0], 'straub,peter king,stephen',
 222         'Match key correctly calculated with multiple components, \'remove_spaces\' and \'lower_case\' norm');
 223
 224     my $norm = 'unknown_norm';
 225     $matchpoint = get_title_matchpoint({
 226         length => 0,
 227         norms  => [ $norm ],
 228         offset => 0
 229     });
 230     warning_is
 231             { @keys = C4::Matcher::_get_match_keys( $record, $matchpoint ) }
 232             qq{Invalid normalization routine required ($norm)},
 233             'Passing an invalid normalization routine name raises a warning';
 234
 235     is( $keys[0], '  .; thE t[]:,aliS(m)/An\'" Stephen King, Peter Straub.',
 236         'Match key intact if invalid normalization routine specified' );
 237
 238     $matchpoint = get_title_matchpoint({
 239         length => 0,
 240         norms  => [ $norm, 'upper_case' ],
 241         offset => 0
 242     });
 243     warning_is
 244             { @keys = C4::Matcher::_get_match_keys( $record, $matchpoint ) }
 245             qq{Invalid normalization routine required ($norm)},
 246             'Passing an invalid normalization routine name raises a warning';
 247
 248     is( $keys[0], '  .; THE T[]:,ALIS(M)/AN\'" STEPHEN KING, PETER STRAUB.',
 249         'Match key correctly normalized if invalid normalization routine specified' );
 250 };
 251
 252 sub get_title_matchpoint {
 253
 254     my $params = shift;
 255
 256     my $length = $params->{length} // 0;
 257     my $norms  = $params->{norms}  // [];
 258     my $offset = $params->{offset} // 0;
 259
 260     my $matchpoint = {
 261         components =>  [
 262             {
 263                 length    => $length,
 264                 norms     => $norms,
 265                 offset    => $offset,
 266                 subfields =>
 267                     {
 268                         a => 1,
 269                         c => 1
 270                     },
 271                 tag => '245'
 272             }
 273         ],
 274         index => "title",
 275         score => 1000
 276     };
 277
 278     return $matchpoint;
 279 }
 280
 281 sub get_authors_matchpoint {
 282
 283     my $params = shift;
 284
 285     my $length = $params->{length} // 0;
 286     my $norms  = $params->{norms}  // [];
 287     my $offset = $params->{offset} // 0;
 288
 289     my $matchpoint = {
 290         components =>  [
 291             {
 292                 length    => $length,
 293                 norms     => $norms,
 294                 offset    => $offset,
 295                 subfields =>
 296                     {
 297                         a => 1
 298                     },
 299                 tag => '700'
 300             },
 301             {
 302                 length    => $length,
 303                 norms     => $norms,
 304                 offset    => $offset,
 305                 subfields =>
 306                     {
 307                         a => 1
 308                     },
 309                 tag => '100'
 310             }
 311         ],
 312         index => "author",
 313         score => 1000
 314     };
 315
 316     return $matchpoint;
 317 }
 318
 319 1;