"Fossies" - the Fresh Open Source Software Archive

Member "koha-19.11.15/admin/matching-rules.pl" (23 Feb 2021, 10311 Bytes) of package /linux/misc/koha-19.11.15.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "matching-rules.pl" see the Fossies "Dox" file reference documentation and the last Fossies "Diffs" side-by-side code changes report: 20.05.06_vs_20.11.00.

    1 #! /usr/bin/perl
    2 #
    3 # Copyright 2007 LibLime
    4 #
    5 # This file is part of Koha.
    6 #
    7 # Koha is free software; you can redistribute it and/or modify it
    8 # under the terms of the GNU General Public License as published by
    9 # the Free Software Foundation; either version 3 of the License, or
   10 # (at your option) any later version.
   11 #
   12 # Koha is distributed in the hope that it will be useful, but
   13 # WITHOUT ANY WARRANTY; without even the implied warranty of
   14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
   15 # GNU General Public License for more details.
   16 #
   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>.
   19 #
   20 
   21 use Modern::Perl;
   22 
   23 use CGI qw ( -utf8 );
   24 use C4::Auth;
   25 use C4::Context;
   26 use C4::Output;
   27 use C4::Koha;
   28 use C4::Matcher qw/valid_normalization_routines/;
   29 
   30 my $script_name = "/cgi-bin/koha/admin/matching-rules.pl";
   31 
   32 our $input = new CGI;
   33 my $op = $input->param('op') || '';
   34 
   35 
   36 my ($template, $loggedinuser, $cookie)
   37     = get_template_and_user({template_name => "admin/matching-rules.tt",
   38                  query => $input,
   39                  type => "intranet",
   40                  flagsrequired => { parameters => 'manage_matching_rules' },
   41                  debug => 1,
   42                  });
   43 
   44 $template->param(script_name => $script_name);
   45 
   46 my $matcher_id = $input->param("matcher_id");
   47 
   48 $template->param( max_matchpoint => 0 );
   49 $template->param( max_matchcheck => 0 );
   50 my @valid_norms = C4::Matcher::valid_normalization_routines();
   51 unshift @valid_norms, 'none';
   52 $template->param( valid_norms => \@valid_norms );
   53 
   54 my $display_list = 0;
   55 if ($op eq "edit_matching_rule") {
   56     edit_matching_rule_form($template, $matcher_id);
   57 } elsif ($op eq "edit_matching_rule_confirmed") {
   58     add_update_matching_rule($template, $matcher_id);
   59     $display_list = 1;
   60 } elsif ($op eq "add_matching_rule") {
   61     add_matching_rule_form($template);
   62 } elsif ($op eq "add_matching_rule_confirmed") {
   63     add_update_matching_rule($template, $matcher_id);
   64     $display_list = 1;
   65 } elsif ($op eq "delete_matching_rule") {
   66     delete_matching_rule_form($template, $matcher_id);
   67 } elsif ($op eq "delete_matching_rule_confirmed") {
   68     delete_matching_rule($template, $matcher_id);
   69     $display_list = 1;
   70 } else {
   71     $display_list = 1;
   72 }
   73 
   74 if ($display_list) {
   75     matching_rule_list($template);
   76 }
   77 
   78 output_html_with_http_headers $input, $cookie, $template->output;
   79 
   80 exit 0;
   81 
   82 sub add_matching_rule_form {
   83     my $template = shift;
   84 
   85     $template->param(
   86         matching_rule_form => 1,
   87         confirm_op => 'add_matching_rule_confirmed',
   88         max_matchpoint => 1,
   89         max_matchcheck => 1
   90     );
   91 
   92 }
   93 
   94 sub add_update_matching_rule {
   95     my $template = shift;
   96     my $matcher_id = shift;
   97     my $record_type = $input->param('record_type') || 'biblio';
   98 
   99     # do parsing
  100     my $matcher = C4::Matcher->new($record_type, 1000);
  101     $matcher->code(scalar $input->param('code'));
  102     $matcher->description(scalar $input->param('description'));
  103     $matcher->threshold(scalar $input->param('threshold'));
  104 
  105     # matchpoints
  106     my @mp_nums = sort map { /^mp_(\d+)_search_index/ ? int($1): () } $input->multi_param;
  107     foreach my $mp_num (@mp_nums) {
  108         my $index = $input->param("mp_${mp_num}_search_index");
  109         my $score = $input->param("mp_${mp_num}_score");
  110         # components
  111         my $components = [];
  112         my @comp_nums = sort map { /^mp_${mp_num}_c_(\d+)_tag/ ? int($1): () } $input->multi_param;
  113         foreach my $comp_num (@comp_nums) {
  114             my $component = {};
  115             $component->{'tag'} = $input->param("mp_${mp_num}_c_${comp_num}_tag");
  116             $component->{'subfields'} = $input->param("mp_${mp_num}_c_${comp_num}_subfields");
  117             $component->{'offset'} = $input->param("mp_${mp_num}_c_${comp_num}_offset");
  118             $component->{'length'} = $input->param("mp_${mp_num}_c_${comp_num}_length");
  119             # norms
  120             $component->{'norms'} = [];
  121             my @norm_nums = sort map { /^mp_${mp_num}_c_${comp_num}_n_(\d+)_norm/ ? int($1): () } $input->multi_param;
  122             foreach my $norm_num (@norm_nums) {
  123                 push @{ $component->{'norms'} }, $input->multi_param("mp_${mp_num}_c_${comp_num}_n_${norm_num}_norm");
  124             }
  125             push @$components, $component;
  126         }
  127         $matcher->add_matchpoint($index, $score, $components);
  128     }
  129 
  130     # match checks
  131     my @mc_nums = sort map { /^mc_(\d+)_id/ ? int($1): () } $input->multi_param;
  132     foreach my $mc_num (@mc_nums) {
  133         # source components
  134         my $src_components = [];
  135         my @src_comp_nums = sort map { /^mc_${mc_num}_src_c_(\d+)_tag/ ? int($1): () } $input->multi_param;
  136         foreach my $comp_num (@src_comp_nums) {
  137             my $component = {};
  138             $component->{'tag'} = $input->param("mc_${mc_num}_src_c_${comp_num}_tag");
  139             $component->{'subfields'} = $input->param("mc_${mc_num}_src_c_${comp_num}_subfields");
  140             $component->{'offset'} = $input->param("mc_${mc_num}_src_c_${comp_num}_offset");
  141             $component->{'length'} = $input->param("mc_${mc_num}_src_c_${comp_num}_length");
  142             # norms
  143             $component->{'norms'} = [];
  144             my @norm_nums = sort map { /^mc_${mc_num}_src_c_${comp_num}_n_(\d+)_norm/ ? int($1): () } $input->multi_param;
  145             foreach my $norm_num (@norm_nums) {
  146                 push @{ $component->{'norms'} }, $input->multi_param("mc_${mc_num}_src_c_${comp_num}_n_${norm_num}_norm");
  147             }
  148             push @$src_components, $component;
  149         }
  150         # target components
  151         my $tgt_components = [];
  152         my @tgt_comp_nums = sort map { /^mc_${mc_num}_tgt_c_(\d+)_tag/ ? int($1): () } $input->multi_param;
  153         foreach my $comp_num (@tgt_comp_nums) {
  154             my $component = {};
  155             $component->{'tag'} = $input->param("mc_${mc_num}_tgt_c_${comp_num}_tag");
  156             $component->{'subfields'} = $input->param("mc_${mc_num}_tgt_c_${comp_num}_subfields");
  157             $component->{'offset'} = $input->param("mc_${mc_num}_tgt_c_${comp_num}_offset");
  158             $component->{'length'} = $input->param("mc_${mc_num}_tgt_c_${comp_num}_length");
  159             # norms
  160             $component->{'norms'} = [];
  161             my @norm_nums = sort map { /^mc_${mc_num}_tgt_c_${comp_num}_n_(\d+)_norm/ ? int($1): () } $input->multi_param;
  162             foreach my $norm_num (@norm_nums) {
  163                 push @{ $component->{'norms'} }, $input->multi_param("mc_${mc_num}_tgt_c_${comp_num}_n_${norm_num}_norm");
  164             }
  165             push @$tgt_components, $component;
  166         }
  167         $matcher->add_required_check($src_components, $tgt_components);
  168     }
  169     
  170     if (defined $matcher_id and $matcher_id =~ /^\d+/) {
  171         $matcher->_id($matcher_id);
  172         $template->param(edited_matching_rule => $matcher->code());
  173     } else {
  174         $template->param(added_matching_rule => $matcher->code());
  175     }
  176     $matcher_id = $matcher->store();
  177 }
  178 
  179 sub delete_matching_rule_form {
  180     my $template = shift;
  181     my $matcher_id = shift;
  182 
  183     my $matcher = C4::Matcher->fetch($matcher_id);
  184     $template->param(
  185         delete_matching_rule_form => 1,
  186         confirm_op => "delete_matching_rule_confirmed",
  187         matcher_id => $matcher_id,
  188         code => $matcher->code(),
  189         description => $matcher->description(),
  190     );
  191 }
  192 
  193 sub delete_matching_rule {
  194     my $template = shift;
  195     my $matcher_id = shift;
  196 
  197     my $matcher = C4::Matcher->fetch($matcher_id);
  198     $template->param(deleted_matching_rule => $matcher->code(),
  199                     );
  200     C4::Matcher->delete($matcher_id);
  201 }
  202 
  203 sub edit_matching_rule_form {
  204     my $template = shift;
  205     my $matcher_id = shift;
  206 
  207     my $matcher = C4::Matcher->fetch($matcher_id);
  208 
  209     $template->{VARS}->{'matcher_id'} = $matcher_id;
  210     $template->{VARS}->{'code'} = $matcher->code();
  211     $template->{VARS}->{'description'} = $matcher->description();
  212     $template->{VARS}->{'threshold'} = $matcher->threshold();
  213     $template->{VARS}->{'record_type'} = $matcher->record_type();
  214 
  215     my $matcher_info = $matcher->dump();
  216     my @matchpoints = ();
  217     my $mp_num = 0;
  218     foreach my $matchpoint (@{ $matcher_info->{'matchpoints'} }) {
  219         $mp_num++;
  220         my @components = _parse_components($matchpoint->{'components'});
  221         push @matchpoints, { 
  222             mp_num => $mp_num, 
  223             index => $matchpoint->{'index'}, 
  224             score => $matchpoint->{'score'},
  225             components => \@components
  226         };        
  227     }
  228     $template->param(matchpoints => \@matchpoints);
  229 
  230     my $mc_num = 0;
  231     my @matchchecks = ();
  232     foreach my $matchcheck (@{ $matcher_info->{'matchchecks'} }) {
  233         $mc_num++;
  234         my @src_components = _parse_components($matchcheck->{'source_matchpoint'}->{'components'});
  235         my @tgt_components = _parse_components($matchcheck->{'target_matchpoint'}->{'components'});
  236         push @matchchecks, {
  237             mc_num => $mc_num,
  238             src_components => \@src_components,
  239             tgt_components => \@tgt_components
  240         };
  241     }
  242     $template->param(matchchecks => \@matchchecks);
  243 
  244     $template->param(
  245         matching_rule_form => 1,
  246         edit_matching_rule => 1,
  247         confirm_op => 'edit_matching_rule_confirmed',
  248         max_matchpoint => $mp_num,
  249         max_matchcheck => $mc_num
  250     );
  251 
  252 }
  253 
  254 sub _parse_components {
  255     my $components_ref = shift;
  256     my @components = ();
  257 
  258     my $comp_num = 0;
  259     foreach my $component (@{ $components_ref  }) {
  260         $comp_num++;
  261         my $norm_num = 0;
  262         my @norms;
  263         foreach my $norm (@{ $component->{'norms'} }) {
  264             $norm_num++;
  265             push @norms, { norm_num => $norm_num, norm => $norm };
  266         }
  267         push @components, {
  268             comp_num => $comp_num,
  269             tag => $component->{'tag'},
  270             subfields => join("", sort keys %{ $component->{'subfields'} }),
  271             offset => $component->{'offset'},
  272             'length' => $component->{'length'},
  273             norms => \@norms
  274         };
  275     }
  276 
  277     return @components;
  278 }
  279 
  280 sub matching_rule_list {
  281     my $template = shift;
  282     
  283     my @matching_rules = C4::Matcher::GetMatcherList();
  284     $template->param(available_matching_rules => \@matching_rules);
  285     $template->param(display_list => 1);
  286 }