|
Lines 27-33
use vars qw($VERSION);
Link Here
|
| 27 |
|
27 |
|
| 28 |
BEGIN { |
28 |
BEGIN { |
| 29 |
# set the version for version checking |
29 |
# set the version for version checking |
| 30 |
$VERSION = 3.07.00.049; |
30 |
$VERSION = 3.07.00.049; |
| 31 |
} |
31 |
} |
| 32 |
|
32 |
|
| 33 |
=head1 NAME |
33 |
=head1 NAME |
|
Lines 49-64
C4::Matcher - find MARC records matching another one
Link Here
|
| 49 |
|
49 |
|
| 50 |
$matcher->add_simple_required_check('245', 'a', -1, 0, '', '245', 'a', -1, 0, ''); |
50 |
$matcher->add_simple_required_check('245', 'a', -1, 0, '', '245', 'a', -1, 0, ''); |
| 51 |
$matcher->add_required_check([ { tag => '245', subfields => 'a', norms => [] } ], |
51 |
$matcher->add_required_check([ { tag => '245', subfields => 'a', norms => [] } ], |
| 52 |
[ { tag => '245', subfields => 'a', norms => [] } ]); |
52 |
[ { tag => '245', subfields => 'a', norms => [] } ]); |
| 53 |
|
53 |
|
| 54 |
my @matches = $matcher->get_matches($marc_record, $max_matches); |
54 |
my @matches = $matcher->get_matches($marc_record, $max_matches); |
| 55 |
|
55 |
|
| 56 |
foreach $match (@matches) { |
56 |
foreach $match (@matches) { |
| 57 |
|
57 |
|
| 58 |
# matches already sorted in order of |
58 |
# matches already sorted in order of |
| 59 |
# decreasing score |
59 |
# decreasing score |
| 60 |
print "record ID: $match->{'record_id'}; |
60 |
print "record ID: $match->{'record_id'}; |
| 61 |
print "score: $match->{'score'}; |
61 |
print "score: $match->{'score'}; |
| 62 |
|
62 |
|
| 63 |
} |
63 |
} |
| 64 |
|
64 |
|
|
Lines 82-96
present in the database. Each hashref includes:
Link Here
|
| 82 |
=cut |
82 |
=cut |
| 83 |
|
83 |
|
| 84 |
sub GetMatcherList { |
84 |
sub GetMatcherList { |
| 85 |
my $dbh = C4::Context->dbh; |
85 |
my $dbh = C4::Context->dbh; |
| 86 |
|
86 |
|
| 87 |
my $sth = $dbh->prepare_cached("SELECT matcher_id, code, description FROM marc_matchers ORDER BY matcher_id"); |
87 |
my $sth = $dbh->prepare_cached("SELECT matcher_id, code, description FROM marc_matchers ORDER BY matcher_id"); |
| 88 |
$sth->execute(); |
88 |
$sth->execute(); |
| 89 |
my @results = (); |
89 |
my @results = (); |
| 90 |
while (my $row = $sth->fetchrow_hashref) { |
90 |
while (my $row = $sth->fetchrow_hashref) { |
| 91 |
push @results, $row; |
91 |
push @results, $row; |
| 92 |
} |
92 |
} |
| 93 |
return @results; |
93 |
return @results; |
| 94 |
} |
94 |
} |
| 95 |
|
95 |
|
| 96 |
=head2 GetMatcherId |
96 |
=head2 GetMatcherId |
|
Lines 102-112
Returns the matcher_id of a code.
Link Here
|
| 102 |
=cut |
102 |
=cut |
| 103 |
|
103 |
|
| 104 |
sub GetMatcherId { |
104 |
sub GetMatcherId { |
| 105 |
my ($code) = @_; |
105 |
my ($code) = @_; |
| 106 |
my $dbh = C4::Context->dbh; |
106 |
my $dbh = C4::Context->dbh; |
| 107 |
|
107 |
|
| 108 |
my $matcher_id = $dbh->selectrow_array("SELECT matcher_id FROM marc_matchers WHERE code = ?", undef, $code); |
108 |
my $matcher_id = $dbh->selectrow_array("SELECT matcher_id FROM marc_matchers WHERE code = ?", undef, $code); |
| 109 |
return $matcher_id; |
109 |
return $matcher_id; |
| 110 |
} |
110 |
} |
| 111 |
|
111 |
|
| 112 |
=head1 METHODS |
112 |
=head1 METHODS |
|
Lines 123-153
and defaults to 1000.
Link Here
|
| 123 |
=cut |
123 |
=cut |
| 124 |
|
124 |
|
| 125 |
sub new { |
125 |
sub new { |
| 126 |
my $class = shift; |
126 |
my $class = shift; |
| 127 |
my $self = {}; |
127 |
my $self = {}; |
| 128 |
|
128 |
|
| 129 |
$self->{'id'} = undef; |
129 |
$self->{'id'} = undef; |
| 130 |
|
130 |
|
| 131 |
if ($#_ > -1) { |
131 |
if ($#_ > -1) { |
| 132 |
$self->{'record_type'} = shift; |
132 |
$self->{'record_type'} = shift; |
| 133 |
} else { |
133 |
} else { |
| 134 |
$self->{'record_type'} = 'biblio'; |
134 |
$self->{'record_type'} = 'biblio'; |
| 135 |
} |
135 |
} |
| 136 |
|
136 |
|
| 137 |
if ($#_ > -1) { |
137 |
if ($#_ > -1) { |
| 138 |
$self->{'threshold'} = shift; |
138 |
$self->{'threshold'} = shift; |
| 139 |
} else { |
139 |
} else { |
| 140 |
$self->{'threshold'} = 1000; |
140 |
$self->{'threshold'} = 1000; |
| 141 |
} |
141 |
} |
| 142 |
|
142 |
|
| 143 |
$self->{'code'} = ''; |
143 |
$self->{'code'} = ''; |
| 144 |
$self->{'description'} = ''; |
144 |
$self->{'description'} = ''; |
| 145 |
|
145 |
|
| 146 |
$self->{'matchpoints'} = []; |
146 |
$self->{'matchpoints'} = []; |
| 147 |
$self->{'required_checks'} = []; |
147 |
$self->{'required_checks'} = []; |
| 148 |
|
148 |
|
| 149 |
bless $self, $class; |
149 |
bless $self, $class; |
| 150 |
return $self; |
150 |
return $self; |
| 151 |
} |
151 |
} |
| 152 |
|
152 |
|
| 153 |
=head2 fetch |
153 |
=head2 fetch |
|
Lines 161-242
id does not exist, returns undef.
Link Here
|
| 161 |
=cut |
161 |
=cut |
| 162 |
|
162 |
|
| 163 |
sub fetch { |
163 |
sub fetch { |
| 164 |
my $class = shift; |
164 |
my $class = shift; |
| 165 |
my $id = shift; |
165 |
my $id = shift; |
| 166 |
my $dbh = C4::Context->dbh(); |
166 |
my $dbh = C4::Context->dbh(); |
| 167 |
|
167 |
|
| 168 |
my $sth = $dbh->prepare_cached("SELECT * FROM marc_matchers WHERE matcher_id = ?"); |
168 |
my $sth = $dbh->prepare_cached("SELECT * FROM marc_matchers WHERE matcher_id = ?"); |
| 169 |
$sth->execute($id); |
169 |
$sth->execute($id); |
| 170 |
my $row = $sth->fetchrow_hashref; |
170 |
my $row = $sth->fetchrow_hashref; |
| 171 |
$sth->finish(); |
171 |
$sth->finish(); |
| 172 |
return undef unless defined $row; |
172 |
return undef unless defined $row; |
| 173 |
|
173 |
|
| 174 |
my $self = {}; |
174 |
my $self = {}; |
| 175 |
$self->{'id'} = $row->{'matcher_id'}; |
175 |
$self->{'id'} = $row->{'matcher_id'}; |
| 176 |
$self->{'record_type'} = $row->{'record_type'}; |
176 |
$self->{'record_type'} = $row->{'record_type'}; |
| 177 |
$self->{'code'} = $row->{'code'}; |
177 |
$self->{'code'} = $row->{'code'}; |
| 178 |
$self->{'description'} = $row->{'description'}; |
178 |
$self->{'description'} = $row->{'description'}; |
| 179 |
$self->{'threshold'} = int($row->{'threshold'}); |
179 |
$self->{'threshold'} = int($row->{'threshold'}); |
| 180 |
bless $self, $class; |
180 |
bless $self, $class; |
| 181 |
|
181 |
|
| 182 |
# matchpoints |
182 |
# matchpoints |
| 183 |
$self->{'matchpoints'} = []; |
183 |
$self->{'matchpoints'} = []; |
| 184 |
$sth = $dbh->prepare_cached("SELECT * FROM matcher_matchpoints WHERE matcher_id = ? ORDER BY matchpoint_id"); |
184 |
$sth = $dbh->prepare_cached("SELECT * FROM matcher_matchpoints WHERE matcher_id = ? ORDER BY matchpoint_id"); |
| 185 |
$sth->execute($self->{'id'}); |
185 |
$sth->execute($self->{'id'}); |
| 186 |
while (my $row = $sth->fetchrow_hashref) { |
186 |
while (my $row = $sth->fetchrow_hashref) { |
| 187 |
my $matchpoint = $self->_fetch_matchpoint($row->{'matchpoint_id'}); |
187 |
my $matchpoint = $self->_fetch_matchpoint($row->{'matchpoint_id'}); |
| 188 |
push @{ $self->{'matchpoints'} }, $matchpoint; |
188 |
push @{ $self->{'matchpoints'} }, $matchpoint; |
| 189 |
} |
189 |
} |
| 190 |
|
190 |
|
| 191 |
# required checks |
191 |
# required checks |
| 192 |
$self->{'required_checks'} = []; |
192 |
$self->{'required_checks'} = []; |
| 193 |
$sth = $dbh->prepare_cached("SELECT * FROM matchchecks WHERE matcher_id = ? ORDER BY matchcheck_id"); |
193 |
$sth = $dbh->prepare_cached("SELECT * FROM matchchecks WHERE matcher_id = ? ORDER BY matchcheck_id"); |
| 194 |
$sth->execute($self->{'id'}); |
194 |
$sth->execute($self->{'id'}); |
| 195 |
while (my $row = $sth->fetchrow_hashref) { |
195 |
while (my $row = $sth->fetchrow_hashref) { |
| 196 |
my $source_matchpoint = $self->_fetch_matchpoint($row->{'source_matchpoint_id'}); |
196 |
my $source_matchpoint = $self->_fetch_matchpoint($row->{'source_matchpoint_id'}); |
| 197 |
my $target_matchpoint = $self->_fetch_matchpoint($row->{'target_matchpoint_id'}); |
197 |
my $target_matchpoint = $self->_fetch_matchpoint($row->{'target_matchpoint_id'}); |
| 198 |
my $matchcheck = {}; |
198 |
my $matchcheck = {}; |
| 199 |
$matchcheck->{'source_matchpoint'} = $source_matchpoint; |
199 |
$matchcheck->{'source_matchpoint'} = $source_matchpoint; |
| 200 |
$matchcheck->{'target_matchpoint'} = $target_matchpoint; |
200 |
$matchcheck->{'target_matchpoint'} = $target_matchpoint; |
| 201 |
push @{ $self->{'required_checks'} }, $matchcheck; |
201 |
push @{ $self->{'required_checks'} }, $matchcheck; |
| 202 |
} |
202 |
} |
| 203 |
|
203 |
|
| 204 |
return $self; |
204 |
return $self; |
| 205 |
} |
205 |
} |
| 206 |
|
206 |
|
| 207 |
sub _fetch_matchpoint { |
207 |
sub _fetch_matchpoint { |
| 208 |
my $self = shift; |
208 |
my $self = shift; |
| 209 |
my $matchpoint_id = shift; |
209 |
my $matchpoint_id = shift; |
| 210 |
|
210 |
|
| 211 |
my $dbh = C4::Context->dbh; |
211 |
my $dbh = C4::Context->dbh; |
| 212 |
my $sth = $dbh->prepare_cached("SELECT * FROM matchpoints WHERE matchpoint_id = ?"); |
212 |
my $sth = $dbh->prepare_cached("SELECT * FROM matchpoints WHERE matchpoint_id = ?"); |
| 213 |
$sth->execute($matchpoint_id); |
213 |
$sth->execute($matchpoint_id); |
| 214 |
my $row = $sth->fetchrow_hashref; |
214 |
my $row = $sth->fetchrow_hashref; |
| 215 |
my $matchpoint = {}; |
215 |
my $matchpoint = {}; |
| 216 |
$matchpoint->{'index'} = $row->{'search_index'}; |
216 |
$matchpoint->{'index'} = $row->{'search_index'}; |
| 217 |
$matchpoint->{'score'} = int($row->{'score'}); |
217 |
$matchpoint->{'score'} = int($row->{'score'}); |
| 218 |
$sth->finish(); |
218 |
$sth->finish(); |
| 219 |
|
219 |
|
| 220 |
$matchpoint->{'components'} = []; |
220 |
$matchpoint->{'components'} = []; |
| 221 |
$sth = $dbh->prepare_cached("SELECT * FROM matchpoint_components WHERE matchpoint_id = ? ORDER BY sequence"); |
221 |
$sth = $dbh->prepare_cached("SELECT * FROM matchpoint_components WHERE matchpoint_id = ? ORDER BY sequence"); |
| 222 |
$sth->execute($matchpoint_id); |
222 |
$sth->execute($matchpoint_id); |
| 223 |
while ($row = $sth->fetchrow_hashref) { |
223 |
while ($row = $sth->fetchrow_hashref) { |
| 224 |
my $component = {}; |
224 |
my $component = {}; |
| 225 |
$component->{'tag'} = $row->{'tag'}; |
225 |
$component->{'tag'} = $row->{'tag'}; |
| 226 |
$component->{'subfields'} = { map { $_ => 1 } split(//, $row->{'subfields'}) }; |
226 |
$component->{'subfields'} = { map { $_ => 1 } split(//, $row->{'subfields'}) }; |
| 227 |
$component->{'offset'} = int($row->{'offset'}); |
227 |
$component->{'offset'} = int($row->{'offset'}); |
| 228 |
$component->{'length'} = int($row->{'length'}); |
228 |
$component->{'length'} = int($row->{'length'}); |
| 229 |
$component->{'norms'} = []; |
229 |
$component->{'norms'} = []; |
| 230 |
my $sth2 = $dbh->prepare_cached("SELECT * |
230 |
my $sth2 = $dbh->prepare_cached("SELECT * |
| 231 |
FROM matchpoint_component_norms |
231 |
FROM matchpoint_component_norms |
| 232 |
WHERE matchpoint_component_id = ? ORDER BY sequence"); |
232 |
WHERE matchpoint_component_id = ? ORDER BY sequence"); |
| 233 |
$sth2->execute($row->{'matchpoint_component_id'}); |
233 |
$sth2->execute($row->{'matchpoint_component_id'}); |
| 234 |
while (my $row2 = $sth2->fetchrow_hashref) { |
234 |
while (my $row2 = $sth2->fetchrow_hashref) { |
| 235 |
push @{ $component->{'norms'} }, $row2->{'norm_routine'}; |
235 |
push @{ $component->{'norms'} }, $row2->{'norm_routine'}; |
| 236 |
} |
236 |
} |
| 237 |
push @{ $matchpoint->{'components'} }, $component; |
237 |
push @{ $matchpoint->{'components'} }, $component; |
| 238 |
} |
238 |
} |
| 239 |
return $matchpoint; |
239 |
return $matchpoint; |
| 240 |
} |
240 |
} |
| 241 |
|
241 |
|
| 242 |
=head2 store |
242 |
=head2 store |
|
Lines 252-366
is replaced.
Link Here
|
| 252 |
=cut |
252 |
=cut |
| 253 |
|
253 |
|
| 254 |
sub store { |
254 |
sub store { |
| 255 |
my $self = shift; |
255 |
my $self = shift; |
| 256 |
|
256 |
|
| 257 |
if (defined $self->{'id'}) { |
257 |
if (defined $self->{'id'}) { |
| 258 |
# update |
258 |
# update |
| 259 |
$self->_del_matcher_components(); |
259 |
$self->_del_matcher_components(); |
| 260 |
$self->_update_marc_matchers(); |
260 |
$self->_update_marc_matchers(); |
| 261 |
} else { |
261 |
} else { |
| 262 |
# create new |
262 |
# create new |
| 263 |
$self->_new_marc_matchers(); |
263 |
$self->_new_marc_matchers(); |
| 264 |
} |
264 |
} |
| 265 |
$self->_store_matcher_components(); |
265 |
$self->_store_matcher_components(); |
| 266 |
return $self->{'id'}; |
266 |
return $self->{'id'}; |
| 267 |
} |
267 |
} |
| 268 |
|
268 |
|
| 269 |
sub _del_matcher_components { |
269 |
sub _del_matcher_components { |
| 270 |
my $self = shift; |
270 |
my $self = shift; |
| 271 |
|
271 |
|
| 272 |
my $dbh = C4::Context->dbh(); |
272 |
my $dbh = C4::Context->dbh(); |
| 273 |
my $sth = $dbh->prepare_cached("DELETE FROM matchpoints WHERE matcher_id = ?"); |
273 |
my $sth = $dbh->prepare_cached("DELETE FROM matchpoints WHERE matcher_id = ?"); |
| 274 |
$sth->execute($self->{'id'}); |
274 |
$sth->execute($self->{'id'}); |
| 275 |
$sth = $dbh->prepare_cached("DELETE FROM matchchecks WHERE matcher_id = ?"); |
275 |
$sth = $dbh->prepare_cached("DELETE FROM matchchecks WHERE matcher_id = ?"); |
| 276 |
$sth->execute($self->{'id'}); |
276 |
$sth->execute($self->{'id'}); |
| 277 |
# foreign key delete cascades take care of deleting relevant rows |
277 |
# foreign key delete cascades take care of deleting relevant rows |
| 278 |
# from matcher_matchpoints, matchpoint_components, and |
278 |
# from matcher_matchpoints, matchpoint_components, and |
| 279 |
# matchpoint_component_norms |
279 |
# matchpoint_component_norms |
| 280 |
} |
280 |
} |
| 281 |
|
281 |
|
| 282 |
sub _update_marc_matchers { |
282 |
sub _update_marc_matchers { |
| 283 |
my $self = shift; |
283 |
my $self = shift; |
| 284 |
|
284 |
|
| 285 |
my $dbh = C4::Context->dbh(); |
285 |
my $dbh = C4::Context->dbh(); |
| 286 |
my $sth = $dbh->prepare_cached("UPDATE marc_matchers |
286 |
my $sth = $dbh->prepare_cached("UPDATE marc_matchers |
| 287 |
SET code = ?, |
287 |
SET code = ?, |
| 288 |
description = ?, |
288 |
description = ?, |
| 289 |
record_type = ?, |
289 |
record_type = ?, |
| 290 |
threshold = ? |
290 |
threshold = ? |
| 291 |
WHERE matcher_id = ?"); |
291 |
WHERE matcher_id = ?"); |
| 292 |
$sth->execute($self->{'code'}, $self->{'description'}, $self->{'record_type'}, $self->{'threshold'}, $self->{'id'}); |
292 |
$sth->execute($self->{'code'}, $self->{'description'}, $self->{'record_type'}, $self->{'threshold'}, $self->{'id'}); |
| 293 |
} |
293 |
} |
| 294 |
|
294 |
|
| 295 |
sub _new_marc_matchers { |
295 |
sub _new_marc_matchers { |
| 296 |
my $self = shift; |
296 |
my $self = shift; |
| 297 |
|
297 |
|
| 298 |
my $dbh = C4::Context->dbh(); |
298 |
my $dbh = C4::Context->dbh(); |
| 299 |
my $sth = $dbh->prepare_cached("INSERT INTO marc_matchers |
299 |
my $sth = $dbh->prepare_cached("INSERT INTO marc_matchers |
| 300 |
(code, description, record_type, threshold) |
300 |
(code, description, record_type, threshold) |
| 301 |
VALUES (?, ?, ?, ?)"); |
301 |
VALUES (?, ?, ?, ?)"); |
| 302 |
$sth->execute($self->{'code'}, $self->{'description'}, $self->{'record_type'}, $self->{'threshold'}); |
302 |
$sth->execute($self->{'code'}, $self->{'description'}, $self->{'record_type'}, $self->{'threshold'}); |
| 303 |
$self->{'id'} = $dbh->{'mysql_insertid'}; |
303 |
$self->{'id'} = $dbh->{'mysql_insertid'}; |
| 304 |
} |
304 |
} |
| 305 |
|
305 |
|
| 306 |
sub _store_matcher_components { |
306 |
sub _store_matcher_components { |
| 307 |
my $self = shift; |
307 |
my $self = shift; |
| 308 |
|
308 |
|
| 309 |
my $dbh = C4::Context->dbh(); |
309 |
my $dbh = C4::Context->dbh(); |
| 310 |
my $sth; |
310 |
my $sth; |
| 311 |
my $matcher_id = $self->{'id'}; |
311 |
my $matcher_id = $self->{'id'}; |
| 312 |
foreach my $matchpoint (@{ $self->{'matchpoints'}}) { |
312 |
foreach my $matchpoint (@{ $self->{'matchpoints'}}) { |
| 313 |
my $matchpoint_id = $self->_store_matchpoint($matchpoint); |
313 |
my $matchpoint_id = $self->_store_matchpoint($matchpoint); |
| 314 |
$sth = $dbh->prepare_cached("INSERT INTO matcher_matchpoints (matcher_id, matchpoint_id) |
314 |
$sth = $dbh->prepare_cached("INSERT INTO matcher_matchpoints (matcher_id, matchpoint_id) |
| 315 |
VALUES (?, ?)"); |
315 |
VALUES (?, ?)"); |
| 316 |
$sth->execute($matcher_id, $matchpoint_id); |
316 |
$sth->execute($matcher_id, $matchpoint_id); |
| 317 |
} |
317 |
} |
| 318 |
foreach my $matchcheck (@{ $self->{'required_checks'} }) { |
318 |
foreach my $matchcheck (@{ $self->{'required_checks'} }) { |
| 319 |
my $source_matchpoint_id = $self->_store_matchpoint($matchcheck->{'source_matchpoint'}); |
319 |
my $source_matchpoint_id = $self->_store_matchpoint($matchcheck->{'source_matchpoint'}); |
| 320 |
my $target_matchpoint_id = $self->_store_matchpoint($matchcheck->{'target_matchpoint'}); |
320 |
my $target_matchpoint_id = $self->_store_matchpoint($matchcheck->{'target_matchpoint'}); |
| 321 |
$sth = $dbh->prepare_cached("INSERT INTO matchchecks |
321 |
$sth = $dbh->prepare_cached("INSERT INTO matchchecks |
| 322 |
(matcher_id, source_matchpoint_id, target_matchpoint_id) |
322 |
(matcher_id, source_matchpoint_id, target_matchpoint_id) |
| 323 |
VALUES (?, ?, ?)"); |
323 |
VALUES (?, ?, ?)"); |
| 324 |
$sth->execute($matcher_id, $source_matchpoint_id, $target_matchpoint_id); |
324 |
$sth->execute($matcher_id, $source_matchpoint_id, $target_matchpoint_id); |
| 325 |
} |
325 |
} |
| 326 |
|
326 |
|
| 327 |
} |
327 |
} |
| 328 |
|
328 |
|
| 329 |
sub _store_matchpoint { |
329 |
sub _store_matchpoint { |
| 330 |
my $self = shift; |
330 |
my $self = shift; |
| 331 |
my $matchpoint = shift; |
331 |
my $matchpoint = shift; |
| 332 |
|
332 |
|
| 333 |
my $dbh = C4::Context->dbh(); |
333 |
my $dbh = C4::Context->dbh(); |
| 334 |
my $sth; |
334 |
my $sth; |
| 335 |
my $matcher_id = $self->{'id'}; |
335 |
my $matcher_id = $self->{'id'}; |
| 336 |
$sth = $dbh->prepare_cached("INSERT INTO matchpoints (matcher_id, search_index, score) |
336 |
$sth = $dbh->prepare_cached("INSERT INTO matchpoints (matcher_id, search_index, score) |
| 337 |
VALUES (?, ?, ?)"); |
337 |
VALUES (?, ?, ?)"); |
| 338 |
$sth->execute($matcher_id, $matchpoint->{'index'}, $matchpoint->{'score'}); |
338 |
$sth->execute($matcher_id, $matchpoint->{'index'}, $matchpoint->{'score'}); |
| 339 |
my $matchpoint_id = $dbh->{'mysql_insertid'}; |
339 |
my $matchpoint_id = $dbh->{'mysql_insertid'}; |
| 340 |
my $seqnum = 0; |
340 |
my $seqnum = 0; |
| 341 |
foreach my $component (@{ $matchpoint->{'components'} }) { |
341 |
foreach my $component (@{ $matchpoint->{'components'} }) { |
| 342 |
$seqnum++; |
342 |
$seqnum++; |
| 343 |
$sth = $dbh->prepare_cached("INSERT INTO matchpoint_components |
343 |
$sth = $dbh->prepare_cached("INSERT INTO matchpoint_components |
| 344 |
(matchpoint_id, sequence, tag, subfields, offset, length) |
344 |
(matchpoint_id, sequence, tag, subfields, offset, length) |
| 345 |
VALUES (?, ?, ?, ?, ?, ?)"); |
345 |
VALUES (?, ?, ?, ?, ?, ?)"); |
| 346 |
$sth->bind_param(1, $matchpoint_id); |
346 |
$sth->bind_param(1, $matchpoint_id); |
| 347 |
$sth->bind_param(2, $seqnum); |
347 |
$sth->bind_param(2, $seqnum); |
| 348 |
$sth->bind_param(3, $component->{'tag'}); |
348 |
$sth->bind_param(3, $component->{'tag'}); |
| 349 |
$sth->bind_param(4, join "", sort keys %{ $component->{'subfields'} }); |
349 |
$sth->bind_param(4, join "", sort keys %{ $component->{'subfields'} }); |
| 350 |
$sth->bind_param(5, $component->{'offset'}); |
350 |
$sth->bind_param(5, $component->{'offset'}); |
| 351 |
$sth->bind_param(6, $component->{'length'}); |
351 |
$sth->bind_param(6, $component->{'length'}); |
| 352 |
$sth->execute(); |
352 |
$sth->execute(); |
| 353 |
my $matchpoint_component_id = $dbh->{'mysql_insertid'}; |
353 |
my $matchpoint_component_id = $dbh->{'mysql_insertid'}; |
| 354 |
my $normseq = 0; |
354 |
my $normseq = 0; |
| 355 |
foreach my $norm (@{ $component->{'norms'} }) { |
355 |
foreach my $norm (@{ $component->{'norms'} }) { |
| 356 |
$normseq++; |
356 |
$normseq++; |
| 357 |
$sth = $dbh->prepare_cached("INSERT INTO matchpoint_component_norms |
357 |
$sth = $dbh->prepare_cached("INSERT INTO matchpoint_component_norms |
| 358 |
(matchpoint_component_id, sequence, norm_routine) |
358 |
(matchpoint_component_id, sequence, norm_routine) |
| 359 |
VALUES (?, ?, ?)"); |
359 |
VALUES (?, ?, ?)"); |
| 360 |
$sth->execute($matchpoint_component_id, $normseq, $norm); |
360 |
$sth->execute($matchpoint_component_id, $normseq, $norm); |
| 361 |
} |
361 |
} |
| 362 |
} |
362 |
} |
| 363 |
return $matchpoint_id; |
363 |
return $matchpoint_id; |
| 364 |
} |
364 |
} |
| 365 |
|
365 |
|
| 366 |
|
366 |
|
|
Lines 374-385
from the database.
Link Here
|
| 374 |
=cut |
374 |
=cut |
| 375 |
|
375 |
|
| 376 |
sub delete { |
376 |
sub delete { |
| 377 |
my $class = shift; |
377 |
my $class = shift; |
| 378 |
my $matcher_id = shift; |
378 |
my $matcher_id = shift; |
| 379 |
|
379 |
|
| 380 |
my $dbh = C4::Context->dbh; |
380 |
my $dbh = C4::Context->dbh; |
| 381 |
my $sth = $dbh->prepare("DELETE FROM marc_matchers WHERE matcher_id = ?"); |
381 |
my $sth = $dbh->prepare("DELETE FROM marc_matchers WHERE matcher_id = ?"); |
| 382 |
$sth->execute($matcher_id); # relying on cascading deletes to clean up everything |
382 |
$sth->execute($matcher_id); # relying on cascading deletes to clean up everything |
| 383 |
} |
383 |
} |
| 384 |
|
384 |
|
| 385 |
=head2 record_type |
385 |
=head2 record_type |
|
Lines 392-399
Accessor method.
Link Here
|
| 392 |
=cut |
392 |
=cut |
| 393 |
|
393 |
|
| 394 |
sub record_type { |
394 |
sub record_type { |
| 395 |
my $self = shift; |
395 |
my $self = shift; |
| 396 |
@_ ? $self->{'record_type'} = shift : $self->{'record_type'}; |
396 |
@_ ? $self->{'record_type'} = shift : $self->{'record_type'}; |
| 397 |
} |
397 |
} |
| 398 |
|
398 |
|
| 399 |
=head2 threshold |
399 |
=head2 threshold |
|
Lines 406-413
Accessor method.
Link Here
|
| 406 |
=cut |
406 |
=cut |
| 407 |
|
407 |
|
| 408 |
sub threshold { |
408 |
sub threshold { |
| 409 |
my $self = shift; |
409 |
my $self = shift; |
| 410 |
@_ ? $self->{'threshold'} = shift : $self->{'threshold'}; |
410 |
@_ ? $self->{'threshold'} = shift : $self->{'threshold'}; |
| 411 |
} |
411 |
} |
| 412 |
|
412 |
|
| 413 |
=head2 _id |
413 |
=head2 _id |
|
Lines 422-429
done outside of the editing CGI.
Link Here
|
| 422 |
=cut |
422 |
=cut |
| 423 |
|
423 |
|
| 424 |
sub _id { |
424 |
sub _id { |
| 425 |
my $self = shift; |
425 |
my $self = shift; |
| 426 |
@_ ? $self->{'id'} = shift : $self->{'id'}; |
426 |
@_ ? $self->{'id'} = shift : $self->{'id'}; |
| 427 |
} |
427 |
} |
| 428 |
|
428 |
|
| 429 |
=head2 code |
429 |
=head2 code |
|
Lines 436-443
Accessor method.
Link Here
|
| 436 |
=cut |
436 |
=cut |
| 437 |
|
437 |
|
| 438 |
sub code { |
438 |
sub code { |
| 439 |
my $self = shift; |
439 |
my $self = shift; |
| 440 |
@_ ? $self->{'code'} = shift : $self->{'code'}; |
440 |
@_ ? $self->{'code'} = shift : $self->{'code'}; |
| 441 |
} |
441 |
} |
| 442 |
|
442 |
|
| 443 |
=head2 description |
443 |
=head2 description |
|
Lines 450-457
Accessor method.
Link Here
|
| 450 |
=cut |
450 |
=cut |
| 451 |
|
451 |
|
| 452 |
sub description { |
452 |
sub description { |
| 453 |
my $self = shift; |
453 |
my $self = shift; |
| 454 |
@_ ? $self->{'description'} = shift : $self->{'description'}; |
454 |
@_ ? $self->{'description'} = shift : $self->{'description'}; |
| 455 |
} |
455 |
} |
| 456 |
|
456 |
|
| 457 |
=head2 add_matchpoint |
457 |
=head2 add_matchpoint |
|
Lines 465-475
is the weight that will be added if a match is found.
Link Here
|
| 465 |
$matchcomponents should be a reference to an array of matchpoint |
465 |
$matchcomponents should be a reference to an array of matchpoint |
| 466 |
compoents, each of which should be a hash containing the following |
466 |
compoents, each of which should be a hash containing the following |
| 467 |
keys: |
467 |
keys: |
| 468 |
tag |
468 |
tag |
| 469 |
subfields |
469 |
subfields |
| 470 |
offset |
470 |
offset |
| 471 |
length |
471 |
length |
| 472 |
norms |
472 |
norms |
| 473 |
|
473 |
|
| 474 |
The normalization_rules value should in turn be a reference to an |
474 |
The normalization_rules value should in turn be a reference to an |
| 475 |
array, each element of which should be a reference to a |
475 |
array, each element of which should be a reference to a |
|
Lines 477-502
normalization subroutine (under C4::Normalize) to be applied
Link Here
|
| 477 |
to the source string. |
477 |
to the source string. |
| 478 |
|
478 |
|
| 479 |
=cut |
479 |
=cut |
| 480 |
|
480 |
|
| 481 |
sub add_matchpoint { |
481 |
sub add_matchpoint { |
| 482 |
my $self = shift; |
482 |
my $self = shift; |
| 483 |
my ($index, $score, $matchcomponents) = @_; |
483 |
my ($index, $score, $matchcomponents) = @_; |
| 484 |
|
484 |
|
| 485 |
my $matchpoint = {}; |
485 |
my $matchpoint = {}; |
| 486 |
$matchpoint->{'index'} = $index; |
486 |
$matchpoint->{'index'} = $index; |
| 487 |
$matchpoint->{'score'} = $score; |
487 |
$matchpoint->{'score'} = $score; |
| 488 |
$matchpoint->{'components'} = []; |
488 |
$matchpoint->{'components'} = []; |
| 489 |
foreach my $input_component (@{ $matchcomponents }) { |
489 |
foreach my $input_component (@{ $matchcomponents }) { |
| 490 |
push @{ $matchpoint->{'components'} }, _parse_match_component($input_component); |
490 |
push @{ $matchpoint->{'components'} }, _parse_match_component($input_component); |
| 491 |
} |
491 |
} |
| 492 |
push @{ $self->{'matchpoints'} }, $matchpoint; |
492 |
push @{ $self->{'matchpoints'} }, $matchpoint; |
| 493 |
} |
493 |
} |
| 494 |
|
494 |
|
| 495 |
=head2 add_simple_matchpoint |
495 |
=head2 add_simple_matchpoint |
| 496 |
|
496 |
|
| 497 |
$matcher->add_simple_matchpoint($index, $score, $source_tag, |
497 |
$matcher->add_simple_matchpoint($index, $score, $source_tag, |
| 498 |
$source_subfields, $source_offset, |
498 |
$source_subfields, $source_offset, |
| 499 |
$source_length, $source_normalizer); |
499 |
$source_length, $source_normalizer); |
| 500 |
|
500 |
|
| 501 |
|
501 |
|
| 502 |
Adds a simple matchpoint rule -- after composing a key based on the source tag and subfields, |
502 |
Adds a simple matchpoint rule -- after composing a key based on the source tag and subfields, |
|
Lines 506-520
will receive the assigned score.
Link Here
|
| 506 |
=cut |
506 |
=cut |
| 507 |
|
507 |
|
| 508 |
sub add_simple_matchpoint { |
508 |
sub add_simple_matchpoint { |
| 509 |
my $self = shift; |
509 |
my $self = shift; |
| 510 |
my ($index, $score, $source_tag, $source_subfields, $source_offset, $source_length, $source_normalizer) = @_; |
510 |
my ($index, $score, $source_tag, $source_subfields, $source_offset, $source_length, $source_normalizer) = @_; |
| 511 |
|
511 |
|
| 512 |
$self->add_matchpoint($index, $score, [ |
512 |
$self->add_matchpoint($index, $score, [ |
| 513 |
{ tag => $source_tag, subfields => $source_subfields, |
513 |
{ tag => $source_tag, subfields => $source_subfields, |
| 514 |
offset => $source_offset, 'length' => $source_length, |
514 |
offset => $source_offset, 'length' => $source_length, |
| 515 |
norms => [ $source_normalizer ] |
515 |
norms => [ $source_normalizer ] |
| 516 |
} |
516 |
} |
| 517 |
]); |
517 |
]); |
| 518 |
} |
518 |
} |
| 519 |
|
519 |
|
| 520 |
=head2 add_required_check |
520 |
=head2 add_required_check |
|
Lines 536-546
$source_matchpoint and $target_matchpoint are each a reference to
Link Here
|
| 536 |
an array of hashes, where each hash follows the same definition |
536 |
an array of hashes, where each hash follows the same definition |
| 537 |
as the matchpoint component specification in add_matchpoint, i.e., |
537 |
as the matchpoint component specification in add_matchpoint, i.e., |
| 538 |
|
538 |
|
| 539 |
tag |
539 |
tag |
| 540 |
subfields |
540 |
subfields |
| 541 |
offset |
541 |
offset |
| 542 |
length |
542 |
length |
| 543 |
norms |
543 |
norms |
| 544 |
|
544 |
|
| 545 |
The normalization_rules value should in turn be a reference to an |
545 |
The normalization_rules value should in turn be a reference to an |
| 546 |
array, each element of which should be a reference to a |
546 |
array, each element of which should be a reference to a |
|
Lines 550-580
to the source string.
Link Here
|
| 550 |
=cut |
550 |
=cut |
| 551 |
|
551 |
|
| 552 |
sub add_required_check { |
552 |
sub add_required_check { |
| 553 |
my $self = shift; |
553 |
my $self = shift; |
| 554 |
my ($source_matchpoint, $target_matchpoint) = @_; |
554 |
my ($source_matchpoint, $target_matchpoint) = @_; |
| 555 |
|
555 |
|
| 556 |
my $matchcheck = {}; |
556 |
my $matchcheck = {}; |
| 557 |
$matchcheck->{'source_matchpoint'}->{'index'} = ''; |
557 |
$matchcheck->{'source_matchpoint'}->{'index'} = ''; |
| 558 |
$matchcheck->{'source_matchpoint'}->{'score'} = 0; |
558 |
$matchcheck->{'source_matchpoint'}->{'score'} = 0; |
| 559 |
$matchcheck->{'source_matchpoint'}->{'components'} = []; |
559 |
$matchcheck->{'source_matchpoint'}->{'components'} = []; |
| 560 |
$matchcheck->{'target_matchpoint'}->{'index'} = ''; |
560 |
$matchcheck->{'target_matchpoint'}->{'index'} = ''; |
| 561 |
$matchcheck->{'target_matchpoint'}->{'score'} = 0; |
561 |
$matchcheck->{'target_matchpoint'}->{'score'} = 0; |
| 562 |
$matchcheck->{'target_matchpoint'}->{'components'} = []; |
562 |
$matchcheck->{'target_matchpoint'}->{'components'} = []; |
| 563 |
foreach my $input_component (@{ $source_matchpoint }) { |
563 |
foreach my $input_component (@{ $source_matchpoint }) { |
| 564 |
push @{ $matchcheck->{'source_matchpoint'}->{'components'} }, _parse_match_component($input_component); |
564 |
push @{ $matchcheck->{'source_matchpoint'}->{'components'} }, _parse_match_component($input_component); |
| 565 |
} |
565 |
} |
| 566 |
foreach my $input_component (@{ $target_matchpoint }) { |
566 |
foreach my $input_component (@{ $target_matchpoint }) { |
| 567 |
push @{ $matchcheck->{'target_matchpoint'}->{'components'} }, _parse_match_component($input_component); |
567 |
push @{ $matchcheck->{'target_matchpoint'}->{'components'} }, _parse_match_component($input_component); |
| 568 |
} |
568 |
} |
| 569 |
push @{ $self->{'required_checks'} }, $matchcheck; |
569 |
push @{ $self->{'required_checks'} }, $matchcheck; |
| 570 |
} |
570 |
} |
| 571 |
|
571 |
|
| 572 |
=head2 add_simple_required_check |
572 |
=head2 add_simple_required_check |
| 573 |
|
573 |
|
| 574 |
$matcher->add_simple_required_check($source_tag, $source_subfields, |
574 |
$matcher->add_simple_required_check($source_tag, $source_subfields, |
| 575 |
$source_offset, $source_length, $source_normalizer, |
575 |
$source_offset, $source_length, $source_normalizer, |
| 576 |
$target_tag, $target_subfields, $target_offset, |
576 |
$target_tag, $target_subfields, $target_offset, |
| 577 |
$target_length, $target_normalizer); |
577 |
$target_length, $target_normalizer); |
| 578 |
|
578 |
|
| 579 |
Adds a required check, which requires that the normalized keys made from the source and targets |
579 |
Adds a required check, which requires that the normalized keys made from the source and targets |
| 580 |
must match for a match to be considered valid. |
580 |
must match for a match to be considered valid. |
|
Lines 582-607
must match for a match to be considered valid.
Link Here
|
| 582 |
=cut |
582 |
=cut |
| 583 |
|
583 |
|
| 584 |
sub add_simple_required_check { |
584 |
sub add_simple_required_check { |
| 585 |
my $self = shift; |
585 |
my $self = shift; |
| 586 |
my ($source_tag, $source_subfields, $source_offset, $source_length, $source_normalizer, |
586 |
my ($source_tag, $source_subfields, $source_offset, $source_length, $source_normalizer, |
| 587 |
$target_tag, $target_subfields, $target_offset, $target_length, $target_normalizer) = @_; |
587 |
$target_tag, $target_subfields, $target_offset, $target_length, $target_normalizer) = @_; |
| 588 |
|
588 |
|
| 589 |
$self->add_required_check( |
589 |
$self->add_required_check( |
| 590 |
[ { tag => $source_tag, subfields => $source_subfields, offset => $source_offset, 'length' => $source_length, |
590 |
[ { tag => $source_tag, subfields => $source_subfields, offset => $source_offset, 'length' => $source_length, |
| 591 |
norms => [ $source_normalizer ] } ], |
591 |
norms => [ $source_normalizer ] } ], |
| 592 |
[ { tag => $target_tag, subfields => $target_subfields, offset => $target_offset, 'length' => $target_length, |
592 |
[ { tag => $target_tag, subfields => $target_subfields, offset => $target_offset, 'length' => $target_length, |
| 593 |
norms => [ $target_normalizer ] } ] |
593 |
norms => [ $target_normalizer ] } ] |
| 594 |
); |
594 |
); |
| 595 |
} |
595 |
} |
| 596 |
|
596 |
|
| 597 |
=head2 get_matches |
597 |
=head2 get_matches |
| 598 |
|
598 |
|
| 599 |
my @matches = $matcher->get_matches($marc_record, $max_matches); |
599 |
my @matches = $matcher->get_matches($marc_record, $max_matches); |
| 600 |
foreach $match (@matches) { |
600 |
foreach $match (@matches) { |
| 601 |
# matches already sorted in order of |
601 |
# matches already sorted in order of |
| 602 |
# decreasing score |
602 |
# decreasing score |
| 603 |
print "record ID: $match->{'record_id'}; |
603 |
print "record ID: $match->{'record_id'}; |
| 604 |
print "score: $match->{'score'}; |
604 |
print "score: $match->{'score'}; |
| 605 |
} |
605 |
} |
| 606 |
|
606 |
|
| 607 |
Identifies all of the records matching the given MARC record. For a record already |
607 |
Identifies all of the records matching the given MARC record. For a record already |
|
Lines 621-743
in order of decreasing score, i.e., the best match is first.
Link Here
|
| 621 |
=cut |
621 |
=cut |
| 622 |
|
622 |
|
| 623 |
sub get_matches { |
623 |
sub get_matches { |
| 624 |
my $self = shift; |
624 |
my $self = shift; |
| 625 |
my ($source_record, $max_matches) = @_; |
625 |
my ($source_record, $max_matches) = @_; |
| 626 |
|
626 |
|
| 627 |
my %matches = (); |
627 |
my %matches = (); |
| 628 |
|
628 |
|
| 629 |
my $QParser; |
629 |
my $QParser; |
| 630 |
$QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser')); |
630 |
$QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser')); |
| 631 |
foreach my $matchpoint ( @{ $self->{'matchpoints'} } ) { |
631 |
foreach my $matchpoint ( @{ $self->{'matchpoints'} } ) { |
| 632 |
my @source_keys = _get_match_keys( $source_record, $matchpoint ); |
632 |
my @source_keys = _get_match_keys( $source_record, $matchpoint ); |
| 633 |
|
633 |
|
| 634 |
next if scalar(@source_keys) == 0; |
634 |
next if scalar(@source_keys) == 0; |
| 635 |
|
635 |
|
| 636 |
# FIXME - because of a bug in QueryParser, an expression ofthe |
636 |
# FIXME - because of a bug in QueryParser, an expression ofthe |
| 637 |
# format 'isbn:"isbn1" || isbn:"isbn2" || isbn"isbn3"...' |
637 |
# format 'isbn:"isbn1" || isbn:"isbn2" || isbn"isbn3"...' |
| 638 |
# does not get parsed correctly, so we will not |
638 |
# does not get parsed correctly, so we will not |
| 639 |
# do AggressiveMatchOnISBN if UseQueryParser is on |
639 |
# do AggressiveMatchOnISBN if UseQueryParser is on |
| 640 |
@source_keys = C4::Koha::GetVariationsOfISBNs(@source_keys) |
640 |
@source_keys = C4::Koha::GetVariationsOfISBNs(@source_keys) |
| 641 |
if ( $matchpoint->{index} =~ /^isbn$/i |
641 |
if ( $matchpoint->{index} =~ /^isbn$/i |
| 642 |
&& C4::Context->preference('AggressiveMatchOnISBN') ) |
642 |
&& C4::Context->preference('AggressiveMatchOnISBN') ) |
| 643 |
&& !C4::Context->preference('UseQueryParser'); |
643 |
&& !C4::Context->preference('UseQueryParser'); |
| 644 |
|
644 |
|
| 645 |
# build query |
645 |
# build query |
| 646 |
my $query; |
646 |
my $query; |
| 647 |
my $error; |
647 |
my $error; |
| 648 |
my $searchresults; |
648 |
my $searchresults; |
| 649 |
my $total_hits; |
649 |
my $total_hits; |
| 650 |
if ( $self->{'record_type'} eq 'biblio' ) { |
650 |
if ( $self->{'record_type'} eq 'biblio' ) { |
| 651 |
|
651 |
|
| 652 |
if ($QParser) { |
652 |
if ($QParser) { |
| 653 |
$query = join( " || ", |
653 |
$query = join( " || ", |
| 654 |
map { "$matchpoint->{'index'}:$_" } @source_keys ); |
654 |
map { "$matchpoint->{'index'}:$_" } @source_keys ); |
| 655 |
} |
655 |
} |
| 656 |
else { |
656 |
else { |
| 657 |
my $phr = C4::Context->preference('AggressiveMatchOnISBN') ? ',phr' : q{}; |
657 |
my $phr = C4::Context->preference('AggressiveMatchOnISBN') ? ',phr' : q{}; |
| 658 |
$query = join( " or ", |
658 |
$query = join( " or ", |
| 659 |
map { "$matchpoint->{'index'}$phr=$_" } @source_keys ); |
659 |
map { "$matchpoint->{'index'}$phr=$_" } @source_keys ); |
| 660 |
} |
660 |
} |
| 661 |
|
|
|
| 662 |
require C4::Search; |
| 663 |
|
| 664 |
( $error, $searchresults, $total_hits ) = |
| 665 |
C4::Search::SimpleSearch( $query, 0, $max_matches ); |
| 666 |
} |
| 667 |
elsif ( $self->{'record_type'} eq 'authority' ) { |
| 668 |
my $authresults; |
| 669 |
my @marclist; |
| 670 |
my @and_or; |
| 671 |
my @excluding = []; |
| 672 |
my @operator; |
| 673 |
my @value; |
| 674 |
foreach my $key (@source_keys) { |
| 675 |
push @marclist, $matchpoint->{'index'}; |
| 676 |
push @and_or, 'or'; |
| 677 |
push @operator, 'exact'; |
| 678 |
push @value, $key; |
| 679 |
} |
| 680 |
require C4::AuthoritiesMarc; |
| 681 |
( $authresults, $total_hits ) = |
| 682 |
C4::AuthoritiesMarc::SearchAuthorities( |
| 683 |
\@marclist, \@and_or, \@excluding, \@operator, |
| 684 |
\@value, 0, 20, undef, |
| 685 |
'AuthidAsc', 1 |
| 686 |
); |
| 687 |
foreach my $result (@$authresults) { |
| 688 |
push @$searchresults, $result->{'authid'}; |
| 689 |
} |
| 690 |
} |
| 691 |
|
| 692 |
#Collect the results |
| 693 |
if ( defined $error ) { |
| 694 |
warn "search failed ($query) $error"; |
| 695 |
} |
| 696 |
else { |
| 697 |
if ($self->{'record_type'} eq 'authority') { |
| 698 |
foreach my $matched ( @{$searchresults} ) { |
| 699 |
$matches{$matched}->{score} += $matchpoint->{'score'}; |
| 700 |
} |
| 701 |
} |
| 702 |
elsif ($self->{'record_type'} eq 'biblio') { |
| 703 |
foreach my $matched ( @{$searchresults} ) { |
| 704 |
my $record = C4::Search::new_record_from_zebra( 'biblioserver', $matched ); |
| 705 |
$matches{$record}->{score} += $matchpoint->{'score'}; #Using $record HASH string representation as the key :) |
| 706 |
$matches{$record}->{record} = $record; |
| 707 |
} |
| 708 |
} |
| 709 |
|
661 |
|
| 710 |
} |
662 |
require C4::Search; |
| 711 |
} |
663 |
|
|
|
664 |
( $error, $searchresults, $total_hits ) = |
| 665 |
C4::Search::SimpleSearch( $query, 0, $max_matches ); |
| 666 |
} |
| 667 |
elsif ( $self->{'record_type'} eq 'authority' ) { |
| 668 |
my $authresults; |
| 669 |
my @marclist; |
| 670 |
my @and_or; |
| 671 |
my @excluding = []; |
| 672 |
my @operator; |
| 673 |
my @value; |
| 674 |
foreach my $key (@source_keys) { |
| 675 |
push @marclist, $matchpoint->{'index'}; |
| 676 |
push @and_or, 'or'; |
| 677 |
push @operator, 'exact'; |
| 678 |
push @value, $key; |
| 679 |
} |
| 680 |
require C4::AuthoritiesMarc; |
| 681 |
( $authresults, $total_hits ) = |
| 682 |
C4::AuthoritiesMarc::SearchAuthorities( |
| 683 |
\@marclist, \@and_or, \@excluding, \@operator, |
| 684 |
\@value, 0, 20, undef, |
| 685 |
'AuthidAsc', 1 |
| 686 |
); |
| 687 |
foreach my $result (@$authresults) { |
| 688 |
push @$searchresults, $result->{'authid'}; |
| 689 |
} |
| 690 |
} |
| 691 |
|
| 692 |
#Collect the results |
| 693 |
if ( defined $error ) { |
| 694 |
warn "search failed ($query) $error"; |
| 695 |
} |
| 696 |
else { |
| 697 |
if ($self->{'record_type'} eq 'authority') { |
| 698 |
foreach my $matched ( @{$searchresults} ) { |
| 699 |
$matches{$matched}->{score} += $matchpoint->{'score'}; |
| 700 |
} |
| 701 |
} |
| 702 |
elsif ($self->{'record_type'} eq 'biblio') { |
| 703 |
foreach my $matched ( @{$searchresults} ) { |
| 704 |
my $record = C4::Search::new_record_from_zebra( 'biblioserver', $matched ); |
| 705 |
$matches{$record}->{score} += $matchpoint->{'score'}; #Using $record HASH string representation as the key :) |
| 706 |
$matches{$record}->{record} = $record; |
| 707 |
} |
| 708 |
} |
| 712 |
|
709 |
|
| 713 |
# get rid of any that don't meet the threshold |
710 |
} |
| 714 |
%matches = map { ($matches{$_}->{score} >= $self->{'threshold'}) ? ($_ => $matches{$_}) : () } keys %matches; |
711 |
} |
| 715 |
|
712 |
|
| 716 |
# get rid of any that don't meet the required checks |
713 |
# get rid of any that don't meet the threshold |
| 717 |
%matches = map { _passes_required_checks($source_record, $matches{$_}->{record}, $self->{'required_checks'}) ? ($_ => $matches{$_}) : () } |
714 |
%matches = map { ($matches{$_}->{score} >= $self->{'threshold'}) ? ($_ => $matches{$_}) : () } keys %matches; |
| 718 |
keys %matches unless ($self->{'record_type'} eq 'auth'); |
715 |
|
| 719 |
|
716 |
# get rid of any that don't meet the required checks |
| 720 |
my @results = (); |
717 |
%matches = map { _passes_required_checks($source_record, $matches{$_}->{record}, $self->{'required_checks'}) ? ($_ => $matches{$_}) : () } |
| 721 |
if ($self->{'record_type'} eq 'biblio') { |
718 |
keys %matches unless ($self->{'record_type'} eq 'auth'); |
| 722 |
require C4::Biblio; |
719 |
|
| 723 |
foreach my $hashkey (keys %matches) { |
720 |
my @results = (); |
| 724 |
my $target_record = $matches{$hashkey}->{record}; |
721 |
if ($self->{'record_type'} eq 'biblio') { |
| 725 |
my $record_number; |
722 |
require C4::Biblio; |
| 726 |
my $result = C4::Biblio::TransformMarcToKoha(C4::Context->dbh, $target_record, ''); |
723 |
foreach my $hashkey (keys %matches) { |
| 727 |
$record_number = $result->{'biblionumber'}; |
724 |
my $target_record = $matches{$hashkey}->{record}; |
| 728 |
push @results, { 'record_id' => $record_number, 'score' => $matches{$hashkey}->{score}, 'target_record' => $target_record, 'target_biblio' => $result }; |
725 |
my $record_number; |
| 729 |
} |
726 |
my $result = C4::Biblio::TransformMarcToKoha(C4::Context->dbh, $target_record, ''); |
| 730 |
} elsif ($self->{'record_type'} eq 'authority') { |
727 |
$record_number = $result->{'biblionumber'}; |
| 731 |
require C4::AuthoritiesMarc; |
728 |
push @results, { 'record_id' => $record_number, 'score' => $matches{$hashkey}->{score}, 'target_record' => $target_record, 'target_biblio' => $result }; |
| 732 |
foreach my $authid (keys %matches) { |
729 |
} |
| 733 |
push @results, { 'record_id' => $authid, 'score' => $matches{$authid}->{score} }; |
730 |
} elsif ($self->{'record_type'} eq 'authority') { |
| 734 |
} |
731 |
require C4::AuthoritiesMarc; |
| 735 |
} |
732 |
foreach my $authid (keys %matches) { |
| 736 |
@results = sort { $b->{'score'} cmp $a->{'score'} } @results; |
733 |
push @results, { 'record_id' => $authid, 'score' => $matches{$authid}->{score} }; |
| 737 |
if (scalar(@results) > $max_matches) { |
734 |
} |
| 738 |
@results = @results[0..$max_matches-1]; |
735 |
} |
| 739 |
} |
736 |
@results = sort { $b->{'score'} cmp $a->{'score'} } @results; |
| 740 |
return @results; |
737 |
if (scalar(@results) > $max_matches) { |
|
|
738 |
@results = @results[0..$max_matches-1]; |
| 739 |
} |
| 740 |
return @results; |
| 741 |
|
741 |
|
| 742 |
} |
742 |
} |
| 743 |
|
743 |
|
|
Lines 752-872
aid setting up a HTML editing form.
Link Here
|
| 752 |
=cut |
752 |
=cut |
| 753 |
|
753 |
|
| 754 |
sub dump { |
754 |
sub dump { |
| 755 |
my $self = shift; |
755 |
my $self = shift; |
| 756 |
|
756 |
|
| 757 |
my $result = {}; |
757 |
my $result = {}; |
| 758 |
|
758 |
|
| 759 |
$result->{'matcher_id'} = $self->{'id'}; |
759 |
$result->{'matcher_id'} = $self->{'id'}; |
| 760 |
$result->{'code'} = $self->{'code'}; |
760 |
$result->{'code'} = $self->{'code'}; |
| 761 |
$result->{'description'} = $self->{'description'}; |
761 |
$result->{'description'} = $self->{'description'}; |
| 762 |
$result->{'record_type'} = $self->{'record_type'}; |
762 |
$result->{'record_type'} = $self->{'record_type'}; |
| 763 |
|
763 |
|
| 764 |
$result->{'matchpoints'} = []; |
764 |
$result->{'matchpoints'} = []; |
| 765 |
foreach my $matchpoint (@{ $self->{'matchpoints'} }) { |
765 |
foreach my $matchpoint (@{ $self->{'matchpoints'} }) { |
| 766 |
push @{ $result->{'matchpoints'} }, $matchpoint; |
766 |
push @{ $result->{'matchpoints'} }, $matchpoint; |
| 767 |
} |
767 |
} |
| 768 |
$result->{'matchchecks'} = []; |
768 |
$result->{'matchchecks'} = []; |
| 769 |
foreach my $matchcheck (@{ $self->{'required_checks'} }) { |
769 |
foreach my $matchcheck (@{ $self->{'required_checks'} }) { |
| 770 |
push @{ $result->{'matchchecks'} }, $matchcheck; |
770 |
push @{ $result->{'matchchecks'} }, $matchcheck; |
| 771 |
} |
771 |
} |
| 772 |
|
772 |
|
| 773 |
return $result; |
773 |
return $result; |
| 774 |
} |
774 |
} |
| 775 |
|
775 |
|
| 776 |
sub _passes_required_checks { |
776 |
sub _passes_required_checks { |
| 777 |
my ($source_record, $target_record, $matchchecks) = @_; |
777 |
my ($source_record, $target_record, $matchchecks) = @_; |
| 778 |
|
778 |
|
| 779 |
# no checks supplied == automatic pass |
779 |
# no checks supplied == automatic pass |
| 780 |
return 1 if $#{ $matchchecks } == -1; |
780 |
return 1 if $#{ $matchchecks } == -1; |
| 781 |
|
781 |
|
| 782 |
foreach my $matchcheck (@{ $matchchecks }) { |
782 |
foreach my $matchcheck (@{ $matchchecks }) { |
| 783 |
my $source_key = join "", _get_match_keys($source_record, $matchcheck->{'source_matchpoint'}); |
783 |
my $source_key = join "", _get_match_keys($source_record, $matchcheck->{'source_matchpoint'}); |
| 784 |
my $target_key = join "", _get_match_keys($target_record, $matchcheck->{'target_matchpoint'}); |
784 |
my $target_key = join "", _get_match_keys($target_record, $matchcheck->{'target_matchpoint'}); |
| 785 |
return 0 unless $source_key eq $target_key; |
785 |
return 0 unless $source_key eq $target_key; |
| 786 |
} |
786 |
} |
| 787 |
return 1; |
787 |
return 1; |
| 788 |
} |
788 |
} |
| 789 |
|
789 |
|
| 790 |
sub _get_match_keys { |
790 |
sub _get_match_keys { |
| 791 |
my $source_record = shift; |
791 |
my $source_record = shift; |
| 792 |
my $matchpoint = shift; |
792 |
my $matchpoint = shift; |
| 793 |
my $check_only_first_repeat = @_ ? shift : 0; |
793 |
my $check_only_first_repeat = @_ ? shift : 0; |
| 794 |
|
794 |
|
| 795 |
# If there is more than one component to the matchpoint (e.g., |
795 |
# If there is more than one component to the matchpoint (e.g., |
| 796 |
# matchpoint includes both 003 and 001), any repeats |
796 |
# matchpoint includes both 003 and 001), any repeats |
| 797 |
# of the first component's tag are identified; repeats |
797 |
# of the first component's tag are identified; repeats |
| 798 |
# of the subsequent components' tags are appended to |
798 |
# of the subsequent components' tags are appended to |
| 799 |
# each parallel key dervied from the first component, |
799 |
# each parallel key dervied from the first component, |
| 800 |
# up to the number of repeats of the first component's tag. |
800 |
# up to the number of repeats of the first component's tag. |
| 801 |
# |
801 |
# |
| 802 |
# For example, if the record has one 003 and two 001s, only |
802 |
# For example, if the record has one 003 and two 001s, only |
| 803 |
# one key is retrieved because there is only one 003. The key |
803 |
# one key is retrieved because there is only one 003. The key |
| 804 |
# will consist of the contents of the first 003 and first 001. |
804 |
# will consist of the contents of the first 003 and first 001. |
| 805 |
# |
805 |
# |
| 806 |
# If there are two 003s and two 001s, there will be two keys: |
806 |
# If there are two 003s and two 001s, there will be two keys: |
| 807 |
# first 003 + first 001 |
807 |
# first 003 + first 001 |
| 808 |
# second 003 + second 001 |
808 |
# second 003 + second 001 |
| 809 |
|
809 |
|
| 810 |
my @keys = (); |
810 |
my @keys = (); |
| 811 |
for (my $i = 0; $i <= $#{ $matchpoint->{'components'} }; $i++) { |
811 |
for (my $i = 0; $i <= $#{ $matchpoint->{'components'} }; $i++) { |
| 812 |
my $component = $matchpoint->{'components'}->[$i]; |
812 |
my $component = $matchpoint->{'components'}->[$i]; |
| 813 |
my $j = -1; |
813 |
my $j = -1; |
| 814 |
FIELD: foreach my $field ($source_record->field($component->{'tag'})) { |
814 |
FIELD: foreach my $field ($source_record->field($component->{'tag'})) { |
| 815 |
$j++; |
815 |
$j++; |
| 816 |
last FIELD if $j > 0 and $check_only_first_repeat; |
816 |
last FIELD if $j > 0 and $check_only_first_repeat; |
| 817 |
last FIELD if $i > 0 and $j > $#keys; |
817 |
last FIELD if $i > 0 and $j > $#keys; |
| 818 |
my $key = ""; |
818 |
my $key = ""; |
| 819 |
my $string; |
819 |
my $string; |
| 820 |
if ($field->is_control_field()) { |
820 |
if ($field->is_control_field()) { |
| 821 |
$string=$field->data(); |
821 |
$string=$field->data(); |
| 822 |
} else { |
822 |
} else { |
| 823 |
foreach my $subfield ($field->subfields()) { |
823 |
foreach my $subfield ($field->subfields()) { |
| 824 |
if (exists $component->{'subfields'}->{$subfield->[0]}) { |
824 |
if (exists $component->{'subfields'}->{$subfield->[0]}) { |
| 825 |
$string .= " " . $subfield->[1]; |
825 |
$string .= " " . $subfield->[1]; |
| 826 |
} |
826 |
} |
| 827 |
} |
827 |
} |
| 828 |
} |
828 |
} |
| 829 |
if ($component->{'length'}>0) { |
829 |
if ($component->{'length'}>0) { |
| 830 |
$string= substr($string, $component->{'offset'}, $component->{'length'}); |
830 |
$string= substr($string, $component->{'offset'}, $component->{'length'}); |
| 831 |
# FIXME normalize, substr |
831 |
# FIXME normalize, substr |
| 832 |
} elsif ($component->{'offset'}) { |
832 |
} elsif ($component->{'offset'}) { |
| 833 |
$string= substr($string, $component->{'offset'}); |
833 |
$string= substr($string, $component->{'offset'}); |
| 834 |
} |
834 |
} |
| 835 |
$key = _normalize($string); |
835 |
$key = _normalize($string); |
| 836 |
if ($i == 0) { |
836 |
if ($i == 0) { |
| 837 |
push @keys, $key if $key; |
837 |
push @keys, $key if $key; |
| 838 |
} else { |
838 |
} else { |
| 839 |
$keys[$j] .= " $key" if $key; |
839 |
$keys[$j] .= " $key" if $key; |
| 840 |
} |
840 |
} |
| 841 |
} |
841 |
} |
| 842 |
} |
842 |
} |
| 843 |
return @keys; |
843 |
return @keys; |
| 844 |
} |
844 |
} |
| 845 |
|
845 |
|
| 846 |
|
846 |
|
| 847 |
sub _parse_match_component { |
847 |
sub _parse_match_component { |
| 848 |
my $input_component = shift; |
848 |
my $input_component = shift; |
| 849 |
|
849 |
|
| 850 |
my $component = {}; |
850 |
my $component = {}; |
| 851 |
$component->{'tag'} = $input_component->{'tag'}; |
851 |
$component->{'tag'} = $input_component->{'tag'}; |
| 852 |
$component->{'subfields'} = { map { $_ => 1 } split(//, $input_component->{'subfields'}) }; |
852 |
$component->{'subfields'} = { map { $_ => 1 } split(//, $input_component->{'subfields'}) }; |
| 853 |
$component->{'offset'} = exists($input_component->{'offset'}) ? $input_component->{'offset'} : -1; |
853 |
$component->{'offset'} = exists($input_component->{'offset'}) ? $input_component->{'offset'} : -1; |
| 854 |
$component->{'length'} = $input_component->{'length'} ? $input_component->{'length'} : 0; |
854 |
$component->{'length'} = $input_component->{'length'} ? $input_component->{'length'} : 0; |
| 855 |
$component->{'norms'} = $input_component->{'norms'} ? $input_component->{'norms'} : []; |
855 |
$component->{'norms'} = $input_component->{'norms'} ? $input_component->{'norms'} : []; |
| 856 |
|
856 |
|
| 857 |
return $component; |
857 |
return $component; |
| 858 |
} |
858 |
} |
| 859 |
|
859 |
|
| 860 |
# FIXME - default normalizer |
860 |
# FIXME - default normalizer |
| 861 |
sub _normalize { |
861 |
sub _normalize { |
| 862 |
my $value = uc shift; |
862 |
my $value = uc shift; |
| 863 |
$value =~ s/[.;:,\]\[\)\(\/'"]//g; |
863 |
$value =~ s/[.;:,\]\[\)\(\/'"]//g; |
| 864 |
$value =~ s/^\s+//; |
864 |
$value =~ s/^\s+//; |
| 865 |
#$value =~ s/^\s+$//; |
865 |
#$value =~ s/^\s+$//; |
| 866 |
$value =~ s/\s+$//; |
866 |
$value =~ s/\s+$//; |
| 867 |
$value =~ s/\s+/ /g; |
867 |
$value =~ s/\s+/ /g; |
| 868 |
#$value =~ s/[.;,\]\[\)\(\/"']//g; |
868 |
#$value =~ s/[.;,\]\[\)\(\/"']//g; |
| 869 |
return $value; |
869 |
return $value; |
|
|
870 |
} |
| 871 |
|
| 872 |
=head2 overlayRecord |
| 873 |
|
| 874 |
$mergedRecord = $matcher->overlayRecord($old_record, $new_record); |
| 875 |
|
| 876 |
@Param1 MARC:Record of the old record whose fields should be preserved |
| 877 |
@Param2 MARC:Record of the record whose fields should be overwritten with the old ones |
| 878 |
@Returns MARC::Record-object with overlayed fields. |
| 879 |
|
| 880 |
Overlays the new_record with the designated fields from the old_record. |
| 881 |
Fields are defined using this C4::Matcher's "Match points". |
| 882 |
-Tag and subfields can be used. If only tag is given, all subfields for all the tags present in the old_record are selected. |
| 883 |
-If subfields are defined, only the defined subfields are selected and other subfields are lost. |
| 884 |
-Selected subfields/fields are copied over same elements in the new_record, or if the new_record misses those elements, |
| 885 |
new ones are created. |
| 886 |
|
| 887 |
=cut |
| 888 |
|
| 889 |
sub overlayRecord { |
| 890 |
my $matcher = shift; #Get my $self! |
| 891 |
my ($old_record, $record) = @_; |
| 892 |
foreach my $matchpoint ( @{$matcher->{matchpoints}} ) { |
| 893 |
foreach my $component ( @{$matchpoint->{components}} ) { |
| 894 |
my $tag = $component->{tag}; |
| 895 |
my @t = keys(%{$component->{subfields}}); |
| 896 |
my $subfield = shift(@t); |
| 897 |
my $normalizer = $component->{norms}->[0]; |
| 898 |
|
| 899 |
_copyFieldsTo( $old_record, $record, $tag, $subfield ); |
| 900 |
} |
| 901 |
} |
| 902 |
|
| 903 |
foreach my $required_check (@{$matcher->{required_checks}}) { |
| 904 |
my $source_field = $required_check->{source_matchpoint}->{components}->[0]->{tag}; |
| 905 |
my @t = keys(%{$required_check->{source_matchpoint}->{components}->[0]->{subfields}}); |
| 906 |
my $source_subfield = shift @t; |
| 907 |
my $source_norms = $required_check->{source_matchpoint}->{components}->[0]->{norms}->[0]; |
| 908 |
my $target_field = $required_check->{target_matchpoint}->{components}->[0]->{tag}; |
| 909 |
@t = keys(%{$required_check->{target_matchpoint}->{components}->[0]->{subfields}}); |
| 910 |
my $target_subfield = shift @t; |
| 911 |
my $target_norms = $required_check->{target_matchpoint}->{components}->[0]->{norms}->[0]; |
| 912 |
|
| 913 |
if ($source_norms =~ /copy/ && $target_norms =~ /paste/) { |
| 914 |
_copyFieldsTo( $record, $record, $source_field, $source_subfield, $target_field, $target_subfield ); |
| 915 |
} |
| 916 |
elsif ($source_norms =~ /move/ && $target_norms =~ /paste/) { |
| 917 |
_copyFieldsTo( $record, $record, $source_field, $source_subfield, $target_field, $target_subfield ); |
| 918 |
if ($source_field && $source_subfield) { |
| 919 |
my @source_fields = $record->field($source_field); |
| 920 |
foreach my $f (@source_fields) { |
| 921 |
$f->delete_subfield(code => $source_subfield); |
| 922 |
} |
| 923 |
} |
| 924 |
elsif ($source_field) { |
| 925 |
my @source_fields = $record->field($source_field); |
| 926 |
$record->delete_fields(@source_fields); |
| 927 |
} |
| 928 |
} |
| 929 |
elsif ($source_norms =~ /preserve/ && $target_norms =~ /preserve/) { |
| 930 |
_copyFieldsTo( $old_record, $record, $source_field, $source_subfield, $target_field, $target_subfield ); |
| 931 |
} |
| 932 |
|
| 933 |
} |
| 934 |
return $record; |
| 935 |
} |
| 936 |
#Copies the given field and subfield from $oldRecord to the $newRecord as a new field and subfield |
| 937 |
# |
| 938 |
# _copyFieldsTo($oldRecord, $newRecord, '049', 'a', '051, 'c'); |
| 939 |
# _copyFieldsTo($oldRecord, $newRecord, '049', 'a'); #Target field and subfield defaults to '049' and 'a' |
| 940 |
# |
| 941 |
#@PARAM1 MARC::Record from which to copy fields from |
| 942 |
#@PARAM2 MARC::Record to receive the copied fields |
| 943 |
#@PARAM3 source tag as String |
| 944 |
#@PARAM4 source subfield as String, optional, if omited copies the whole field regardless of target definitions |
| 945 |
#@PARAM5 target field, if the source field needs to change the field code |
| 946 |
#@PARAM6 target subfield, if the source subfield needs to change code |
| 947 |
sub _copyFieldsTo { |
| 948 |
my ($oldRecord, $newRecord, $sourceField, $sourceSubfield, $targetField, $targetSubfield) = @_; |
| 949 |
$targetField = $sourceField unless $targetField; |
| 950 |
$targetSubfield = $sourceSubfield unless $targetSubfield; |
| 951 |
|
| 952 |
my @oldFields = $oldRecord->field($sourceField); |
| 953 |
my @newFields = $newRecord->field($targetField); |
| 954 |
|
| 955 |
if (@oldFields) { #There is no point in continuing if there is nothing to preserve. |
| 956 |
for (my $oi=0 ; $oi < scalar @oldFields ; $oi++) { |
| 957 |
|
| 958 |
my $old_field = $oldFields[$oi]; |
| 959 |
my $new_field = $newFields[$oi]; |
| 960 |
if (not($new_field) && not($sourceSubfield)) { #If no new field present, clone the old field |
| 961 |
$new_field = $old_field->clone(); |
| 962 |
$new_field->set_tag( $targetField ) if $targetField; |
| 963 |
$newRecord->append_fields( $new_field ); |
| 964 |
} |
| 965 |
else { #Copy the designated fields |
| 966 |
my @subfields = ($sourceSubfield); |
| 967 |
@subfields = map {$_->[0]} $old_field->subfields() unless $sourceSubfield; #Move all subfields if none are define |
| 968 |
|
| 969 |
if (@subfields) { |
| 970 |
foreach my $sftag ( @subfields ) { |
| 971 |
my $oldSfContent = $old_field->subfield($sftag); |
| 972 |
if ( $oldSfContent ) { |
| 973 |
$sftag = $targetSubfield if $targetSubfield; |
| 974 |
|
| 975 |
if (not($new_field)) { #Why is MARC::Field so crap that it doesn't allow creating an empty object? |
| 976 |
$new_field = MARC::Field->new( $targetField, ' ', ' ', $sftag => $oldSfContent ); |
| 977 |
$newRecord->append_fields( $new_field ); |
| 978 |
} |
| 979 |
else { |
| 980 |
$new_field->update( $sftag => $oldSfContent ); |
| 981 |
} |
| 982 |
} |
| 983 |
} |
| 984 |
} |
| 985 |
} |
| 986 |
} |
| 987 |
} |
| 870 |
} |
988 |
} |
| 871 |
|
989 |
|
| 872 |
1; |
990 |
1; |