| Lines 17-30
          package C4::Matcher;
      
      
        Link Here | 
        
          | 17 | # You should have received a copy of the GNU General Public License | 17 | # You should have received a copy of the GNU General Public License | 
        
          | 18 | # along with Koha; if not, see <http://www.gnu.org/licenses>. | 18 | # along with Koha; if not, see <http://www.gnu.org/licenses>. | 
        
          | 19 |  | 19 |  | 
          
            
              | 20 | use strict; | 20 | use Modern::Perl; | 
            
              | 21 | use warnings; |  |  | 
        
          | 22 |  | 21 |  | 
            
              | 23 | use C4::Context; |  |  | 
        
          | 24 | use MARC::Record; | 22 | use MARC::Record; | 
        
          | 25 |  | 23 |  | 
        
          | 26 | use Koha::SearchEngine; | 24 | use Koha::SearchEngine; | 
        
          | 27 | use Koha::SearchEngine::Search; | 25 | use Koha::SearchEngine::Search; | 
            
              |  |  | 26 | use Koha::Util::Normalize qw/legacy_default remove_spaces upper_case lower_case/; | 
        
          | 28 |  | 27 |  | 
        
          | 29 | =head1 NAME | 28 | =head1 NAME | 
        
          | 30 |  | 29 |  | 
  
    | Lines 774-779
          sub _passes_required_checks {
      
      
        Link Here | 
        
          | 774 | } | 773 | } | 
        
          | 775 |  | 774 |  | 
        
          | 776 | sub _get_match_keys { | 775 | sub _get_match_keys { | 
            
              |  |  | 776 |  | 
        
          | 777 |     my $source_record = shift; | 777 |     my $source_record = shift; | 
        
          | 778 |     my $matchpoint = shift; | 778 |     my $matchpoint = shift; | 
        
          | 779 |     my $check_only_first_repeat = @_ ? shift : 0; | 779 |     my $check_only_first_repeat = @_ ? shift : 0; | 
  
    | Lines 792-798
          sub _get_match_keys {
      
      
        Link Here | 
        
          | 792 |     # If there are two 003s and two 001s, there will be two keys: | 792 |     # If there are two 003s and two 001s, there will be two keys: | 
        
          | 793 |     #    first 003 + first 001 | 793 |     #    first 003 + first 001 | 
        
          | 794 |     #    second 003 + second 001 | 794 |     #    second 003 + second 001 | 
          
            
              | 795 |      | 795 |  | 
        
          | 796 |     my @keys = (); | 796 |     my @keys = (); | 
        
          | 797 |     for (my $i = 0; $i <= $#{ $matchpoint->{'components'} }; $i++) { | 797 |     for (my $i = 0; $i <= $#{ $matchpoint->{'components'} }; $i++) { | 
        
          | 798 |         my $component = $matchpoint->{'components'}->[$i]; | 798 |         my $component = $matchpoint->{'components'}->[$i]; | 
  
    | Lines 801-824
          sub _get_match_keys {
      
      
        Link Here | 
        
          | 801 |             $j++; | 801 |             $j++; | 
        
          | 802 |             last FIELD if $j > 0 and $check_only_first_repeat; | 802 |             last FIELD if $j > 0 and $check_only_first_repeat; | 
        
          | 803 |             last FIELD if $i > 0 and $j > $#keys; | 803 |             last FIELD if $i > 0 and $j > $#keys; | 
          
            
              | 804 |             my $key = ""; | 804 |  | 
            
              | 805 | 			my $string; | 805 |             my $string; | 
            
              | 806 |             if ($field->is_control_field()) { | 806 |             if ( $field->is_control_field() ) { | 
            
              | 807 | 				$string=$field->data(); | 807 |                 $string = $field->data(); | 
        
          | 808 |             } else { | 808 |             } else { | 
          
            
              | 809 |                 foreach my $subfield ($field->subfields()) { | 809 |                 $string = $field->as_string( | 
            
              | 810 |                     if (exists $component->{'subfields'}->{$subfield->[0]}) { | 810 |                     join('', keys %{ $component->{ subfields } }), ' ' # ' ' as separator | 
            
              | 811 |                         $string .= " " . $subfield->[1]; #FIXME: It would be better to create an array and join with a space later... | 811 |                 ); | 
            
              | 812 |                     } | 812 |             } | 
            
              | 813 |                 } | 813 |  | 
            
              | 814 | 			} |  |  | 
        
          | 815 |             if ($component->{'length'}>0) { | 814 |             if ($component->{'length'}>0) { | 
          
            
              | 816 |                     $string= substr($string, $component->{'offset'}, $component->{'length'}); | 815 |                 $string= substr($string, $component->{'offset'}, $component->{'length'}); | 
            
              | 817 |                             # FIXME normalize, substr |  |  | 
        
          | 818 |             } elsif ($component->{'offset'}) { | 816 |             } elsif ($component->{'offset'}) { | 
          
            
              | 819 |                     $string= substr($string, $component->{'offset'}); | 817 |                 $string= substr($string, $component->{'offset'}); | 
        
          | 820 |             } | 818 |             } | 
          
            
              | 821 |             $key = _normalize($string); | 819 |  | 
            
              |  |  | 820 |             my $norms = $component->{'norms'}; | 
            
              | 821 |             my $key = $string; | 
            
              | 822 |  | 
            
              | 823 |             foreach my $norm ( @{ $norms } ) { | 
            
              | 824 |                 if ( grep { $norm eq $_ } valid_normalization_routines() ) { | 
            
              | 825 |                     if ( $norm eq 'remove_spaces' ) { | 
            
              | 826 |                         $key = remove_spaces($key); | 
            
              | 827 |                     } | 
            
              | 828 |                     elsif ( $norm eq 'upper_case' ) { | 
            
              | 829 |                         $key = upper_case($key); | 
            
              | 830 |                     } | 
            
              | 831 |                     elsif ( $norm eq 'lower_case' ) { | 
            
              | 832 |                         $key = lower_case($key); | 
            
              | 833 |                     } | 
            
              | 834 |                     elsif ( $norm eq 'legacy_default' ) { | 
            
              | 835 |                         $key = legacy_default($key); | 
            
              | 836 |                     } | 
            
              | 837 |                 } else { | 
            
              | 838 |                     warn "Invalid normalization routine required ($norm)" | 
            
              | 839 |                         unless $norm eq 'none'; | 
            
              | 840 |                 } | 
            
              | 841 |             } | 
            
              | 842 |  | 
        
          | 822 |             if ($i == 0) { | 843 |             if ($i == 0) { | 
        
          | 823 |                 push @keys, $key if $key; | 844 |                 push @keys, $key if $key; | 
        
          | 824 |             } else { | 845 |             } else { | 
  
    | Lines 843-858
          sub _parse_match_component {
      
      
        Link Here | 
        
          | 843 |     return $component; | 864 |     return $component; | 
        
          | 844 | } | 865 | } | 
        
          | 845 |  | 866 |  | 
          
            
              | 846 | # FIXME - default normalizer | 867 | sub valid_normalization_routines { | 
            
              | 847 | sub _normalize { | 868 |  | 
            
              | 848 |     my $value = uc shift; | 869 |     return ( | 
            
              | 849 |     $value =~ s/[.;:,\]\[\)\(\/'"]//g; | 870 |         'remove_spaces', | 
            
              | 850 |     $value =~ s/^\s+//; | 871 |         'upper_case', | 
            
              | 851 |     #$value =~ s/^\s+$//; | 872 |         'lower_case', | 
            
              | 852 |     $value =~ s/\s+$//; | 873 |         'legacy_default' | 
            
              | 853 |     $value =~ s/\s+/ /g; | 874 |     ); | 
            
              | 854 |     #$value =~ s/[.;,\]\[\)\(\/"']//g; |  |  | 
            
              | 855 |     return $value; | 
        
          | 856 | } | 875 | } | 
        
          | 857 |  | 876 |  | 
        
          | 858 | 1; | 877 | 1; | 
            
              | 859 | -  |  |  |