Bug 16912: Koha::Patrons - Move and rewrite tests for AddEnrolmentFeeIfNeeded
[koha.git] / admin / matching-rules.pl
blob20d9f8294251d31768f1d267f8fd221940f0e910
1 #! /usr/bin/perl
3 # Copyright 2007 LibLime
5 # This file is part of Koha.
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.
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.
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>.
21 use strict;
22 use warnings;
24 use CGI qw ( -utf8 );
25 use C4::Auth;
26 use C4::Context;
27 use C4::Output;
28 use C4::Koha;
29 use C4::Matcher qw/valid_normalization_routines/;
31 my $script_name = "/cgi-bin/koha/admin/matching-rules.pl";
33 our $input = new CGI;
34 my $op = $input->param('op') || '';
37 my ($template, $loggedinuser, $cookie)
38 = get_template_and_user({template_name => "admin/matching-rules.tt",
39 query => $input,
40 type => "intranet",
41 authnotrequired => 0,
42 flagsrequired => {parameters => 'parameters_remaining_permissions'},
43 debug => 1,
44 });
46 $template->param(script_name => $script_name);
48 my $matcher_id = $input->param("matcher_id");
50 $template->param( max_matchpoint => 0 );
51 $template->param( max_matchcheck => 0 );
52 my @valid_norms = C4::Matcher::valid_normalization_routines();
53 unshift @valid_norms, 'none';
54 $template->param( valid_norms => \@valid_norms );
56 my $display_list = 0;
57 if ($op eq "edit_matching_rule") {
58 edit_matching_rule_form($template, $matcher_id);
59 } elsif ($op eq "edit_matching_rule_confirmed") {
60 add_update_matching_rule($template, $matcher_id);
61 $display_list = 1;
62 } elsif ($op eq "add_matching_rule") {
63 add_matching_rule_form($template);
64 } elsif ($op eq "add_matching_rule_confirmed") {
65 add_update_matching_rule($template, $matcher_id);
66 $display_list = 1;
67 } elsif ($op eq "delete_matching_rule") {
68 delete_matching_rule_form($template, $matcher_id);
69 } elsif ($op eq "delete_matching_rule_confirmed") {
70 delete_matching_rule($template, $matcher_id);
71 $display_list = 1;
72 } else {
73 $display_list = 1;
76 if ($display_list) {
77 matching_rule_list($template);
80 output_html_with_http_headers $input, $cookie, $template->output;
82 exit 0;
84 sub add_matching_rule_form {
85 my $template = shift;
87 $template->param(
88 matching_rule_form => 1,
89 confirm_op => 'add_matching_rule_confirmed',
90 max_matchpoint => 1,
91 max_matchcheck => 1
96 sub add_update_matching_rule {
97 my $template = shift;
98 my $matcher_id = shift;
99 my $record_type = $input->param('record_type') || 'biblio';
101 # do parsing
102 my $matcher = C4::Matcher->new($record_type, 1000);
103 $matcher->code(scalar $input->param('code'));
104 $matcher->description(scalar $input->param('description'));
105 $matcher->threshold(scalar $input->param('threshold'));
107 # matchpoints
108 my @mp_nums = sort map { /^mp_(\d+)_search_index/ ? int($1): () } $input->multi_param;
109 foreach my $mp_num (@mp_nums) {
110 my $index = $input->param("mp_${mp_num}_search_index");
111 my $score = $input->param("mp_${mp_num}_score");
112 # components
113 my $components = [];
114 my @comp_nums = sort map { /^mp_${mp_num}_c_(\d+)_tag/ ? int($1): () } $input->multi_param;
115 foreach my $comp_num (@comp_nums) {
116 my $component = {};
117 $component->{'tag'} = $input->param("mp_${mp_num}_c_${comp_num}_tag");
118 $component->{'subfields'} = $input->param("mp_${mp_num}_c_${comp_num}_subfields");
119 $component->{'offset'} = $input->param("mp_${mp_num}_c_${comp_num}_offset");
120 $component->{'length'} = $input->param("mp_${mp_num}_c_${comp_num}_length");
121 # norms
122 $component->{'norms'} = [];
123 my @norm_nums = sort map { /^mp_${mp_num}_c_${comp_num}_n_(\d+)_norm/ ? int($1): () } $input->multi_param;
124 foreach my $norm_num (@norm_nums) {
125 push @{ $component->{'norms'} }, $input->multi_param("mp_${mp_num}_c_${comp_num}_n_${norm_num}_norm");
127 push @$components, $component;
129 $matcher->add_matchpoint($index, $score, $components);
132 # match checks
133 my @mc_nums = sort map { /^mc_(\d+)_id/ ? int($1): () } $input->multi_param;
134 foreach my $mc_num (@mc_nums) {
135 # source components
136 my $src_components = [];
137 my @src_comp_nums = sort map { /^mc_${mc_num}_src_c_(\d+)_tag/ ? int($1): () } $input->multi_param;
138 foreach my $comp_num (@src_comp_nums) {
139 my $component = {};
140 $component->{'tag'} = $input->param("mc_${mc_num}_src_c_${comp_num}_tag");
141 $component->{'subfields'} = $input->param("mc_${mc_num}_src_c_${comp_num}_subfields");
142 $component->{'offset'} = $input->param("mc_${mc_num}_src_c_${comp_num}_offset");
143 $component->{'length'} = $input->param("mc_${mc_num}_src_c_${comp_num}_length");
144 # norms
145 $component->{'norms'} = [];
146 my @norm_nums = sort map { /^mc_${mc_num}_src_c_${comp_num}_n_(\d+)_norm/ ? int($1): () } $input->multi_param;
147 foreach my $norm_num (@norm_nums) {
148 push @{ $component->{'norms'} }, $input->multi_param("mc_${mc_num}_src_c_${comp_num}_n_${norm_num}_norm");
150 push @$src_components, $component;
152 # target components
153 my $tgt_components = [];
154 my @tgt_comp_nums = sort map { /^mc_${mc_num}_tgt_c_(\d+)_tag/ ? int($1): () } $input->multi_param;
155 foreach my $comp_num (@tgt_comp_nums) {
156 my $component = {};
157 $component->{'tag'} = $input->param("mc_${mc_num}_tgt_c_${comp_num}_tag");
158 $component->{'subfields'} = $input->param("mc_${mc_num}_tgt_c_${comp_num}_subfields");
159 $component->{'offset'} = $input->param("mc_${mc_num}_tgt_c_${comp_num}_offset");
160 $component->{'length'} = $input->param("mc_${mc_num}_tgt_c_${comp_num}_length");
161 # norms
162 $component->{'norms'} = [];
163 my @norm_nums = sort map { /^mc_${mc_num}_tgt_c_${comp_num}_n_(\d+)_norm/ ? int($1): () } $input->multi_param;
164 foreach my $norm_num (@norm_nums) {
165 push @{ $component->{'norms'} }, $input->multi_param("mc_${mc_num}_tgt_c_${comp_num}_n_${norm_num}_norm");
167 push @$tgt_components, $component;
169 $matcher->add_required_check($src_components, $tgt_components);
172 if (defined $matcher_id and $matcher_id =~ /^\d+/) {
173 $matcher->_id($matcher_id);
174 $template->param(edited_matching_rule => $matcher->code());
175 } else {
176 $template->param(added_matching_rule => $matcher->code());
178 $matcher_id = $matcher->store();
181 sub delete_matching_rule_form {
182 my $template = shift;
183 my $matcher_id = shift;
185 my $matcher = C4::Matcher->fetch($matcher_id);
186 $template->param(
187 delete_matching_rule_form => 1,
188 confirm_op => "delete_matching_rule_confirmed",
189 matcher_id => $matcher_id,
190 code => $matcher->code(),
191 description => $matcher->description(),
195 sub delete_matching_rule {
196 my $template = shift;
197 my $matcher_id = shift;
199 my $matcher = C4::Matcher->fetch($matcher_id);
200 $template->param(deleted_matching_rule => $matcher->code(),
202 C4::Matcher->delete($matcher_id);
205 sub edit_matching_rule_form {
206 my $template = shift;
207 my $matcher_id = shift;
209 my $matcher = C4::Matcher->fetch($matcher_id);
211 $template->{VARS}->{'matcher_id'} = $matcher_id;
212 $template->{VARS}->{'code'} = $matcher->code();
213 $template->{VARS}->{'description'} = $matcher->description();
214 $template->{VARS}->{'threshold'} = $matcher->threshold();
215 $template->{VARS}->{'record_type'} = $matcher->record_type();
217 my $matcher_info = $matcher->dump();
218 my @matchpoints = ();
219 my $mp_num = 0;
220 foreach my $matchpoint (@{ $matcher_info->{'matchpoints'} }) {
221 $mp_num++;
222 my @components = _parse_components($matchpoint->{'components'});
223 push @matchpoints, {
224 mp_num => $mp_num,
225 index => $matchpoint->{'index'},
226 score => $matchpoint->{'score'},
227 components => \@components
230 $template->param(matchpoints => \@matchpoints);
232 my $mc_num = 0;
233 my @matchchecks = ();
234 foreach my $matchcheck (@{ $matcher_info->{'matchchecks'} }) {
235 $mc_num++;
236 my @src_components = _parse_components($matchcheck->{'source_matchpoint'}->{'components'});
237 my @tgt_components = _parse_components($matchcheck->{'target_matchpoint'}->{'components'});
238 push @matchchecks, {
239 mc_num => $mc_num,
240 src_components => \@src_components,
241 tgt_components => \@tgt_components
244 $template->param(matchchecks => \@matchchecks);
246 $template->param(
247 matching_rule_form => 1,
248 edit_matching_rule => 1,
249 confirm_op => 'edit_matching_rule_confirmed',
250 max_matchpoint => $mp_num,
251 max_matchcheck => $mc_num
256 sub _parse_components {
257 my $components_ref = shift;
258 my @components = ();
260 my $comp_num = 0;
261 foreach my $component (@{ $components_ref }) {
262 $comp_num++;
263 my $norm_num = 0;
264 my @norms;
265 foreach my $norm (@{ $component->{'norms'} }) {
266 $norm_num++;
267 push @norms, { norm_num => $norm_num, norm => $norm };
269 push @components, {
270 comp_num => $comp_num,
271 tag => $component->{'tag'},
272 subfields => join("", sort keys %{ $component->{'subfields'} }),
273 offset => $component->{'offset'},
274 'length' => $component->{'length'},
275 norms => \@norms
279 return @components;
282 sub matching_rule_list {
283 my $template = shift;
285 my @matching_rules = C4::Matcher::GetMatcherList();
286 $template->param(available_matching_rules => \@matching_rules);
287 $template->param(display_list => 1);