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

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

Return to bug 13706