#!/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/;
use Pod::Usage      qw( pod2usage );

=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 logging, 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)->as_list;
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;
        }
        unless ( $field->as_string ) {
            warn "    Malformed authority record, blank 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 $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 $MARCto        = C4::AuthoritiesMarc::GetAuthority($recordid_to_keep);
                my $editedbiblios = 0;
                eval {
                    $editedbiblios = C4::AuthoritiesMarc::merge(
                        {
                            mergefrom => $localauthid,
                            MARCfrom  => undef,
                            mergeto   => $recordid_to_keep,
                            MARCto    => $MARCto
                        }
                    );
                };
                if ($@) {
                    warn "    Merging $localauthid into $recordid_to_keep failed :",
                        $@;
                } else {
                    print "    Updated " . $editedbiblios . " biblios\n";
                    $updated_bibs += $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

    @record_ids = _choose_records(@record_ids);

    This function sorts the list of record ids, based on the passed
    methods (see script options).
    By default, it sorts on usage count.
    It is used in the main loop to decide which record to keep.

=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 ] => (@candidate_auths);

    return @candidate_authids;
}
