View | Details | Raw Unified | Return to bug 13706
Collapse All | Expand All

(-)a/misc/maintenance/dedup_authorities.pl (-1 / +329 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
use Modern::Perl;
3
use C4::Context;
4
use C4::AuthoritiesMarc;
5
use C4::Biblio;
6
use C4::Search;
7
use C4::Charset;
8
use C4::Heading;
9
use Koha::SearchEngine;
10
use Koha::SearchEngine::QueryBuilder;
11
use Koha::Logger;
12
13
use Koha::Authorities;
14
15
use Getopt::Long;
16
use YAML;
17
use List::MoreUtils qw/uniq/;
18
19
=head1 NAME
20
21
misc/migration_tools/dedup_authorities.pl - Deduping authorities script
22
23
=head1 SYNOPSIS
24
25
dedup_authorities.pl [ -h ] [ -where="authid < 5000" ] -c [ -v ] [ -m d ] [ -a PERSO_NAME ]
26
27
 Options:
28
     -h --help          display usage statement
29
     -v --verbose       increase verbosity, can be repeated for greater verbosity
30
     -m --method        method for choosing the reference authority, can be: date, used, or ppn (UNIMARC)
31
                        can be repeated
32
     -w --where         a SQL WHERE statement to limit the authority records checked
33
     -c --confirm       without this parameter no changes will be made, script will run in test mode
34
     -a --authtypecode  check only specified auth type, repeatable
35
36
=head1 OPTIONS
37
38
=over
39
40
=item B<--method>
41
42
Method(s) used to choose which authority to keep in case we found
43
duplicates.
44
<methods> is a string composed of letters describing what methods to use
45
and in which order.
46
Letters can be:
47
    date:  keep the most recent authority (based on 005 field)
48
    used:  keep the most used authority
49
    ppn:   PPN (UNIMARC only), keep the authority with a ppn (when some
50
        authorities don't have one, based on 009 field)
51
52
Example:
53
-m ppn -m date -m used
54
Among the authorities that have a PPN, keep the most recent,
55
and if two (or more) have the same date in 005, keep the
56
most used.
57
58
Default is 'used'
59
60
=item B<--where>
61
62
limit the deduplication to SOME authorities only
63
64
Example:
65
-where="authid < 5000"
66
will only auths with a low auth_id (old records)
67
68
=item B<--verbose>
69
70
display verbose loggin, can be repeated twice for more info
71
72
73
=item B<--help>
74
75
show usage information.
76
77
=back
78
79
=cut
80
81
my @methods;
82
my @authtypecodes;
83
my $help = 0;
84
my $confirm = 0;
85
my $verbose = 0;
86
my $wherestring = "";
87
my $debug = 0;
88
89
90
my $result = GetOptions (
91
    "d|debug"          => \$debug,
92
    "v|verbose+"       => \$verbose,
93
    "c|confirm"        => \$confirm,
94
    "h|help"           => \$help,
95
    "w|where=s"        => \$wherestring,
96
    "m|method=s"       => \@methods,
97
    "a|authtypecode=s" => \@authtypecodes
98
);
99
100
pod2usage( -verbose => 2) if ($help);
101
102
print "RUNNING IN TEST MODE, NO CHANGES WILL BE MADE\n" unless $confirm;
103
$verbose = 1 unless ( $confirm || $verbose );
104
105
106
107
my @choose_subs;
108
@methods = ('used') unless @methods;
109
foreach my $method ( @methods ) {
110
    if ($method  eq 'date') {
111
        push @choose_subs, \&_get_date;
112
    }
113
    elsif( $method eq 'ppn') {
114
        die 'PPN method is only valid for UNIMARC'
115
            unless( C4::Context->preference('marcflavour') eq 'UNIMARC' );
116
        push @choose_subs, \&_has_ppn;
117
    }
118
    elsif( $method eq 'used') {
119
        push @choose_subs, \&_get_usage;
120
    }
121
    else {
122
        warn "Choose method '$method' is not supported";
123
    }
124
}
125
126
my $dbh = C4::Context->dbh;
127
128
$verbose and print "Fetching authtypecodes...\n";
129
my $params = undef;
130
if( @authtypecodes ){
131
$params = { authtypecode => { -in => \@authtypecodes } };
132
}
133
my @auth_types = Koha::Authority::Types->search($params);
134
my %auth_match_headings = map { $_->authtypecode => $_->auth_tag_to_report } @auth_types;
135
$verbose and print "Fetching authtypecodes done.\n";
136
137
my %biblios;
138
my $seen;
139
140
for my $authtype (@auth_types) {
141
    my $authtypecode = $authtype->authtypecode;
142
    my %duplicated;
143
    my $deleted = 0;
144
    my $updated_bibs = 0;
145
    my $i = 0;
146
    $verbose and print "Deduping authtype '$authtypecode' \n";
147
148
    $verbose and print "Fetching authorities for '$authtypecode'... ";
149
    my $authorities = Koha::Authorities->search({ authtypecode => $authtypecode });
150
    $authorities = $authorities->search( \$wherestring ) if $wherestring;
151
    my $size = $authorities->count;
152
    $verbose and print "$size authorities found\n";
153
154
    while ( my $authority = $authorities->next ) {
155
        next if defined $seen->{ $authority->authid };
156
        $seen->{ $authority->authid } = 1;
157
        $i++;
158
        if ($verbose >= 2) {
159
            my $percentage = sprintf("%.2f", $i * 100 / $size);
160
            print "Processing authority " . $authority->authid ." ($i/$size $percentage%)\n";
161
        } elsif ($verbose and ($i % 100) == 0) {
162
            my $percentage = sprintf("%.2f", $i * 100 / $size);
163
            print "Progression for authtype '$authtypecode': $i/$size ($percentage%)\n";
164
        }
165
166
        #authority was marked as duplicate
167
        next if defined $duplicated{$authority->authid};
168
        my $authrecord = C4::AuthoritiesMarc::GetAuthority($authority->authid);
169
170
        next unless $authrecord;
171
        C4::Charset::SetUTF8Flag($authrecord);
172
173
        $debug and print "Building query...\n";
174
        my $field = $authrecord->field( $auth_match_headings{ $authtypecode } );
175
        unless ( $field ){
176
            warn "Malformed authority record, no heading";
177
            next;
178
        }
179
        my $heading = C4::Heading->new_from_field( $field, undef, 1 ); #new auth heading
180
        my $search_term = $heading->search_form;
181
        $debug and print "Building query done\n";
182
        $debug and print "$search_term\n";
183
184
        $debug and print "Searching...";
185
#my ($error, $results) = SimpleSearch("match-heading:\"$search_term\"", undef, undef, ["authorityserver"]);
186
        my $builder = Koha::SearchEngine::QueryBuilder->new({ index => $Koha::SearchEngine::AUTHORITIES_INDEX } );
187
        my $searcher = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::AUTHORITIES_INDEX });
188
        my $query = $builder->build_authorities_query_compat(['match-heading'],[''],[''],['exact'],[$search_term],$authtypecode,'');
189
        my ( $results,$total ) = $searcher->search_auth_compat( $query, 0, 50, undef );
190
        if ( !$results ) {
191
            $debug and warn $@;
192
            $debug and warn YAML::Dump($search_term);
193
            $debug and warn $field->as_string;
194
            next;
195
        }
196
197
        $debug and warn YAML::Dump($results);
198
199
        my @recordids = map { $_->{authid} != $authority->authid ? $_->{authid} : () } @$results;
200
        if ( !$results || scalar( @$results ) < 1 || scalar @recordids < 1 ){
201
            ($verbose >= 2) and print 'No duplicates found for ' . $heading->display_form . "\n";
202
            next;
203
        }
204
        map {  $seen->{ $_ } = 1 } @recordids;
205
        $debug and print "Searching done.\n";
206
207
        $debug and print "Choosing records...";
208
        my ( $recordid_to_keep, @recordids_to_merge )
209
            = _choose_records( $authority->authid, @recordids );
210
        $debug and print "Choosing records done.\n";
211
        unless (!$confirm or @recordids_to_merge == 0) {
212
            ($verbose >= 2) and print "Merging ". join(',',@recordids_to_merge) ." into $recordid_to_keep.\n";
213
            for my $localauthid (@recordids_to_merge) {
214
                next if $recordid_to_keep == $localauthid;
215
                my @editedbiblios = eval {
216
                    C4::AuthoritiesMarc::merge({
217
                        merge_from => $localauthid,
218
                        MARCfrom   => undef,
219
                        mergeto    => $recordid_to_keep,
220
                        MARCto     => undef
221
                    });
222
                };
223
                if ($@) {
224
                    warn "merging $localauthid into $recordid_to_keep failed :", $@;
225
                } else {
226
                    print "Updated " . scalar @editedbiblios . " biblios\n";
227
                    $updated_bibs += scalar @editedbiblios;
228
                    $duplicated{$localauthid} = 2;
229
                    print "Deleting $localauthid\n";
230
                    C4::AuthoritiesMarc::DelAuthority({ authid => $localauthid, skip_merge => 1 });
231
                    $deleted++;
232
                }
233
            }
234
            ($verbose >= 2) and print "Merge done.\n";
235
            $duplicated{$recordid_to_keep} = 1;
236
        } elsif ($verbose >= 2) {
237
            if (@recordids_to_merge > 0) {
238
                print 'Would merge '
239
                    . join(',', @recordids_to_merge)
240
                    . " into $recordid_to_keep (".$heading->display_form.")\n";
241
            } else {
242
                print "No duplicates found for $recordid_to_keep\n";
243
            }
244
        }
245
    }
246
    $verbose and print "End of deduping for authtype '$authtypecode'\n";
247
    $verbose and print "Updated $updated_bibs biblios\n";
248
    $verbose and print "Deleted $deleted authorities\n";
249
}
250
251
# Update biblios
252
my @biblios_to_update = grep {defined $biblios{$_} and $biblios{$_} == 1}
253
                            keys %biblios;
254
if( @biblios_to_update > 0 ) {
255
} else {
256
    print "No biblios to update\n";
257
}
258
259
260
exit 0;
261
262
sub _get_id {
263
    my $record = shift;
264
265
    if($record and (my $field = $record->field('001'))) {
266
        return $field->data();
267
    }
268
    return 0;
269
}
270
271
sub _has_ppn {
272
    my $record = shift;
273
274
    if($record and (my $field = $record->field('009'))) {
275
        return $field->data() ? 1 : 0;
276
    }
277
    return 0;
278
}
279
280
sub _get_date {
281
    my $record = shift;
282
283
    if($record and (my $field = $record->field('005'))) {
284
        return $field->data();
285
    }
286
    return 0;
287
}
288
289
sub _get_usage {
290
    my $record = shift;
291
292
    if($record and (my $field = $record->field('001'))) {
293
        return Koha::Authorities->get_usage_count({ authid => $field->data() });
294
    }
295
    return 0;
296
}
297
298
=head2 _choose_records
299
    this function takes input of candidate record ids to merging
300
    and returns
301
        first the record to merge to
302
        and list of records to merge from
303
=cut
304
sub _choose_records {
305
    my @recordids = @_;
306
307
    my @records = map { C4::AuthoritiesMarc::GetAuthority($_) } @recordids;
308
    my @candidate_auths = @records;
309
310
    # See http://www.sysarch.com/Perl/sort_paper.html Schwartzian transform
311
    my @candidate_authids =
312
        map $_->[0] =>
313
        sort {
314
            $b->[1] <=> $a->[1] ||
315
            $b->[2] <=> $a->[2] ||
316
            $b->[3] <=> $a->[3]
317
        }
318
        map [
319
            _get_id($_),
320
            $choose_subs[0] ? $choose_subs[0]->($_) : 0,
321
            $choose_subs[1] ? $choose_subs[1]->($_) : 0,
322
            $choose_subs[2] ? $choose_subs[2]->($_) : 0
323
        ] =>
324
        ( $records[0], @candidate_auths );
325
326
    return @candidate_authids;
327
}
328
329

Return to bug 13706