- 

#!/usr/bin/perl

use Modern::Perl;

use C4::Context;

use C4::AuthoritiesMarc;

use C4::Biblio;

use C4::Search;

use C4::Charset;

use C4::Heading;

use Koha::SearchEngine;

use Koha::SearchEngine::QueryBuilder;

use Koha::Logger;

use Koha::Authorities;

use Getopt::Long;

use YAML;

use List::MoreUtils qw/uniq/;

=head1 NAME

misc/migration_tools/dedup_authorities.pl - Deduping authorities script

=head1 SYNOPSIS

dedup_authorities.pl [ -h ] [ -where="authid < 5000" ] -c [ -v ] [ -m d ] [ -a PERSO_NAME ]

 Options:

     -h --help          display usage statement

     -v --verbose       increase verbosity, can be repeated for greater verbosity

     -m --method        method for choosing the reference authority, can be: date, used, or ppn (UNIMARC)

                        can be repeated

     -w --where         a SQL WHERE statement to limit the authority records checked

     -c --confirm       without this parameter no changes will be made, script will run in test mode

     -a --authtypecode  check only specified auth type, repeatable

=head1 OPTIONS

=over

=item B<--method>

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:

    date:  keep the most recent authority (based on 005 field)

    used:  keep the most used authority

    ppn:   PPN (UNIMARC only), keep the authority with a ppn (when some

        authorities don't have one, based on 009 field)

Example:

-m ppn -m date -m used

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 'used'

=item B<--where>

limit the deduplication to SOME authorities only

Example:

-where="authid < 5000"

will only auths with a low auth_id (old records)

=item B<--verbose>

display verbose loggin, can be repeated twice for more info

=item B<--help>

show usage information.

=back

=cut

my @methods;

my @authtypecodes;

my $help = 0;

my $confirm = 0;

my $verbose = 0;

my $wherestring = "";

my $debug = 0;

my $result = GetOptions (

    "d|debug"          => \$debug,

    "v|verbose+"       => \$verbose,

    "c|confirm"        => \$confirm,

    "h|help"           => \$help,

    "w|where=s"        => \$wherestring,

    "m|method=s"       => \@methods,

    "a|authtypecode=s" => \@authtypecodes

);

pod2usage( -verbose => 2) if ($help);

print "RUNNING IN TEST MODE, NO CHANGES WILL BE MADE\n" unless $confirm;

$verbose = 1 unless ( $confirm || $verbose );

my @choose_subs;

@methods = ('used') unless @methods;

foreach my $method ( @methods ) {

    if ($method  eq 'date') {

        push @choose_subs, \&_get_date;

    }

    elsif( $method eq 'ppn') {

        die 'PPN method is only valid for UNIMARC'

            unless( C4::Context->preference('marcflavour') eq 'UNIMARC' );

        push @choose_subs, \&_has_ppn;

    }

    elsif( $method eq 'used') {

        push @choose_subs, \&_get_usage;

    }

    else {

        warn "Choose method '$method' is not supported";

    }

}

my $dbh = C4::Context->dbh;

$verbose and print "Fetching authtypecodes...\n";

my $params = undef;

if( @authtypecodes ){

$params = { authtypecode => { -in => \@authtypecodes } };

}

my @auth_types = Koha::Authority::Types->search($params);

my %auth_match_headings = map { $_->authtypecode => $_->auth_tag_to_report } @auth_types;

$verbose and print "Fetching authtypecodes done.\n";

my %biblios;

my $seen;

for my $authtype (@auth_types) {

    my $authtypecode = $authtype->authtypecode;

    my %duplicated;

    my $deleted = 0;

    my $updated_bibs = 0;

    my $i = 0;

    $verbose and print "Deduping authtype '$authtypecode' \n";

    $verbose and print "Fetching authorities for '$authtypecode'... ";

    my $authorities = Koha::Authorities->search({ authtypecode => $authtypecode });

    $authorities = $authorities->search( \$wherestring ) if $wherestring;

    my $size = $authorities->count;

    $verbose and print "$size authorities found\n";

    while ( my $authority = $authorities->next ) {

        next if defined $seen->{ $authority->authid };

        $seen->{ $authority->authid } = 1;

        $i++;

        if ($verbose >= 2) {

            my $percentage = sprintf("%.2f", $i * 100 / $size);

            print "Processing authority " . $authority->authid ." ($i/$size $percentage%)\n";

        } elsif ($verbose and ($i % 100) == 0) {

            my $percentage = sprintf("%.2f", $i * 100 / $size);

            print "Progression for authtype '$authtypecode': $i/$size ($percentage%)\n";

        }

        #authority was marked as duplicate

        next if defined $duplicated{$authority->authid};

        my $authrecord = C4::AuthoritiesMarc::GetAuthority($authority->authid);

        next unless $authrecord;

        C4::Charset::SetUTF8Flag($authrecord);

        $debug and print "Building query...\n";

        my $field = $authrecord->field( $auth_match_headings{ $authtypecode } );

        unless ( $field ){

            warn "Malformed authority record, no heading";

            next;

        }

        my $heading = C4::Heading->new_from_field( $field, undef, 1 ); #new auth heading

        my $search_term = $heading->search_form;

        $debug and print "Building query done\n";

        $debug and print "$search_term\n";

        $debug and print "Searching...";

#my ($error, $results) = SimpleSearch("match-heading:\"$search_term\"", undef, undef, ["authorityserver"]);

        my $builder = Koha::SearchEngine::QueryBuilder->new({ index => $Koha::SearchEngine::AUTHORITIES_INDEX } );

        my $searcher = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::AUTHORITIES_INDEX });

        my $query = $builder->build_authorities_query_compat(['match-heading'],[''],[''],['exact'],[$search_term],$authtypecode,'');

        my ( $results,$total ) = $searcher->search_auth_compat( $query, 0, 50, undef );

        if ( !$results ) {

            $debug and warn $@;

            $debug and warn YAML::Dump($search_term);

            $debug and warn $field->as_string;

            next;

        }

        $debug and warn YAML::Dump($results);

        my @recordids = map { $_->{authid} != $authority->authid ? $_->{authid} : () } @$results;

        if ( !$results || scalar( @$results ) < 1 || scalar @recordids < 1 ){

            ($verbose >= 2) and print 'No duplicates found for ' . $heading->display_form . "\n";

            next;

        }

        map {  $seen->{ $_ } = 1 } @recordids;

        $debug and print "Searching done.\n";

        $debug and print "Choosing records...";

        my ( $recordid_to_keep, @recordids_to_merge )

            = _choose_records( $authority->authid, @recordids );

        $debug and print "Choosing records done.\n";

        unless (!$confirm or @recordids_to_merge == 0) {

            ($verbose >= 2) and print "Merging ". join(',',@recordids_to_merge) ." into $recordid_to_keep.\n";

            for my $localauthid (@recordids_to_merge) {

                next if $recordid_to_keep == $localauthid;

                my @editedbiblios = eval {

                    C4::AuthoritiesMarc::merge({

                        merge_from => $localauthid,

                        MARCfrom   => undef,

                        mergeto    => $recordid_to_keep,

                        MARCto     => undef

                    });

                };

                if ($@) {

                    warn "merging $localauthid into $recordid_to_keep failed :", $@;

                } else {

                    print "Updated " . scalar @editedbiblios . " biblios\n";

                    $updated_bibs += scalar @editedbiblios;

                    $duplicated{$localauthid} = 2;

                    print "Deleting $localauthid\n";

                    C4::AuthoritiesMarc::DelAuthority({ authid => $localauthid, skip_merge => 1 });

                    $deleted++;

                }

            }

            ($verbose >= 2) and print "Merge done.\n";

            $duplicated{$recordid_to_keep} = 1;

        } elsif ($verbose >= 2) {

            if (@recordids_to_merge > 0) {

                print 'Would merge '

                    . join(',', @recordids_to_merge)

                    . " into $recordid_to_keep (".$heading->display_form.")\n";

            } else {

                print "No duplicates found for $recordid_to_keep\n";

            }

        }

    }

    $verbose and print "End of deduping for authtype '$authtypecode'\n";

    $verbose and print "Updated $updated_bibs biblios\n";

    $verbose and print "Deleted $deleted authorities\n";

}

# Update biblios

my @biblios_to_update = grep {defined $biblios{$_} and $biblios{$_} == 1}

                            keys %biblios;

if( @biblios_to_update > 0 ) {

} else {

    print "No biblios to update\n";

}

exit 0;

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 Koha::Authorities->get_usage_count({ authid => $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 { C4::AuthoritiesMarc::GetAuthority($_) } @recordids;

    my @candidate_auths = @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;

}