+=cut
+
+sub fetch {
+ my $class = shift;
+ my $id = shift;
+ my $dbh = C4::Context->dbh();
+
+ my $sth = $dbh->prepare_cached("SELECT * FROM marc_matchers WHERE matcher_id = ?");
+ $sth->execute($id);
+ my $row = $sth->fetchrow_hashref;
+ $sth->finish();
+ return undef unless defined $row;
+
+ my $self = {};
+ $self->{'id'} = $row->{'matcher_id'};
+ $self->{'record_type'} = $row->{'record_type'};
+ $self->{'code'} = $row->{'code'};
+ $self->{'description'} = $row->{'description'};
+ $self->{'threshold'} = int($row->{'threshold'});
+ bless $self, $class;
+
+ # matchpoints
+ $self->{'matchpoints'} = [];
+ $sth = $dbh->prepare_cached("SELECT * FROM matcher_matchpoints WHERE matcher_id = ? ORDER BY matchpoint_id");
+ $sth->execute($self->{'id'});
+ while (my $row = $sth->fetchrow_hashref) {
+ my $matchpoint = $self->_fetch_matchpoint($row->{'matchpoint_id'});
+ push @{ $self->{'matchpoints'} }, $matchpoint;
+ }
+
+ # required checks
+ $self->{'required_checks'} = [];
+ $sth = $dbh->prepare_cached("SELECT * FROM matchchecks WHERE matcher_id = ? ORDER BY matchcheck_id");
+ $sth->execute($self->{'id'});
+ while (my $row = $sth->fetchrow_hashref) {
+ my $source_matchpoint = $self->_fetch_matchpoint($row->{'source_matchpoint_id'});
+ my $target_matchpoint = $self->_fetch_matchpoint($row->{'target_matchpoint_id'});
+ my $matchcheck = {};
+ $matchcheck->{'source_matchpoint'} = $source_matchpoint;
+ $matchcheck->{'target_matchpoint'} = $target_matchpoint;
+ push @{ $self->{'required_checks'} }, $matchcheck;
+ }
+
+ return $self;
+}
+
+sub _fetch_matchpoint {
+ my $self = shift;
+ my $matchpoint_id = shift;
+
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare_cached("SELECT * FROM matchpoints WHERE matchpoint_id = ?");
+ $sth->execute($matchpoint_id);
+ my $row = $sth->fetchrow_hashref;
+ my $matchpoint = {};
+ $matchpoint->{'index'} = $row->{'search_index'};
+ $matchpoint->{'score'} = int($row->{'score'});
+ $sth->finish();
+
+ $matchpoint->{'components'} = [];
+ $sth = $dbh->prepare_cached("SELECT * FROM matchpoint_components WHERE matchpoint_id = ? ORDER BY sequence");
+ $sth->execute($matchpoint_id);
+ while ($row = $sth->fetchrow_hashref) {
+ my $component = {};
+ $component->{'tag'} = $row->{'tag'};
+ $component->{'subfields'} = { map { $_ => 1 } split(//, $row->{'subfields'}) };
+ $component->{'offset'} = int($row->{'offset'});
+ $component->{'length'} = int($row->{'length'});
+ $component->{'norms'} = [];
+ my $sth2 = $dbh->prepare_cached("SELECT *
+ FROM matchpoint_component_norms
+ WHERE matchpoint_component_id = ? ORDER BY sequence");
+ $sth2->execute($row->{'matchpoint_component_id'});
+ while (my $row2 = $sth2->fetchrow_hashref) {
+ push @{ $component->{'norms'} }, $row2->{'norm_routine'};
+ }
+ push @{ $matchpoint->{'components'} }, $component;
+ }
+ return $matchpoint;
+}
+
+=head2 store
+
+ my $id = $matcher->store();
+
+Stores matcher in database. The return value is the ID
+of the marc_matchers row. If the matcher was
+previously retrieved from the database via the fetch()
+method, the DB representation of the matcher
+is replaced.
+
+=cut
+
+sub store {
+ my $self = shift;
+
+ if (defined $self->{'id'}) {
+ # update
+ $self->_del_matcher_components();
+ $self->_update_marc_matchers();
+ } else {
+ # create new
+ $self->_new_marc_matchers();
+ }
+ $self->_store_matcher_components();
+ return $self->{'id'};
+}
+
+sub _del_matcher_components {
+ my $self = shift;
+
+ my $dbh = C4::Context->dbh();
+ my $sth = $dbh->prepare_cached("DELETE FROM matchpoints WHERE matcher_id = ?");
+ $sth->execute($self->{'id'});
+ $sth = $dbh->prepare_cached("DELETE FROM matchchecks WHERE matcher_id = ?");
+ $sth->execute($self->{'id'});
+ # foreign key delete cascades take care of deleting relevant rows
+ # from matcher_matchpoints, matchpoint_components, and
+ # matchpoint_component_norms
+}
+
+sub _update_marc_matchers {
+ my $self = shift;
+
+ my $dbh = C4::Context->dbh();
+ my $sth = $dbh->prepare_cached("UPDATE marc_matchers
+ SET code = ?,
+ description = ?,
+ record_type = ?,
+ threshold = ?
+ WHERE matcher_id = ?");
+ $sth->execute($self->{'code'}, $self->{'description'}, $self->{'record_type'}, $self->{'threshold'}, $self->{'id'});
+}
+
+sub _new_marc_matchers {
+ my $self = shift;
+
+ my $dbh = C4::Context->dbh();
+ my $sth = $dbh->prepare_cached("INSERT INTO marc_matchers
+ (code, description, record_type, threshold)
+ VALUES (?, ?, ?, ?)");
+ $sth->execute($self->{'code'}, $self->{'description'}, $self->{'record_type'}, $self->{'threshold'});
+ $self->{'id'} = $dbh->{'mysql_insertid'};
+}
+
+sub _store_matcher_components {
+ my $self = shift;
+
+ my $dbh = C4::Context->dbh();
+ my $sth;
+ my $matcher_id = $self->{'id'};
+ foreach my $matchpoint (@{ $self->{'matchpoints'}}) {
+ my $matchpoint_id = $self->_store_matchpoint($matchpoint);
+ $sth = $dbh->prepare_cached("INSERT INTO matcher_matchpoints (matcher_id, matchpoint_id)
+ VALUES (?, ?)");
+ $sth->execute($matcher_id, $matchpoint_id);
+ }
+ foreach my $matchcheck (@{ $self->{'required_checks'} }) {
+ my $source_matchpoint_id = $self->_store_matchpoint($matchcheck->{'source_matchpoint'});
+ my $target_matchpoint_id = $self->_store_matchpoint($matchcheck->{'target_matchpoint'});
+ $sth = $dbh->prepare_cached("INSERT INTO matchchecks
+ (matcher_id, source_matchpoint_id, target_matchpoint_id)
+ VALUES (?, ?, ?)");
+ $sth->execute($matcher_id, $source_matchpoint_id, $target_matchpoint_id);
+ }
+
+}
+
+sub _store_matchpoint {
+ my $self = shift;
+ my $matchpoint = shift;
+
+ my $dbh = C4::Context->dbh();
+ my $sth;
+ my $matcher_id = $self->{'id'};
+ $sth = $dbh->prepare_cached("INSERT INTO matchpoints (matcher_id, search_index, score)
+ VALUES (?, ?, ?)");
+ $sth->execute($matcher_id, $matchpoint->{'index'}, $matchpoint->{'score'});
+ my $matchpoint_id = $dbh->{'mysql_insertid'};
+ my $seqnum = 0;
+ foreach my $component (@{ $matchpoint->{'components'} }) {
+ $seqnum++;
+ $sth = $dbh->prepare_cached("INSERT INTO matchpoint_components
+ (matchpoint_id, sequence, tag, subfields, offset, length)
+ VALUES (?, ?, ?, ?, ?, ?)");
+ $sth->bind_param(1, $matchpoint_id);
+ $sth->bind_param(2, $seqnum);
+ $sth->bind_param(3, $component->{'tag'});
+ $sth->bind_param(4, join "", sort keys %{ $component->{'subfields'} });
+ $sth->bind_param(5, $component->{'offset'});
+ $sth->bind_param(6, $component->{'length'});
+ $sth->execute();
+ my $matchpoint_component_id = $dbh->{'mysql_insertid'};
+ my $normseq = 0;
+ foreach my $norm (@{ $component->{'norms'} }) {
+ $normseq++;
+ $sth = $dbh->prepare_cached("INSERT INTO matchpoint_component_norms
+ (matchpoint_component_id, sequence, norm_routine)
+ VALUES (?, ?, ?)");
+ $sth->execute($matchpoint_component_id, $normseq, $norm);
+ }
+ }
+ return $matchpoint_id;
+}
+
+
+=head2 delete
+
+ C4::Matcher->delete($id);
+
+Deletes the matcher of the specified ID
+from the database.
+
+=cut
+
+sub delete {
+ my $class = shift;
+ my $matcher_id = shift;
+
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("DELETE FROM marc_matchers WHERE matcher_id = ?");
+ $sth->execute($matcher_id); # relying on cascading deletes to clean up everything
+}
+
+=head2 threshold
+
+ $matcher->threshold(1000);
+ my $threshold = $matcher->threshold();