LP#1312945: auth-auth linking: cache less agressively and look for all links
[working/Evergreen.git] / Open-ILS / src / support-scripts / authority_authority_linker.pl.in
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5 use DBI;
6 use Getopt::Long;
7 use MARC::Record;
8 use MARC::File::XML (BinaryEncoding => 'UTF-8');
9 use MARC::Charset;
10 use OpenSRF::System;
11 use OpenILS::Utils::Fieldmapper;
12 use OpenSRF::Utils::SettingsClient;
13 use OpenSRF::EX qw/:try/;
14 use Encode;
15 use Unicode::Normalize;
16 use OpenILS::Application::AppUtils;
17 use Data::Dumper;
18 use Pod::Usage qw/ pod2usage /;
19
20 MARC::Charset->assume_unicode(1);
21
22 my $acsaf_cache = {};
23
24 sub get_acsaf {
25     my ($e, $id) = @_;
26
27     $acsaf_cache->{$id} ||=
28         $e->retrieve_authority_control_set_authority_field([
29             $id,
30             {flesh => 1, flesh_fields => {acsaf => ["main_entry"]}}
31         ]);
32     return $acsaf_cache->{$id};
33 }
34
35 # Grab DB information from local settings. Return connected db handle (or die)
36 sub connect_to_db {
37     my $sc = OpenSRF::Utils::SettingsClient->new;
38     my $db_driver = $sc->config_value( reporter => setup => database => 'driver' );
39     my $db_host = $sc->config_value( reporter => setup => database => 'host' );
40     my $db_port = $sc->config_value( reporter => setup => database => 'port' );
41     my $db_name = $sc->config_value( reporter => setup => database => 'db' );
42     if (!$db_name) {
43         $db_name = $sc->config_value( reporter => setup => database => 'name' );
44         print STDERR "WARN: <database><name> is a deprecated setting for database name. For future compatibility, you should use <database><db> instead." if $db_name;
45     }
46     my $db_user = $sc->config_value( reporter => setup => database => 'user' );
47     my $db_pw = $sc->config_value( reporter => setup => database => 'pw' );
48
49     die "Unable to retrieve database connection information from the settings server" unless ($db_driver && $db_host && $db_port && $db_name && $db_user);
50
51     my $dsn = "dbi:" . $db_driver . ":dbname=" . $db_name .';host=' . $db_host . ';port=' . $db_port;
52
53     return DBI->connect(
54         $dsn,$db_user,$db_pw, {
55             AutoCommit => 1, pg_enable_utf8 => 1, RaiseError => 1
56         }
57     ); # shouldn't need 'or die...' with RaiseError=>1
58 }
59
60 # I can't believe this isn't already in a sub somewhere?  We seem to repeat
61 # these steps all over the place, which is very much "bad code smell."
62 sub marcxml_eg {
63     my ($xml) = @_; # a string, not an object, to be clear
64
65     $xml =~ s/\n//sgo;
66     $xml =~ s/^<\?xml.+\?\s*>//go;
67     $xml =~ s/>\s+</></go;
68     $xml =~ s/\p{Cc}//go;
69
70     return OpenILS::Application::AppUtils->entityize($xml);
71 }
72
73 sub matchable_string {
74     my ($field, $sf_list, $joiner) = @_;
75     $joiner ||= ' ';
76
77     return join($joiner, map { $field->subfield($_) } split "", $sf_list);
78 }
79
80 # ########### main
81 my ($start_id, $end_id);
82 my $bootstrap = '@sysconfdir@/opensrf_core.xml';
83 my @records;
84
85 my %options;
86 my $result = GetOptions(
87     \%options,
88     'configuration=s' => \$bootstrap,
89     'record=i' => \@records,
90     'all', 'help', 'debug',
91     'start_id=i' => \$start_id,
92     'end_id=i' => \$end_id
93 );
94
95 pod2usage(0) if not $result or $options{help};
96
97 print "OpenSRF bootstrap and fieldmapper import...\n" if $options{debug};
98 OpenSRF::System->bootstrap_client(config_file => $bootstrap);
99 Fieldmapper->import(IDL => OpenSRF::Utils::SettingsClient->new->config_value("IDL"));
100
101 # must be loaded and initialized after the IDL is parsed
102
103 print "Loading CStoreEditor ...\n" if $options{debug};
104
105 use OpenILS::Utils::CStoreEditor;
106 OpenILS::Utils::CStoreEditor::init();
107
108 my $e = OpenILS::Utils::CStoreEditor->new;
109
110 my $query = q{
111     SELECT
112         source,
113         ARRAY_TO_STRING(ARRAY_AGG(target || ',' || field), ';') AS links
114         FROM (
115             SELECT  sh1.record AS target,
116                 sh2.record AS source,
117                 sh2.atag AS field
118             FROM  authority.simple_heading sh1
119                 JOIN authority.simple_heading sh2 USING (sort_value)
120                 JOIN authority.control_set_authority_field af1 ON (sh1.atag = af1.id AND af1.main_entry IS NULL)
121                 JOIN authority.control_set_authority_field af2 ON (sh2.atag = af2.id AND af2.main_entry IS NOT NULL AND af2.linking_subfield IS NOT NULL)
122                 %s -- where clause here
123             EXCEPT SELECT target, source, field FROM authority.authority_linking
124     ) x GROUP BY 1
125 };
126
127 my @bind_params;
128 if (@records) {
129     $query = sprintf($query, "WHERE sh2.record = ?");
130     @bind_params = @records;    # should be just one scalar in this array.
131 } elsif ($options{all}) {
132     $query = sprintf($query, ""); # no where clause
133 } elsif ($start_id and $end_id) {
134     $query = sprintf($query, "WHERE sh2.record BETWEEN ? AND ?");
135     @bind_params = ($start_id, $end_id);
136 } else {
137     pod2usage(0);
138 }
139
140 print "SQL, params: ", Dumper($query, \@bind_params), "\n" if $options{debug};
141 my $dbh = connect_to_db; # dies if any problem
142 my $sth = $dbh->prepare($query);
143
144 print "Executing query ...\n" if $options{debug};
145 $sth->execute(@bind_params);
146
147 my $problems = 0;
148
149 while (my ($src, $links) = $sth->fetchrow_array) {
150     print "src: $src\n" if $options{debug};
151
152     try {
153         my $src_rec = $e->retrieve_authority_record_entry($src) or
154             die $e->die_event;
155         my $src_marc = MARC::Record->new_from_xml($src_rec->marc);
156
157         for my $link (split ';', $links) {
158             my ($target, $field_id) = split ',', $link;
159
160             print "target: $target, field_id: $field_id\n" if $options{debug};
161
162             my $target_rec = $e->retrieve_authority_record_entry($target) or
163                     die $e->die_event;
164             my $target_marc = MARC::Record->new_from_xml($target_rec->marc);
165             my $cni = $target_marc->field('003')->data;
166
167             my $acsaf = get_acsaf($e, $field_id) or die $e->die_event;
168
169             for my $field ($src_marc->field($acsaf->tag)) {
170                 my $src_string = matchable_string(
171                     $field, $acsaf->main_entry->display_sf_list, $acsaf->main_entry->joiner
172                 );
173
174                 print("at field ", $acsaf->id, " (", $acsaf->tag,
175                     "), trying to match '$src_string'...\n") if $options{debug};
176
177                 my ($tfield) = $target_marc->field($acsaf->main_entry->tag);
178                 my $target_string = matchable_string(
179                     $tfield, $acsaf->main_entry->display_sf_list, $acsaf->main_entry->joiner
180                 );
181
182                 if ($target_string eq $src_string) {
183                     print "got a match ...\n" if $options{debug};
184                     $field->update('0' => "($cni)$target");
185                 }
186             }
187         }
188
189         $src_rec->marc(marcxml_eg($src_marc->as_xml_record));
190
191         $e->xact_begin;
192         $e->update_authority_record_entry($src_rec) or
193             die $e->die_event;
194         $e->xact_commit;
195
196     } otherwise {
197         my $err = shift;
198         print STDERR "\nRecord # $src : ",
199             (ref $err eq "HASH" ? Dumper($err) : $err), "\n";
200
201         # Reset SAX parser so that one bad record doesn't
202         # kill the entire process.
203
204         import MARC::File::XML;
205         $problems++;
206     }
207 }
208
209 exit ($problems > 0);
210
211 __END__
212
213 =head1 NAME
214
215 authority_authority_linker.pl - Link reference headings in authority records to main entry headings in other authority records
216
217 =head1 SYNOPSIS
218
219 authority_authority_linker.pl [B<--configuration>=I<opensrf_core.conf>]
220 [[B<--record>=I<record>[ B<--record>=I<record>]]] | [B<--all>] | [B<--start_id>=I<start-ID> B<--end_id>=I<end-ID>]
221
222 =head1 DESCRIPTION
223
224 For a given set of records, find authority reference headings that also
225 appear as main entry headings in any other authority record. In the
226 specific MARC field of the authority record (source) containing the reference
227 heading with such a match in another authority record (target), add a subfield
228 0 (zero) referring to the target record by ID.
229
230 =head1 OPTIONS
231
232 =over
233
234 =item * B<-c> I<config-file>, B<--configuration>=I<config-file>
235
236 Specifies the OpenSRF configuration file used to connect to the OpenSRF router.
237 Defaults to F<@sysconfdir@/opensrf_core.xml>
238
239 =item * B<-r> I<record-ID>, B<--record>=I<record-ID>
240
241 Specifies the authority record ID (found in the C<authority.record_entry.id>
242 column) of the B<source> record to process. This option may be specified more
243 than once to process multiple records in a single run.
244
245 =item * B<-a>, B<--all>
246
247 Specifies that all authority records should be processed. For large
248 databases, this may take an extraordinarily long amount of time.
249
250 =item * B<-s> I<start-ID>, B<--start_id>=I<start-ID>
251
252 Specifies the starting ID of the range of authority records to process.
253 This option is ignored unless it is accompanied by the B<-e> or B<--end_id>
254 option.
255
256 =item * B<-e> I<end-ID>, B<--end_id>=I<end-ID>
257
258 Specifies the ending ID of the range of authority records to process.
259 This option is ignored unless it is accompanied by the B<-s> or B<--start>
260 option.
261
262 =back
263
264 =head1 EXAMPLES
265
266     authority_authority_linker.pl --start_id 1 --end_id 50000
267
268 Processes the authority records with IDs between 1 and 50,000 using the
269 default OpenSRF configuration file for connection information.
270
271 =head1 AUTHOR
272
273 Lebbeous Fogle-Weekley <lebbeous@esilibrary.com>
274
275 =head1 COPYRIGHT AND LICENSE
276
277 Copyright (C) 2013 Equinox Software, Inc.
278
279 This program is free software; you can redistribute it and/or
280 modify it under the terms of the GNU General Public License
281 as published by the Free Software Foundation; either version 2
282 of the License, or (at your option) any later version.
283
284 This program is distributed in the hope that it will be useful,
285 but WITHOUT ANY WARRANTY; without even the implied warranty of
286 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
287 GNU General Public License for more details.
288
289 You should have received a copy of the GNU General Public License
290 along with this program; if not, write to the Free Software
291 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
292 02110-1301, USA.
293
294 =cut