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

(-)a/C4/AuthoritiesMarc.pm (-81 / +33 lines)
Lines 1302-1308 Then we should add some new parameter : bibliotargettag, authtargettag Link Here
1302
1302
1303
sub merge {
1303
sub merge {
1304
    my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
1304
    my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
1305
    my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);        
1305
    my @editedbiblios;
1306
    my $dbh=C4::Context->dbh;
1306
    my $dbh=C4::Context->dbh;
1307
    my $authtypecodefrom = GetAuthTypeCode($mergefrom);
1307
    my $authtypecodefrom = GetAuthTypeCode($mergefrom);
1308
    my $authtypecodeto = GetAuthTypeCode($mergeto);
1308
    my $authtypecodeto = GetAuthTypeCode($mergeto);
Lines 1316-1332 sub merge { Link Here
1316
    my ($auth_tag_to_report_from) = $sth->fetchrow;
1316
    my ($auth_tag_to_report_from) = $sth->fetchrow;
1317
    $sth->execute($authtypecodeto);
1317
    $sth->execute($authtypecodeto);
1318
    my ($auth_tag_to_report_to) = $sth->fetchrow;
1318
    my ($auth_tag_to_report_to) = $sth->fetchrow;
1319
    
1319
1320
    my @record_to;
1320
    my @record_to;
1321
    @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to);
1321
    @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to);
1322
    my @record_from;
1322
    my @record_from;
1323
    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
1323
    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
1324
    
1324
1325
    my @reccache;
1325
    my @reccache;
1326
    # search all biblio tags using this authority.
1326
    # search all biblio tags using this authority.
1327
    #Getting marcbiblios impacted by the change.
1327
    #Getting marcbiblios impacted by the change.
1328
    if (C4::Context->preference('NoZebra')) {
1328
    if (C4::Context->preference('NoZebra')) {
1329
        #nozebra way    
1329
        #nozebra way
1330
        my $dbh=C4::Context->dbh;
1330
        my $dbh=C4::Context->dbh;
1331
        my $rq=$dbh->prepare(qq(SELECT biblionumbers from nozebra where indexname="an" and server="biblioserver" and value="$mergefrom" ));
1331
        my $rq=$dbh->prepare(qq(SELECT biblionumbers from nozebra where indexname="an" and server="biblioserver" and value="$mergefrom" ));
1332
        $rq->execute;
1332
        $rq->execute;
Lines 1375-1415 sub merge { Link Here
1375
    while (my ($tagfield) = $sth->fetchrow) {
1375
    while (my ($tagfield) = $sth->fetchrow) {
1376
        push @tags_using_authtype,$tagfield ;
1376
        push @tags_using_authtype,$tagfield ;
1377
    }
1377
    }
1378
    my $tag_to=0;  
1378
    my $tag_to=0;
1379
    if ($authtypecodeto ne $authtypecodefrom){  
1379
    if ($authtypecodeto ne $authtypecodefrom){
1380
        # If many tags, take the first
1380
        # If many tags, take the first
1381
        $sth->execute($authtypecodeto);    
1381
        $sth->execute($authtypecodeto);
1382
        $tag_to=$sth->fetchrow;
1382
        $tag_to=$sth->fetchrow;
1383
        #warn $tag_to;    
1383
    }
1384
    }  
1385
    # BulkEdit marc records
1384
    # BulkEdit marc records
1386
    # May be used as a template for a bulkedit field  
1385
    # May be used as a template for a bulkedit field
1387
    foreach my $marcrecord(@reccache){
1386
    foreach my $marcrecord(@reccache){
1388
        my $update;           
1387
        my $update;
1389
        foreach my $tagfield (@tags_using_authtype){
1388
        foreach my $tagfield (@tags_using_authtype){
1390
#             warn "tagfield : $tagfield ";
1391
            foreach my $field ($marcrecord->field($tagfield)){
1389
            foreach my $field ($marcrecord->field($tagfield)){
1392
                my $auth_number=$field->subfield("9");
1390
                my $auth_number=$field->subfield("9");
1393
                my $tag=$field->tag();          
1391
                my $tag=$field->tag();
1394
                if ($auth_number==$mergefrom) {
1392
                if ($auth_number==$mergefrom) {
1395
                my $field_to=MARC::Field->new(($tag_to?$tag_to:$tag),$field->indicator(1),$field->indicator(2),"9"=>$mergeto);
1393
                    my $field_to = MARC::Field->new(($tag_to?$tag_to:$tag),
1396
		my $exclude='9';
1394
                        $field->indicator(1),$field->indicator(2),"9"=>$mergeto);
1397
                foreach my $subfield (@record_to) {
1395
                    my $exclude='9';
1398
                    $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1396
                    foreach my $subfield (@record_to) {
1399
		    $exclude.= $subfield->[0];
1397
                        $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1400
                }
1398
                        $exclude.= $subfield->[0];
1401
		$exclude='['.$exclude.']';
1399
                    }
1402
#		add subfields in $field not included in @record_to
1400
                    $exclude='['.$exclude.']';
1403
		my @restore= grep {$_->[0]!~/$exclude/} $field->subfields();
1401
                    #add subfields in $field not included in @record_to
1404
                foreach my $subfield (@restore) {
1402
                    my @restore= grep {$_->[0]!~/$exclude/} $field->subfields();
1405
                   $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1403
                    foreach my $subfield (@restore) {
1406
		}
1404
                       $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1407
                $marcrecord->delete_field($field);
1405
                    }
1408
                $marcrecord->insert_grouped_field($field_to);            
1406
                    $marcrecord->delete_field($field);
1409
                $update=1;
1407
                    $marcrecord->insert_grouped_field($field_to);
1408
                    $update=1;
1410
                }
1409
                }
1411
            }#for each tag
1410
            }#for each tag
1412
        }#foreach tagfield
1411
        }#foreach tagfield
1412
1413
        my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ;
1413
        my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ;
1414
        my $biblionumber;
1414
        my $biblionumber;
1415
        if ($bibliotag<10){
1415
        if ($bibliotag<10){
Lines 1424-1483 sub merge { Link Here
1424
        }
1424
        }
1425
        if ($update==1){
1425
        if ($update==1){
1426
            &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;
1426
            &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;
1427
            $counteditedbiblio++;
1427
            push @editedbiblios, $biblionumber;
1428
            warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG});
1428
        }
1429
        }    
1430
    }#foreach $marc
1429
    }#foreach $marc
1431
    return $counteditedbiblio;  
1430
1432
  # now, find every other authority linked with this authority
1431
    return @editedbiblios;
1433
  # now, find every other authority linked with this authority
1432
}
1434
#   my $oConnection=C4::Context->Zconn("authorityserver");
1435
#   my $query;
1436
# # att 9210               Auth-Internal-authtype
1437
# # att 9220               Auth-Internal-LN
1438
# # ccl.properties to add for authorities
1439
#   $query= "= ".$mergefrom;
1440
#   my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
1441
#   my $count=$oResult->size() if  ($oResult);
1442
#   my @reccache;
1443
#   my $z=0;
1444
#   while ( $z<$count ) {
1445
#   my $rec;
1446
#           $rec=$oResult->record($z);
1447
#       my $marcdata = $rec->raw();
1448
#   push @reccache, $marcdata;
1449
#   $z++;
1450
#   }
1451
#   $oResult->destroy();
1452
#   foreach my $marc(@reccache){
1453
#     my $update;
1454
#     my $marcrecord;
1455
#     $marcrecord = MARC::File::USMARC::decode($marc);
1456
#     foreach my $tagfield (@tags_using_authtype){
1457
#       $tagfield=substr($tagfield,0,3);
1458
#       my @tags = $marcrecord->field($tagfield);
1459
#       foreach my $tag (@tags){
1460
#         my $tagsubs=$tag->subfield("9");
1461
#     #warn "$tagfield:$tagsubs:$mergefrom";
1462
#         if ($tagsubs== $mergefrom) {
1463
#           $tag->update("9" =>$mergeto);
1464
#           foreach my $subfield (@record_to) {
1465
#     #        warn "$subfield,$subfield->[0],$subfield->[1]";
1466
#             $tag->update($subfield->[0] =>$subfield->[1]);
1467
#           }#for $subfield
1468
#         }
1469
#         $marcrecord->delete_field($tag);
1470
#         $marcrecord->add_fields($tag);
1471
#         $update=1;
1472
#       }#for each tag
1473
#     }#foreach tagfield
1474
#     my $authoritynumber = TransformMarcToKoha($dbh,$marcrecord,"") ;
1475
#     if ($update==1){
1476
#       &ModAuthority($marcrecord,$authoritynumber,GetAuthTypeCode($authoritynumber)) ;
1477
#     }
1478
# 
1479
#   }#foreach $marc
1480
}#sub
1481
1433
1482
=head2 get_auth_type_location
1434
=head2 get_auth_type_location
1483
1435
(-)a/misc/migration_tools/dedup_authorities.pl (-1 / +584 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
10
use Getopt::Long;
11
use YAML;
12
use List::MoreUtils qw/uniq/;
13
14
my @matchstrings;
15
my $choosemethod = "u";   # by default, choose to keep the most used authority
16
my ($verbose, $all, $help, $wherestring, $test);
17
18
# default is to check all these subfields for 'auth_tag_to_report'
19
my $check = 'TAGabcdefghitxyz';
20
21
my $result = GetOptions (
22
    "match=s"   => \@matchstrings
23
    , "verbose+"  => \$verbose
24
    , "all|a"  => \$all
25
    , "test|t"  => \$test
26
    , "help|h"   => \$help
27
    , "where=s"   => \$wherestring
28
    , "choose-method=s" => \$choosemethod
29
    , "check=s" => \$check
30
);
31
32
if ( $help || ! (@ARGV || $all)) {
33
    print_usage();
34
    exit 0;
35
}
36
37
my @choose_subs;
38
foreach (split //, $choosemethod) {
39
    given($_) {
40
        when ('d') {
41
            push @choose_subs, \&_get_date;
42
        }
43
        when ('p') {
44
            push @choose_subs, \&_has_ppn;
45
        }
46
        when ('u') {
47
            push @choose_subs, \&_get_usage;
48
        }
49
        default {
50
            warn "Choose method '$_' is not supported";
51
        }
52
    }
53
}
54
55
my @checks;
56
foreach my $c (split /,/, $check) {
57
    my $field = substr $c, 0, 3;
58
    my $subfields = substr $c, 3;
59
    if ($field =~ /^[0-9][0-9.]{2}$/ or $field eq "TAG") {
60
        my @subf = grep /^[0-9a-z]$/, uniq split //, $subfields;
61
        if (@subf == 0 and not MARC::Field->is_controlfield_tag($field)) {
62
            die "Field '$field' is not a control field and no subfields are given";
63
        }
64
        if (@subf > 0 and MARC::Field->is_controlfield_tag($field)) {
65
            die "Field '$field' is a control field but you have given subfields";
66
        }
67
        push @checks, {
68
            field => $field,
69
            subfields => \@subf
70
        };
71
    } else {
72
        die "'$field' is not a valid tag";
73
    }
74
}
75
76
my $dbh = C4::Context->dbh;
77
78
$verbose and logger("Fetching authtypecodes...");
79
my $authtypes_ref = $dbh->selectcol_arrayref(
80
    qq{SELECT authtypecode, auth_tag_to_report FROM auth_types},
81
    { Columns=>[1,2] }
82
);
83
my %authtypes=@$authtypes_ref;
84
$verbose and logger("Fetching authtypecodes done.");
85
86
my %biblios;
87
my %authorities;
88
my @authtypecodes = @ARGV ;
89
@authtypecodes = keys %authtypes unless(@authtypecodes);
90
91
unless (@matchstrings) {
92
    @matchstrings = ('at/152b##he/2..abxyz');
93
}
94
95
$verbose and logger("Preparing matchstrings...");
96
my @attempts = prepare_matchstrings(@matchstrings);
97
$verbose and logger("Preparing matchstrings done.");
98
99
for my $authtypecode (@authtypecodes) {
100
    $verbose and logger("Deduping authtype '$authtypecode'");
101
    $verbose and logger("Fetching all authids for '$authtypecode'... ");
102
    my @sqlparams;
103
    my $strselect
104
        = qq{SELECT authid, NULL FROM auth_header where authtypecode=?};
105
    push @sqlparams, $authtypecode;
106
    if ($wherestring) {
107
        $strselect .= " and $wherestring";
108
    }
109
    my $auth_ref
110
        = $dbh->selectcol_arrayref( $strselect, { Columns => [ 1, 2 ] },
111
        @sqlparams );
112
    $verbose and logger("Fetching authids done.");
113
    my $auth_tag = $authtypes{$authtypecode};
114
    my %hash_authorities_authtypecode;
115
    if ($auth_ref){
116
        %hash_authorities_authtypecode=@$auth_ref;
117
        $verbose and logger("Building authorities hash...");
118
        @authorities{keys %hash_authorities_authtypecode} = values %hash_authorities_authtypecode;
119
        $verbose and logger("Building authorities hash done.");
120
    }
121
    $verbose and logger("Start deduping for authtype '$authtypecode'");
122
    my $size = scalar keys %hash_authorities_authtypecode;
123
    my $i = 1;
124
    for my $authid ( keys %hash_authorities_authtypecode ) {
125
        if ($verbose >= 2) {
126
            my $percentage = sprintf("%.2f", $i * 100 / $size);
127
            logger("Processing authority $authid ($i/$size $percentage%)");
128
        } elsif ($verbose and ($i % 100) == 0) {
129
            my $percentage = sprintf("%.2f", $i * 100 / $size);
130
            logger("Progression for authtype '$authtypecode': $i/$size ($percentage%)");
131
        }
132
133
        #authority was marked as duplicate
134
        next if $authorities{$authid};
135
        my $authrecord = GetAuthority($authid);
136
137
        # next if cannot take authority
138
        next unless $authrecord;
139
        SetUTF8Flag($authrecord);
140
        my $success;
141
        for my $attempt (@attempts) {
142
            ($verbose >= 2) and logger("Building query...");
143
            my $query = _build_query( $authrecord, $attempt );
144
            ($verbose >= 2) and logger("Building query done.");
145
            $debug and $query and warn $query;
146
            # This prevent too general queries to be executed
147
            # TODO: This should allow more than these 3 indexes
148
            next unless $query =~ /(he|he-main|ident)(,\S*)*(=|:)/;
149
150
            ($verbose >= 2) and logger("Searching...");
151
            my ($error, $results) = SimpleSearch($query, undef, undef, ["authorityserver"]);
152
            if ( $error || !$results ) {
153
                $debug and warn $@;
154
                $debug and warn $error;
155
                $debug and warn YAML::Dump($query);
156
                $debug and warn $auth_tag;
157
                next;
158
            }
159
            $debug and warn YAML::Dump($results);
160
            next if ( !$results or scalar( @$results ) < 1 );
161
            my @recordids = map {
162
                _get_id( MARC::Record->new_from_usmarc($_) )
163
            } @$results;
164
            ($verbose >= 2) and logger("Searching done.");
165
166
            ($verbose >= 2) and logger("Choosing records...");
167
            my ( $recordid_to_keep, @recordids_to_merge )
168
                = _choose_records( $authid, @recordids );
169
            ($verbose >= 2) and logger("Choosing records done.");
170
            unless ($test or @recordids_to_merge == 0) {
171
                ($verbose >= 2) and logger("Merging ". join(',',@recordids_to_merge) ." into $recordid_to_keep.");
172
                for my $localauthid (@recordids_to_merge) {
173
                    my @editedbiblios = eval {
174
                        merge( $localauthid, undef, $recordid_to_keep, undef )
175
                    };
176
                    if ($@) {
177
                        warn "merging $localauthid into $recordid_to_keep failed :", $@;
178
                    } else {
179
                        for my $biblio (@editedbiblios){
180
                            $biblios{$biblio} = 1;
181
                        }
182
                        $authorities{$localauthid} = 2;
183
                    }
184
                }
185
                ($verbose >= 2) and logger("Merge done.");
186
                $authorities{$recordid_to_keep} = 1;
187
            } elsif ($verbose >= 2) {
188
                if (@recordids_to_merge > 0) {
189
                    logger('Would merge '
190
                        . join(',', @recordids_to_merge)
191
                        . " into $recordid_to_keep.");
192
                } else {
193
                    logger("No duplicates found for $recordid_to_keep");
194
                }
195
            }
196
        }
197
        $i++;
198
    }
199
    $verbose and logger("End of deduping for authtype '$authtypecode'");
200
}
201
202
# Update biblios
203
my @biblios_to_update = grep {defined $biblios{$_} and $biblios{$_} == 1}
204
                            keys %biblios;
205
if( @biblios_to_update > 0 ) {
206
    logger("Updating biblios index (" . scalar(@biblios_to_update) . " biblios to update)");
207
    C4::Search::IndexRecord("biblio", \@biblios_to_update,
208
        { as_xml => 1, record_format => "marcxml" });
209
} else {
210
    logger("No biblios to update");
211
}
212
213
# Update authorities
214
my @authorities_to_update = grep{defined $authorities{$_} and $authorities{$_} == 1}
215
                                keys %authorities;
216
if( @authorities_to_update > 0 ) {
217
    logger("Updating authorities index (" . scalar(@authorities_to_update) . " authorities to update)");
218
    C4::Search::IndexRecord("authority", \@authorities_to_update,
219
        { as_xml => 1, record_format => "marcxml" });
220
} else {
221
    logger("No autorities to update");
222
}
223
224
# Delete authorities
225
my @authorities_to_delete = grep{defined $authorities{$_} and $authorities{$_} == 2}
226
                                keys %authorities;
227
if( @authorities_to_delete > 0 ) {
228
    logger("Deleting authorities from index (" . scalar(@authorities_to_delete) . " authorities to delete)");
229
    C4::Search::DeleteRecordIndex("authority", \@authorities_to_delete,
230
        { as_xml => 1, record_format => "marcxml" });
231
} else {
232
    logger("No authorities to delete");
233
}
234
235
exit 0;
236
237
sub compare_arrays{
238
    my ($arrayref1,$arrayref2)=@_;
239
    return 0 if scalar(@$arrayref1)!=scalar(@$arrayref2);
240
    my $compare=1;
241
    for (my $i=0;$i<scalar(@$arrayref1);$i++){
242
        $compare = ($compare and ($arrayref1->[$i] eq $arrayref2->[$i]));
243
    }
244
    return $compare;
245
}
246
247
sub prepare_matchstrings {
248
    my @structure;
249
    for my $matchstring (@_) {
250
        my @andstrings      = split /##/,$matchstring;
251
        my @matchelements = map {
252
            my $hash;
253
            @$hash{qw(index subfieldtag)} = split '/', $_;
254
            if ($$hash{subfieldtag}=~m/([0-9\.]{3})(.*)/) {
255
                @$hash{qw(tag subfields)}=($1,[ split (//, $2) ]);
256
            }
257
            delete $$hash{subfieldtag};
258
            $hash
259
        } @andstrings;
260
        push @structure , \@matchelements;
261
    }
262
    return @structure;
263
}
264
265
#trims the spaces before and after a string
266
#and normalize the number of spaces inside
267
sub trim{
268
    map{
269
       my $value=$_;
270
       $value=~s/\s+$//g;
271
       $value=~s/^\s+//g;
272
       $value=~s/\s+/ /g;
273
       $value;
274
    }@_
275
}
276
277
sub prepare_strings{
278
    my $authrecord=shift;
279
    my $attempt=shift;
280
    my @stringstosearch;
281
    for my $field ($authrecord->field($attempt->{tag})){
282
        if ($attempt->{tag} le '009'){
283
            if ($field->data()){
284
                push @stringstosearch, trim($field->data());
285
            }
286
        }
287
        else {
288
            if ($attempt->{subfields}){
289
                for my $subfield (@{$attempt->{subfields}}){
290
                    push @stringstosearch, trim(map { NormalizeString($_, undef, 1) } $field->subfield($subfield));
291
                }
292
            }
293
            else {
294
                push @stringstosearch,  trim(map { NormalizeString($_, undef, 1) } $field->as_string());
295
            }
296
297
        }
298
    }
299
    return map {
300
                ( $_
301
                ?  qq<$$attempt{'index'}=\"$_\">
302
                : () )
303
            }@stringstosearch;
304
}
305
306
sub _build_query{
307
    my $authrecord = shift;
308
    my $attempt = shift;
309
    if ($attempt) {
310
        my $query = join ' AND ', map {
311
            prepare_strings($authrecord, $_)
312
        } @$attempt;
313
        return $query;
314
    }
315
    return;
316
}
317
318
sub _get_id {
319
    my $record = shift;
320
321
    if($record and (my $field = $record->field('001'))) {
322
        return $field->data();
323
    }
324
    return 0;
325
}
326
327
sub _has_ppn {
328
    my $record = shift;
329
330
    if($record and (my $field = $record->field('009'))) {
331
        return $field->data() ? 1 : 0;
332
    }
333
    return 0;
334
}
335
336
sub _get_date {
337
    my $record = shift;
338
339
    if($record and (my $field = $record->field('005'))) {
340
        return $field->data();
341
    }
342
    return 0;
343
}
344
345
sub _get_usage {
346
    my $record = shift;
347
348
    if($record and (my $field = $record->field('001'))) {
349
        return CountUsage($field->data());
350
    }
351
    return 0;
352
}
353
354
=head2 _choose_records
355
    this function takes input of candidate record ids to merging
356
    and returns
357
        first the record to merge to
358
        and list of records to merge from
359
=cut
360
sub _choose_records {
361
    my @recordids = @_;
362
363
    my @records = map { GetAuthority($_) } @recordids;
364
    my @candidate_auths =
365
      grep { _is_duplicate( $recordids[0], $records[0], _get_id($_), $_ ) }
366
      ( @records[ 1 .. $#records ] );
367
368
    # See http://www.sysarch.com/Perl/sort_paper.html Schwartzian transform
369
    my @candidate_authids =
370
        map $_->[0] =>
371
        sort {
372
            $b->[1] <=> $a->[1] ||
373
            $b->[2] <=> $a->[2] ||
374
            $b->[3] <=> $a->[3]
375
        }
376
        map [
377
            _get_id($_),
378
            $choose_subs[0] ? $choose_subs[0]->($_) : 0,
379
            $choose_subs[1] ? $choose_subs[1]->($_) : 0,
380
            $choose_subs[2] ? $choose_subs[2]->($_) : 0
381
        ] =>
382
        ( $records[0], @candidate_auths );
383
384
    return @candidate_authids;
385
}
386
387
sub compare_subfields {
388
    my ($field1, $field2, $subfields) = @_;
389
390
    my $certainty = 1;
391
    foreach my $subfield (@$subfields) {
392
        $debug && warn "Comparing ". $field1->tag() ."\$$subfield ",
393
            "to ". $field2->tag(). "\$$subfield";
394
395
        my @subfields1 = $field1->subfield($subfield);
396
        my @subfields2 = $field2->subfield($subfield);
397
398
        if (compare_arrays([ trim(@subfields1) ], [ trim(@subfields2) ])) {
399
            $debug && warn "certainty 1 ", @subfields1, " ", @subfields2;
400
        } else {
401
            $debug && warn "certainty 0 ", @subfields1, " ", @subfields2;
402
            $certainty = 0;
403
            last;
404
        }
405
    }
406
407
    return $certainty;
408
}
409
410
sub _is_duplicate {
411
    my ( $authid1, $authrecord, $authid2, $marc ) = @_;
412
    return 0 if ( $authid1 == $authid2 );
413
    $authrecord ||= GetAuthority($authid1);
414
    $marc       ||= GetAuthority($authid2);
415
    if (!$authrecord){
416
        warn "no or bad record for $authid1";
417
        return 0;
418
    }
419
    if (!$marc){
420
        warn "no or bad record for $authid2";
421
        return 0;
422
    }
423
    my $at1        = GetAuthTypeCode($authid1);
424
    if (!$at1){
425
        warn "no or bad authoritytypecode for $authid1";
426
        return 0;
427
    }
428
    my $auth_tag   = $authtypes{$at1} if (exists $authtypes{$at1});
429
    my $at2        = GetAuthTypeCode($authid2);
430
    if (!$at2){
431
        warn "no or bad authoritytypecode for $authid2";
432
        return 0;
433
    }
434
    my $auth_tag2  = $authtypes{$at2} if (exists $authtypes{$at2});
435
    $debug and warn YAML::Dump($authrecord);
436
    $debug and warn YAML::Dump($marc);
437
    SetUTF8Flag($authrecord);
438
    SetUTF8Flag($marc);
439
    my $certainty = 1;
440
441
    $debug and warn "_is_duplicate ($authid1, $authid2)";
442
    if ( $marc->field($auth_tag2)
443
        and !( $authrecord->field($auth_tag) ) )
444
    {
445
        $debug && warn "certainty 0 ";
446
        return 0;
447
    }
448
    elsif ( $authrecord->field($auth_tag)
449
        && !( $marc->field($auth_tag2) ) )
450
    {
451
        $debug && warn "certainty 0 ";
452
        return 0;
453
    }
454
455
    foreach my $check (@checks) {
456
        last if ($certainty == 0);
457
        my $field = $check->{field};
458
        my $subfields = $check->{subfields};
459
        my ($tag1, $tag2) = ($field, $field);
460
        if ($field eq "TAG") {
461
            $tag1 = $auth_tag;
462
            $tag2 = $auth_tag2;
463
        }
464
465
        my @fields1 = $marc->field($tag1);
466
        my @fields2 = $authrecord->field($tag2);
467
        if (scalar @fields1 != scalar @fields2) {
468
            $debug && warn "Not the same number of fields: ",
469
                "id $authid1: ". scalar @fields1 ." fields '$tag1', ",
470
                "id $authid2: ". scalar @fields2 ." fields '$tag2'.";
471
            $certainty = 0;
472
            last;
473
        }
474
475
        for (my $i=0; $i<@fields1; $i++) {
476
            if (@$subfields > 0) {
477
                $certainty = compare_subfields($fields1[$i], $fields2[$i], $subfields);
478
                last if ($certainty == 0);
479
            } else {
480
                $debug && warn "Comparing ".$fields1[$i]->tag()." data ",
481
                    "to ".$fields2[$i]->tag()." data";
482
                if ($fields1[$i]->data() ne $fields2[$i]->data()) {
483
                    $debug && warn "certainty 0 ", $fields1[$i]->data(), " ",
484
                        $fields2[$i]->data();
485
                    $certainty = 0;
486
                    last;
487
                }
488
            }
489
        }
490
    }
491
492
    return $certainty;
493
}
494
495
sub logger {
496
    my ($sec, $min, $hour, $mday, $mon, $year) = localtime;
497
    my $time_msg = sprintf "[%04d-%02d-%02d %02d:%02d:%02d]",
498
        1900+$year, 1+$mon, $mday, $hour, $min, $sec;
499
    say $time_msg, ' ', @_;
500
}
501
502
sub print_usage {
503
    print <<_USAGE_;
504
$0: deduplicate authorities
505
506
Use this batch job to remove duplicate authorities
507
508
Parameters:
509
    --match <matchstring>
510
511
        matchstring is composed of : index1/tagsubfield1[##index2/tagsubfield2]
512
        the matching will be done with an AND between all elements of ONE
513
        matchstring.
514
        tagsubfield can be 123a or 123abc or 123.
515
516
        If multiple match parameters are sent, then it will try to match in the
517
        order it is provided to the script.
518
519
        Examples:
520
            at/152b##he-main/2..a##he/2..bxyzt##ident/009
521
            authtype/152b##he-main,ext/2..a##he,ext/2..bxyz
522
            sn,ne,st-numeric/001##authtype/152b##he-main,ext/2..a##he,ext/2..bxyz
523
524
        Match strings MUST contains at least one of the
525
        following indexes: he, he-main and ident
526
527
528
    --check <tag1><subfieldcodes>[,<tag2><subfieldcodes>[,...]]
529
530
        Check only these fields and subfields to determine whether two
531
        authorities are duplicates.
532
533
        <tag> is a three-digit number which represents the field tag, or the
534
        string 'TAG' which represents auth_tag_to_report and depends on
535
        authtypecode. You can use '.' as wildcards. E.g. '2..'
536
537
        <subfieldcodes> is a list of subfield codes, matching [0-9a-z]
538
539
        Examples:
540
            200abxyz will check subfields a,b,x,y,z of 200 fields
541
            009,152b will check 009 data and 152\$b subfields
542
            TAGab will check 250\$a and 250\$b if auth_tag_to_report is 250 for
543
                the type of the authority currently being checked
544
545
        Default: TAGabcdefghitxyz
546
547
548
    --choose-method <methods>
549
550
        Method(s) used to choose which authority to keep in case we found
551
        duplicates.
552
        <methods> is a string composed of letters describing what methods to use
553
        and in which order.
554
        Letters can be:
555
            d:  date, keep the most recent authority (based on 005 field)
556
            u:  usage, keep the most used authority
557
            p:  PPN (UNIMARC only), keep the authority with a ppn (when some
558
                authorities don't have one, based on 009 field)
559
560
        Examples:
561
            'pdu':  Among the authorities that have a PPN, keep the most recent,
562
                    and if two (or more) have the same date in 005, keep the
563
                    most used.
564
565
        Default is 'u'
566
        You cannot type more than 3 letters
567
568
569
    --where <sqlstring>     limit the deduplication to SOME authorities only
570
571
    --verbose               display logs
572
573
    --all                   deduplicate all authority type
574
575
    --help or -h            show this message.
576
577
Other paramters :
578
   Authtypecode to deduplicate authorities on
579
exemple:
580
    $0 --match ident/009 --match he-main,ext/200a##he,ext/200bxz NC
581
582
Note : If launched with DEBUG=1 it will print more messages
583
_USAGE_
584
}

Return to bug 7419