From 2f99b64c6e4cde7eb113ed447ce40e507d4b7aba Mon Sep 17 00:00:00 2001
From: Julian Maurice <julian.maurice@biblibre.com>
Date: Fri, 27 Jul 2012 12:30:41 +0200
Subject: [PATCH 2/2] Bug 7419: New script dedup_authorities.pl

This script allow to deduplicate authorities automatically.

It works this way:
 1) authorities are fetched from the database. You can limit fetched
 results by authtypecode, or directly by specifying WHERE clause
 2) for each authority:
  2.1) build a Zebra query, depending on --match parameter(s)
  2.2) run the query, retrieve the results
  2.3) for each result check if result is really a duplicate. check is
  customizable with option --check.
  2.4) among real duplicates, choose the one we want to keep (use
  --choose-method option).
  2.5) use C4::Authorities::merge to merge authorities
 3) index updated biblios and authorities, and remove from index
 removed authorities

Use --help for more informations on options

Script is in misc/migration_tools/
---
 C4/AuthoritiesMarc.pm                     |  114 ++----
 misc/migration_tools/dedup_authorities.pl |  585 +++++++++++++++++++++++++++++
 2 files changed, 618 insertions(+), 81 deletions(-)
 create mode 100755 misc/migration_tools/dedup_authorities.pl

diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm
index 21ebd94..45a46e8 100644
--- a/C4/AuthoritiesMarc.pm
+++ b/C4/AuthoritiesMarc.pm
@@ -1300,7 +1300,7 @@ Then we should add some new parameter : bibliotargettag, authtargettag
 
 sub merge {
     my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
-    my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);        
+    my @editedbiblios;
     my $dbh=C4::Context->dbh;
     my $authtypecodefrom = GetAuthTypeCode($mergefrom);
     my $authtypecodeto = GetAuthTypeCode($mergeto);
@@ -1314,17 +1314,17 @@ sub merge {
     my ($auth_tag_to_report_from) = $sth->fetchrow;
     $sth->execute($authtypecodeto);
     my ($auth_tag_to_report_to) = $sth->fetchrow;
-    
+
     my @record_to;
     @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to);
     my @record_from;
     @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
-    
+
     my @reccache;
     # search all biblio tags using this authority.
     #Getting marcbiblios impacted by the change.
     if (C4::Context->preference('NoZebra')) {
-        #nozebra way    
+        #nozebra way
         my $dbh=C4::Context->dbh;
         my $rq=$dbh->prepare(qq(SELECT biblionumbers from nozebra where indexname="an" and server="biblioserver" and value="$mergefrom" ));
         $rq->execute;
@@ -1373,41 +1373,41 @@ sub merge {
     while (my ($tagfield) = $sth->fetchrow) {
         push @tags_using_authtype,$tagfield ;
     }
-    my $tag_to=0;  
-    if ($authtypecodeto ne $authtypecodefrom){  
+    my $tag_to=0;
+    if ($authtypecodeto ne $authtypecodefrom){
         # If many tags, take the first
-        $sth->execute($authtypecodeto);    
+        $sth->execute($authtypecodeto);
         $tag_to=$sth->fetchrow;
-        #warn $tag_to;    
-    }  
+    }
     # BulkEdit marc records
-    # May be used as a template for a bulkedit field  
+    # May be used as a template for a bulkedit field
     foreach my $marcrecord(@reccache){
-        my $update;           
+        my $update;
         foreach my $tagfield (@tags_using_authtype){
-#             warn "tagfield : $tagfield ";
             foreach my $field ($marcrecord->field($tagfield)){
                 my $auth_number=$field->subfield("9");
-                my $tag=$field->tag();          
+                my $tag=$field->tag();
                 if ($auth_number==$mergefrom) {
-                my $field_to=MARC::Field->new(($tag_to?$tag_to:$tag),$field->indicator(1),$field->indicator(2),"9"=>$mergeto);
-		my $exclude='9';
-                foreach my $subfield (@record_to) {
-                    $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
-		    $exclude.= $subfield->[0];
-                }
-		$exclude='['.$exclude.']';
-#		add subfields in $field not included in @record_to
-		my @restore= grep {$_->[0]!~/$exclude/} $field->subfields();
-                foreach my $subfield (@restore) {
-                   $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
-		}
-                $marcrecord->delete_field($field);
-                $marcrecord->insert_grouped_field($field_to);            
-                $update=1;
+                    my $field_to = MARC::Field->new(($tag_to?$tag_to:$tag),
+                        $field->indicator(1),$field->indicator(2),"9"=>$mergeto);
+                    my $exclude='9';
+                    foreach my $subfield (@record_to) {
+                        $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
+                        $exclude.= $subfield->[0];
+                    }
+                    $exclude='['.$exclude.']';
+                    #add subfields in $field not included in @record_to
+                    my @restore= grep {$_->[0]!~/$exclude/} $field->subfields();
+                    foreach my $subfield (@restore) {
+                       $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
+                    }
+                    $marcrecord->delete_field($field);
+                    $marcrecord->insert_grouped_field($field_to);
+                    $update=1;
                 }
             }#for each tag
         }#foreach tagfield
+
         my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ;
         my $biblionumber;
         if ($bibliotag<10){
@@ -1422,60 +1422,12 @@ sub merge {
         }
         if ($update==1){
             &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;
-            $counteditedbiblio++;
-            warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG});
-        }    
+            push @editedbiblios, $biblionumber;
+        }
     }#foreach $marc
-    return $counteditedbiblio;  
-  # now, find every other authority linked with this authority
-  # now, find every other authority linked with this authority
-#   my $oConnection=C4::Context->Zconn("authorityserver");
-#   my $query;
-# # att 9210               Auth-Internal-authtype
-# # att 9220               Auth-Internal-LN
-# # ccl.properties to add for authorities
-#   $query= "= ".$mergefrom;
-#   my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
-#   my $count=$oResult->size() if  ($oResult);
-#   my @reccache;
-#   my $z=0;
-#   while ( $z<$count ) {
-#   my $rec;
-#           $rec=$oResult->record($z);
-#       my $marcdata = $rec->raw();
-#   push @reccache, $marcdata;
-#   $z++;
-#   }
-#   $oResult->destroy();
-#   foreach my $marc(@reccache){
-#     my $update;
-#     my $marcrecord;
-#     $marcrecord = MARC::File::USMARC::decode($marc);
-#     foreach my $tagfield (@tags_using_authtype){
-#       $tagfield=substr($tagfield,0,3);
-#       my @tags = $marcrecord->field($tagfield);
-#       foreach my $tag (@tags){
-#         my $tagsubs=$tag->subfield("9");
-#     #warn "$tagfield:$tagsubs:$mergefrom";
-#         if ($tagsubs== $mergefrom) {
-#           $tag->update("9" =>$mergeto);
-#           foreach my $subfield (@record_to) {
-#     #        warn "$subfield,$subfield->[0],$subfield->[1]";
-#             $tag->update($subfield->[0] =>$subfield->[1]);
-#           }#for $subfield
-#         }
-#         $marcrecord->delete_field($tag);
-#         $marcrecord->add_fields($tag);
-#         $update=1;
-#       }#for each tag
-#     }#foreach tagfield
-#     my $authoritynumber = TransformMarcToKoha($dbh,$marcrecord,"") ;
-#     if ($update==1){
-#       &ModAuthority($marcrecord,$authoritynumber,GetAuthTypeCode($authoritynumber)) ;
-#     }
-# 
-#   }#foreach $marc
-}#sub
+
+    return @editedbiblios;
+}
 
 =head2 get_auth_type_location
 
diff --git a/misc/migration_tools/dedup_authorities.pl b/misc/migration_tools/dedup_authorities.pl
new file mode 100755
index 0000000..47e7eb0
--- /dev/null
+++ b/misc/migration_tools/dedup_authorities.pl
@@ -0,0 +1,585 @@
+#!/usr/bin/perl
+use Modern::Perl;
+use C4::Context;
+use C4::AuthoritiesMarc;
+use C4::Biblio;
+use C4::Search;
+use C4::Charset;
+use C4::Debug;
+use C4::ZebraIndex;
+
+use Getopt::Long;
+use YAML;
+use List::MoreUtils qw/uniq/;
+
+my @matchstrings;
+my $choosemethod = "u";   # by default, choose to keep the most used authority
+my ($verbose, $all, $help, $wherestring, $test);
+
+# default is to check all these subfields for 'auth_tag_to_report'
+my $check = 'TAGabcdefghitxyz';
+
+my $result = GetOptions (
+    "match=s"   => \@matchstrings
+    , "verbose+"  => \$verbose
+    , "all|a"  => \$all
+    , "test|t"  => \$test
+    , "help|h"   => \$help
+    , "where=s"   => \$wherestring
+    , "choose-method=s" => \$choosemethod
+    , "check=s" => \$check
+);
+
+if ( $help || ! (@ARGV || $all)) {
+    print_usage();
+    exit 0;
+}
+
+my @choose_subs;
+foreach (split //, $choosemethod) {
+    given($_) {
+        when ('d') {
+            push @choose_subs, \&_get_date;
+        }
+        when ('p') {
+            push @choose_subs, \&_has_ppn;
+        }
+        when ('u') {
+            push @choose_subs, \&_get_usage;
+        }
+        default {
+            warn "Choose method '$_' is not supported";
+        }
+    }
+}
+
+my @checks;
+foreach my $c (split /,/, $check) {
+    my $field = substr $c, 0, 3;
+    my $subfields = substr $c, 3;
+    if ($field =~ /^[0-9][0-9.]{2}$/ or $field eq "TAG") {
+        my @subf = grep /^[0-9a-z]$/, uniq split //, $subfields;
+        if (@subf == 0 and not MARC::Field->is_controlfield_tag($field)) {
+            die "Field '$field' is not a control field and no subfields are given";
+        }
+        if (@subf > 0 and MARC::Field->is_controlfield_tag($field)) {
+            die "Field '$field' is a control field but you have given subfields";
+        }
+        push @checks, {
+            field => $field,
+            subfields => \@subf
+        };
+    } else {
+        die "'$field' is not a valid tag";
+    }
+}
+
+my $dbh = C4::Context->dbh;
+
+$verbose and logger("Fetching authtypecodes...");
+my $authtypes_ref = $dbh->selectcol_arrayref(
+    qq{SELECT authtypecode, auth_tag_to_report FROM auth_types},
+    { Columns=>[1,2] }
+);
+my %authtypes=@$authtypes_ref;
+$verbose and logger("Fetching authtypecodes done.");
+
+my %biblios;
+my %authorities;
+my @authtypecodes = @ARGV ;
+@authtypecodes = keys %authtypes unless(@authtypecodes);
+
+unless (@matchstrings) {
+    @matchstrings = ('at/152b##he/2..abxyz');
+}
+
+$verbose and logger("Preparing matchstrings...");
+my @attempts = prepare_matchstrings(@matchstrings);
+$verbose and logger("Preparing matchstrings done.");
+
+for my $authtypecode (@authtypecodes) {
+    $verbose and logger("Deduping authtype '$authtypecode'");
+    $verbose and logger("Fetching all authids for '$authtypecode'... ");
+    my @sqlparams;
+    my $strselect
+        = qq{SELECT authid, NULL FROM auth_header where authtypecode=?};
+    push @sqlparams, $authtypecode;
+    if ($wherestring) {
+        $strselect .= " and $wherestring";
+    }
+    my $auth_ref
+        = $dbh->selectcol_arrayref( $strselect, { Columns => [ 1, 2 ] },
+        @sqlparams );
+    $verbose and logger("Fetching authids done.");
+    my $auth_tag = $authtypes{$authtypecode};
+    my %hash_authorities_authtypecode;
+    if ($auth_ref){
+        %hash_authorities_authtypecode=@$auth_ref;
+        $verbose and logger("Building authorities hash...");
+        @authorities{keys %hash_authorities_authtypecode} = values %hash_authorities_authtypecode;
+        $verbose and logger("Building authorities hash done.");
+    }
+    $verbose and logger("Start deduping for authtype '$authtypecode'");
+    my $size = scalar keys %hash_authorities_authtypecode;
+    my $i = 1;
+    for my $authid ( keys %hash_authorities_authtypecode ) {
+        if ($verbose >= 2) {
+            my $percentage = sprintf("%.2f", $i * 100 / $size);
+            logger("Processing authority $authid ($i/$size $percentage%)");
+        } elsif ($verbose and ($i % 100) == 0) {
+            my $percentage = sprintf("%.2f", $i * 100 / $size);
+            logger("Progression for authtype '$authtypecode': $i/$size ($percentage%)");
+        }
+
+        #authority was marked as duplicate
+        next if $authorities{$authid};
+        my $authrecord = GetAuthority($authid);
+
+        # next if cannot take authority
+        next unless $authrecord;
+        SetUTF8Flag($authrecord);
+        my $success;
+        for my $attempt (@attempts) {
+            ($verbose >= 2) and logger("Building query...");
+            my $query = _build_query( $authrecord, $attempt );
+            ($verbose >= 2) and logger("Building query done.");
+            $debug and $query and warn $query;
+            # This prevent too general queries to be executed
+            # TODO: This should allow more than these 3 indexes
+            next unless $query =~ /(he|he-main|ident)(,\S*)*(=|:)/;
+
+            ($verbose >= 2) and logger("Searching...");
+            my ($error, $results) = SimpleSearch($query, undef, undef, ["authorityserver"]);
+            if ( $error || !$results ) {
+                $debug and warn $@;
+                $debug and warn $error;
+                $debug and warn YAML::Dump($query);
+                $debug and warn $auth_tag;
+                next;
+            }
+            $debug and warn YAML::Dump($results);
+            next if ( !$results or scalar( @$results ) < 1 );
+            my @recordids = map {
+                _get_id( MARC::Record->new_from_usmarc($_) )
+            } @$results;
+            ($verbose >= 2) and logger("Searching done.");
+
+            ($verbose >= 2) and logger("Choosing records...");
+            my ( $recordid_to_keep, @recordids_to_merge )
+                = _choose_records( $authid, @recordids );
+            ($verbose >= 2) and logger("Choosing records done.");
+            unless ($test or @recordids_to_merge == 0) {
+                ($verbose >= 2) and logger("Merging ". join(',',@recordids_to_merge) ." into $recordid_to_keep.");
+                for my $localauthid (@recordids_to_merge) {
+                    my @editedbiblios = eval {
+                        merge( $localauthid, undef, $recordid_to_keep, undef )
+                    };
+                    if ($@) {
+                        warn "merging $localauthid into $recordid_to_keep failed :", $@;
+                    } else {
+                        for my $biblio (@editedbiblios){
+                            $biblios{$biblio} = 1;
+                        }
+                        $authorities{$localauthid} = 2;
+                    }
+                }
+                ($verbose >= 2) and logger("Merge done.");
+                $authorities{$recordid_to_keep} = 1;
+            } elsif ($verbose >= 2) {
+                if (@recordids_to_merge > 0) {
+                    logger('Would merge '
+                        . join(',', @recordids_to_merge)
+                        . " into $recordid_to_keep.");
+                } else {
+                    logger("No duplicates found for $recordid_to_keep");
+                }
+            }
+        }
+        $i++;
+    }
+    $verbose and logger("End of deduping for authtype '$authtypecode'");
+}
+
+# Update biblios
+my @biblios_to_update = grep {defined $biblios{$_} and $biblios{$_} == 1}
+                            keys %biblios;
+if( @biblios_to_update > 0 ) {
+    logger("Updating biblios index (" . scalar(@biblios_to_update) . " biblios to update)");
+    C4::ZebraIndex::IndexRecord("biblio", \@biblios_to_update,
+        { as_xml => 1, record_format => "marcxml" });
+} else {
+    logger("No biblios to update");
+}
+
+# Update authorities
+my @authorities_to_update = grep{defined $authorities{$_} and $authorities{$_} == 1}
+                                keys %authorities;
+if( @authorities_to_update > 0 ) {
+    logger("Updating authorities index (" . scalar(@authorities_to_update) . " authorities to update)");
+    C4::ZebraIndex::IndexRecord("authority", \@authorities_to_update,
+        { as_xml => 1, record_format => "marcxml" });
+} else {
+    logger("No autorities to update");
+}
+
+# Delete authorities
+my @authorities_to_delete = grep{defined $authorities{$_} and $authorities{$_} == 2}
+                                keys %authorities;
+if( @authorities_to_delete > 0 ) {
+    logger("Deleting authorities from index (" . scalar(@authorities_to_delete) . " authorities to delete)");
+    C4::ZebraIndex::DeleteRecordIndex("authority", \@authorities_to_delete,
+        { as_xml => 1, record_format => "marcxml" });
+} else {
+    logger("No authorities to delete");
+}
+
+exit 0;
+
+sub compare_arrays{
+    my ($arrayref1,$arrayref2)=@_;
+    return 0 if scalar(@$arrayref1)!=scalar(@$arrayref2);
+    my $compare=1;
+    for (my $i=0;$i<scalar(@$arrayref1);$i++){
+        $compare = ($compare and ($arrayref1->[$i] eq $arrayref2->[$i]));
+    }
+    return $compare;
+}
+
+sub prepare_matchstrings {
+    my @structure;
+    for my $matchstring (@_) {
+        my @andstrings      = split /##/,$matchstring;
+        my @matchelements = map {
+            my $hash;
+            @$hash{qw(index subfieldtag)} = split '/', $_;
+            if ($$hash{subfieldtag}=~m/([0-9\.]{3})(.*)/) {
+                @$hash{qw(tag subfields)}=($1,[ split (//, $2) ]);
+            }
+            delete $$hash{subfieldtag};
+            $hash
+        } @andstrings;
+        push @structure , \@matchelements;
+    }
+    return @structure;
+}
+
+#trims the spaces before and after a string
+#and normalize the number of spaces inside
+sub trim{
+    map{
+       my $value=$_;
+       $value=~s/\s+$//g;
+       $value=~s/^\s+//g;
+       $value=~s/\s+/ /g;
+       $value;
+    }@_
+}
+
+sub prepare_strings{
+    my $authrecord=shift;
+    my $attempt=shift;
+    my @stringstosearch;
+    for my $field ($authrecord->field($attempt->{tag})){
+        if ($attempt->{tag} le '009'){
+            if ($field->data()){
+                push @stringstosearch, trim($field->data());
+            }
+        }
+        else {
+            if ($attempt->{subfields}){
+                for my $subfield (@{$attempt->{subfields}}){
+                    push @stringstosearch, trim(map { NormalizeString($_, undef, 1) } $field->subfield($subfield));
+                }
+            }
+            else {
+                push @stringstosearch,  trim(map { NormalizeString($_, undef, 1) } $field->as_string());
+            }
+
+        }
+    }
+    return map {
+                ( $_
+                ?  qq<$$attempt{'index'}=\"$_\">
+                : () )
+            }@stringstosearch;
+}
+
+sub _build_query{
+    my $authrecord = shift;
+    my $attempt = shift;
+    if ($attempt) {
+        my $query = join ' AND ', map {
+            prepare_strings($authrecord, $_)
+        } @$attempt;
+        return $query;
+    }
+    return;
+}
+
+sub _get_id {
+    my $record = shift;
+
+    if($record and (my $field = $record->field('001'))) {
+        return $field->data();
+    }
+    return 0;
+}
+
+sub _has_ppn {
+    my $record = shift;
+
+    if($record and (my $field = $record->field('009'))) {
+        return $field->data() ? 1 : 0;
+    }
+    return 0;
+}
+
+sub _get_date {
+    my $record = shift;
+
+    if($record and (my $field = $record->field('005'))) {
+        return $field->data();
+    }
+    return 0;
+}
+
+sub _get_usage {
+    my $record = shift;
+
+    if($record and (my $field = $record->field('001'))) {
+        return CountUsage($field->data());
+    }
+    return 0;
+}
+
+=head2 _choose_records
+    this function takes input of candidate record ids to merging
+    and returns
+        first the record to merge to
+        and list of records to merge from
+=cut
+sub _choose_records {
+    my @recordids = @_;
+
+    my @records = map { GetAuthority($_) } @recordids;
+    my @candidate_auths =
+      grep { _is_duplicate( $recordids[0], $records[0], _get_id($_), $_ ) }
+      ( @records[ 1 .. $#records ] );
+
+    # See http://www.sysarch.com/Perl/sort_paper.html Schwartzian transform
+    my @candidate_authids =
+        map $_->[0] =>
+        sort {
+            $b->[1] <=> $a->[1] ||
+            $b->[2] <=> $a->[2] ||
+            $b->[3] <=> $a->[3]
+        }
+        map [
+            _get_id($_),
+            $choose_subs[0] ? $choose_subs[0]->($_) : 0,
+            $choose_subs[1] ? $choose_subs[1]->($_) : 0,
+            $choose_subs[2] ? $choose_subs[2]->($_) : 0
+        ] =>
+        ( $records[0], @candidate_auths );
+
+    return @candidate_authids;
+}
+
+sub compare_subfields {
+    my ($field1, $field2, $subfields) = @_;
+
+    my $certainty = 1;
+    foreach my $subfield (@$subfields) {
+        $debug && warn "Comparing ". $field1->tag() ."\$$subfield ",
+            "to ". $field2->tag(). "\$$subfield";
+
+        my @subfields1 = $field1->subfield($subfield);
+        my @subfields2 = $field2->subfield($subfield);
+
+        if (compare_arrays([ trim(@subfields1) ], [ trim(@subfields2) ])) {
+            $debug && warn "certainty 1 ", @subfields1, " ", @subfields2;
+        } else {
+            $debug && warn "certainty 0 ", @subfields1, " ", @subfields2;
+            $certainty = 0;
+            last;
+        }
+    }
+
+    return $certainty;
+}
+
+sub _is_duplicate {
+    my ( $authid1, $authrecord, $authid2, $marc ) = @_;
+    return 0 if ( $authid1 == $authid2 );
+    $authrecord ||= GetAuthority($authid1);
+    $marc       ||= GetAuthority($authid2);
+    if (!$authrecord){
+        warn "no or bad record for $authid1";
+        return 0;
+    }
+    if (!$marc){
+        warn "no or bad record for $authid2";
+        return 0;
+    }
+    my $at1        = GetAuthTypeCode($authid1);
+    if (!$at1){
+        warn "no or bad authoritytypecode for $authid1";
+        return 0;
+    }
+    my $auth_tag   = $authtypes{$at1} if (exists $authtypes{$at1});
+    my $at2        = GetAuthTypeCode($authid2);
+    if (!$at2){
+        warn "no or bad authoritytypecode for $authid2";
+        return 0;
+    }
+    my $auth_tag2  = $authtypes{$at2} if (exists $authtypes{$at2});
+    $debug and warn YAML::Dump($authrecord);
+    $debug and warn YAML::Dump($marc);
+    SetUTF8Flag($authrecord);
+    SetUTF8Flag($marc);
+    my $certainty = 1;
+
+    $debug and warn "_is_duplicate ($authid1, $authid2)";
+    if ( $marc->field($auth_tag2)
+        and !( $authrecord->field($auth_tag) ) )
+    {
+        $debug && warn "certainty 0 ";
+        return 0;
+    }
+    elsif ( $authrecord->field($auth_tag)
+        && !( $marc->field($auth_tag2) ) )
+    {
+        $debug && warn "certainty 0 ";
+        return 0;
+    }
+
+    foreach my $check (@checks) {
+        last if ($certainty == 0);
+        my $field = $check->{field};
+        my $subfields = $check->{subfields};
+        my ($tag1, $tag2) = ($field, $field);
+        if ($field eq "TAG") {
+            $tag1 = $auth_tag;
+            $tag2 = $auth_tag2;
+        }
+
+        my @fields1 = $marc->field($tag1);
+        my @fields2 = $authrecord->field($tag2);
+        if (scalar @fields1 != scalar @fields2) {
+            $debug && warn "Not the same number of fields: ",
+                "id $authid1: ". scalar @fields1 ." fields '$tag1', ",
+                "id $authid2: ". scalar @fields2 ." fields '$tag2'.";
+            $certainty = 0;
+            last;
+        }
+
+        for (my $i=0; $i<@fields1; $i++) {
+            if (@$subfields > 0) {
+                $certainty = compare_subfields($fields1[$i], $fields2[$i], $subfields);
+                last if ($certainty == 0);
+            } else {
+                $debug && warn "Comparing ".$fields1[$i]->tag()." data ",
+                    "to ".$fields2[$i]->tag()." data";
+                if ($fields1[$i]->data() ne $fields2[$i]->data()) {
+                    $debug && warn "certainty 0 ", $fields1[$i]->data(), " ",
+                        $fields2[$i]->data();
+                    $certainty = 0;
+                    last;
+                }
+            }
+        }
+    }
+
+    return $certainty;
+}
+
+sub logger {
+    my ($sec, $min, $hour, $mday, $mon, $year) = localtime;
+    my $time_msg = sprintf "[%04d-%02d-%02d %02d:%02d:%02d]",
+        1900+$year, 1+$mon, $mday, $hour, $min, $sec;
+    say $time_msg, ' ', @_;
+}
+
+sub print_usage {
+    print <<_USAGE_;
+$0: deduplicate authorities
+
+Use this batch job to remove duplicate authorities
+
+Parameters:
+    --match <matchstring>
+
+        matchstring is composed of : index1/tagsubfield1[##index2/tagsubfield2]
+        the matching will be done with an AND between all elements of ONE
+        matchstring.
+        tagsubfield can be 123a or 123abc or 123.
+
+        If multiple match parameters are sent, then it will try to match in the
+        order it is provided to the script.
+
+        Examples:
+            at/152b##he-main/2..a##he/2..bxyzt##ident/009
+            authtype/152b##he-main,ext/2..a##he,ext/2..bxyz
+            sn,ne,st-numeric/001##authtype/152b##he-main,ext/2..a##he,ext/2..bxyz
+
+        Match strings MUST contains at least one of the
+        following indexes: he, he-main and ident
+
+
+    --check <tag1><subfieldcodes>[,<tag2><subfieldcodes>[,...]]
+
+        Check only these fields and subfields to determine whether two
+        authorities are duplicates.
+
+        <tag> is a three-digit number which represents the field tag, or the
+        string 'TAG' which represents auth_tag_to_report and depends on
+        authtypecode. You can use '.' as wildcards. E.g. '2..'
+
+        <subfieldcodes> is a list of subfield codes, matching [0-9a-z]
+
+        Examples:
+            200abxyz will check subfields a,b,x,y,z of 200 fields
+            009,152b will check 009 data and 152\$b subfields
+            TAGab will check 250\$a and 250\$b if auth_tag_to_report is 250 for
+                the type of the authority currently being checked
+
+        Default: TAGabcdefghitxyz
+
+
+    --choose-method <methods>
+
+        Method(s) used to choose which authority to keep in case we found
+        duplicates.
+        <methods> is a string composed of letters describing what methods to use
+        and in which order.
+        Letters can be:
+            d:  date, keep the most recent authority (based on 005 field)
+            u:  usage, keep the most used authority
+            p:  PPN (UNIMARC only), keep the authority with a ppn (when some
+                authorities don't have one, based on 009 field)
+
+        Examples:
+            'pdu':  Among the authorities that have a PPN, keep the most recent,
+                    and if two (or more) have the same date in 005, keep the
+                    most used.
+
+        Default is 'u'
+        You cannot type more than 3 letters
+
+
+    --where <sqlstring>     limit the deduplication to SOME authorities only
+
+    --verbose               display logs
+
+    --all                   deduplicate all authority type
+
+    --help or -h            show this message.
+
+Other paramters :
+   Authtypecode to deduplicate authorities on
+exemple:
+    $0 --match ident/009 --match he-main,ext/200a##he,ext/200bxz NC
+
+Note : If launched with DEBUG=1 it will print more messages
+_USAGE_
+}
-- 
1.7.10.4