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

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

Return to bug 7419