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

(-)a/misc/maintenance/dedup_authorities.pl (-1 / +325 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::Debug;
9
use C4::Heading;
10
use Koha::SearchEngine;
11
use Koha::SearchEngine::QueryBuilder;
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
88
89
my $result = GetOptions (
90
    "v|verbose+"       => \$verbose,
91
    "c|confirm"        => \$confirm,
92
    "h|help"           => \$help,
93
    "w|where=s"        => \$wherestring,
94
    "m|method=s"       => \@methods,
95
    "a|authtypecode=s" => \@authtypecodes
96
);
97
98
pod2usage( -verbose => 2) if ($help);
99
100
print "RUNNING IN TEST MODE, NO CHANGES WILL BE MADE" unless $confirm;
101
$verbose = 1 unless ( $confirm || $verbose );
102
103
104
105
my @choose_subs;
106
@methods = ('used') unless @methods;
107
foreach my $method ( @methods ) {
108
    if ($method  eq 'date') {
109
        push @choose_subs, \&_get_date;
110
    }
111
    elsif( $method eq 'ppn') {
112
        die 'PPN method is only valid for UNIMARC'
113
            unless( C4::Context->preference('marcflavour') eq 'UNIMARC' );
114
        push @choose_subs, \&_has_ppn;
115
    }
116
    elsif( $method eq 'used') {
117
        push @choose_subs, \&_get_usage;
118
    }
119
    else {
120
        warn "Choose method '$method' is not supported";
121
    }
122
}
123
124
my $dbh = C4::Context->dbh;
125
126
$verbose and logger("Fetching authtypecodes...");
127
my $params = undef;
128
if( @authtypecodes ){
129
$params = { authtypecode => { -in => \@authtypecodes } };
130
}
131
my @auth_types = Koha::Authority::Types->search($params);
132
my %auth_match_headings = map { $_->authtypecode => $_->auth_tag_to_report } @auth_types;
133
$verbose and logger("Fetching authtypecodes done.");
134
135
my %biblios;
136
137
for my $authtype (@auth_types) {
138
    my $authtypecode = $authtype->authtypecode;
139
    my %duplicated;
140
    my $deleted = 0;
141
    my $updated_bibs = 0;
142
    my $i = 0;
143
    $verbose and logger("Deduping authtype '$authtypecode'");
144
145
    $verbose and logger("Fetching authorities for '$authtypecode'... ");
146
    my $authorities = Koha::Authorities->search({ authtypecode => $authtypecode });
147
    $authorities = $authorities->search( \$wherestring ) if $wherestring;
148
    my $size = $authorities->count;
149
    $verbose and logger("$size authorities found");
150
151
    while ( my $authority = $authorities->next ) {
152
        $i++;
153
        if ($verbose >= 2) {
154
            my $percentage = sprintf("%.2f", $i * 100 / $size);
155
            logger("Processing authority $authority->authid ($i/$size $percentage%)");
156
        } elsif ($verbose and ($i % 100) == 0) {
157
            my $percentage = sprintf("%.2f", $i * 100 / $size);
158
            logger("Progression for authtype '$authtypecode': $i/$size ($percentage%)");
159
        }
160
161
        #authority was marked as duplicate
162
        next if defined $duplicated{$authority->authid};
163
        my $authrecord = GetAuthority($authority->authid);
164
165
        next unless $authrecord;
166
        SetUTF8Flag($authrecord);
167
168
        ($verbose >= 2) and logger("Building query...");
169
        my $field = $authrecord->field( $auth_match_headings{ $authtypecode } );
170
        my $heading = C4::Heading->new_from_field( $field, undef, 1 ); #new auth heading
171
        my $search_term = $heading->search_form;
172
        ($verbose >= 2) and logger("Building query done.");
173
        ($verbose >= 2) and logger ("$search_term");
174
175
        ($verbose >= 2) and logger("Searching...");
176
#my ($error, $results) = SimpleSearch("match-heading:\"$search_term\"", undef, undef, ["authorityserver"]);
177
        my $builder = Koha::SearchEngine::QueryBuilder->new({ index => $Koha::SearchEngine::AUTHORITIES_INDEX } );
178
        my $searcher = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::AUTHORITIES_INDEX });
179
        my $query = $builder->build_authorities_query_compat(['match-heading'],[''],[''],['exact'],[$search_term],$authtypecode,'');
180
        my ( $results,$total ) = $searcher->search_auth_compat( $query, 0, 50, undef );
181
        if ( !$results ) {
182
            $debug and warn $@;
183
            $debug and warn YAML::Dump($search_term);
184
            $debug and warn $field->as_string;
185
            next;
186
        }
187
188
        $debug and warn YAML::Dump($results);
189
190
        if ( !$results or scalar( @$results ) < 1 ){
191
            ($verbose >= 2) and logger('No duplicates found for ' . $heading->display_form);
192
            next;
193
        }
194
        my @recordids = map { $_->{authid} if $_->{authid} != $authority->authid } @$results;
195
        ($verbose >= 2) and logger("Searching done.");
196
197
        ($verbose >= 2) and logger("Choosing records...");
198
        my ( $recordid_to_keep, @recordids_to_merge )
199
            = _choose_records( $authority->authid, @recordids );
200
        ($verbose >= 2) and logger("Choosing records done.");
201
        unless (!$confirm or @recordids_to_merge == 0) {
202
            ($verbose >= 2) and logger("Merging ". join(',',@recordids_to_merge) ." into $recordid_to_keep.");
203
            for my $localauthid (@recordids_to_merge) {
204
                next if $recordid_to_keep == $localauthid;
205
                my @editedbiblios = eval {
206
                    merge({
207
                        merge_from => $localauthid,
208
                        MARCfrom   => undef,
209
                        mergeto    => $recordid_to_keep,
210
                        MARCto     => undef
211
                    });
212
                };
213
                if ($@) {
214
                    warn "merging $localauthid into $recordid_to_keep failed :", $@;
215
                } else {
216
                    logger("Updated " . scalar @editedbiblios . " biblios");
217
                    $updated_bibs += scalar @editedbiblios;
218
                    $duplicated{$localauthid} = 2;
219
                    logger("Deleting $localauthid");
220
                    DelAuthority({ authid => $localauthid, skip_merge => 1 });
221
                    $deleted++;
222
                }
223
            }
224
            ($verbose >= 2) and logger("Merge done.");
225
            $duplicated{$recordid_to_keep} = 1;
226
        } elsif ($verbose >= 2) {
227
            if (@recordids_to_merge > 0) {
228
                logger('Would merge '
229
                    . join(',', @recordids_to_merge)
230
                    . " into $recordid_to_keep.");
231
            } else {
232
                logger("No duplicates found for $recordid_to_keep");
233
            }
234
        }
235
    }
236
    $verbose and logger("End of deduping for authtype '$authtypecode'");
237
    $verbose and logger("Updated $updated_bibs biblios");
238
    $verbose and logger("Deleted $deleted authorities");
239
}
240
241
# Update biblios
242
my @biblios_to_update = grep {defined $biblios{$_} and $biblios{$_} == 1}
243
                            keys %biblios;
244
if( @biblios_to_update > 0 ) {
245
} else {
246
    logger("No biblios to update");
247
}
248
249
250
exit 0;
251
252
sub _get_id {
253
    my $record = shift;
254
255
    if($record and (my $field = $record->field('001'))) {
256
        return $field->data();
257
    }
258
    return 0;
259
}
260
261
sub _has_ppn {
262
    my $record = shift;
263
264
    if($record and (my $field = $record->field('009'))) {
265
        return $field->data() ? 1 : 0;
266
    }
267
    return 0;
268
}
269
270
sub _get_date {
271
    my $record = shift;
272
273
    if($record and (my $field = $record->field('005'))) {
274
        return $field->data();
275
    }
276
    return 0;
277
}
278
279
sub _get_usage {
280
    my $record = shift;
281
282
    if($record and (my $field = $record->field('001'))) {
283
        return Koha::Authorities->get_usage_count({ authid => $field->data() });
284
    }
285
    return 0;
286
}
287
288
=head2 _choose_records
289
    this function takes input of candidate record ids to merging
290
    and returns
291
        first the record to merge to
292
        and list of records to merge from
293
=cut
294
sub _choose_records {
295
    my @recordids = @_;
296
297
    my @records = map { GetAuthority($_) } @recordids;
298
    my @candidate_auths = @records;
299
300
    # See http://www.sysarch.com/Perl/sort_paper.html Schwartzian transform
301
    my @candidate_authids =
302
        map $_->[0] =>
303
        sort {
304
            $b->[1] <=> $a->[1] ||
305
            $b->[2] <=> $a->[2] ||
306
            $b->[3] <=> $a->[3]
307
        }
308
        map [
309
            _get_id($_),
310
            $choose_subs[0] ? $choose_subs[0]->($_) : 0,
311
            $choose_subs[1] ? $choose_subs[1]->($_) : 0,
312
            $choose_subs[2] ? $choose_subs[2]->($_) : 0
313
        ] =>
314
        ( $records[0], @candidate_auths );
315
316
    return @candidate_authids;
317
}
318
319
320
sub logger {
321
    my ($sec, $min, $hour, $mday, $mon, $year) = localtime;
322
    my $time_msg = sprintf "[%04d-%02d-%02d %02d:%02d:%02d]",
323
        1900+$year, 1+$mon, $mday, $hour, $min, $sec;
324
    say $time_msg, ' ', @_;
325
}

Return to bug 13706