Attachment #175414 for bug #29238

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





use Modern::Perl;
use Getopt::Long qw( GetOptions );
use Pod::Usage   qw( pod2usage );
use Time::HiRes  qw( gettimeofday );

use Koha::Script -cron;
use C4::AuthoritiesMarc qw( GetAuthority merge );
use C4::Log             qw( cronlogaction );
use Koha::Authority::MergeRequests;

use constant RESET_HOURS => 24;
use constant REMOVE_DAYS => 30;

my ($params);
my $command_line_options = join( " ", @ARGV );
GetOptions(
    'h' => \$params->{help},
    'v' => \$params->{verbose},
    'b' => \$params->{batch},
);

$| = 1;    # flushes output
if ( $params->{batch} ) {
    cronlogaction( { info => $command_line_options } );
    handle_batch($params);

}

sub handle_batch {
    my $params  = shift;
    my $verbose = $params->{verbose};

    my $starttime = gettimeofday;
    print "Started merging\n" if $verbose;

    Koha::Authority::MergeRequests->cron_cleanup( { reset_hours => RESET_HOURS, remove_days => REMOVE_DAYS } );
    my $rs = Koha::Authority::MergeRequests->search(
        { done     => 0 },
        { order_by => { -asc => 'id' } },    # IMPORTANT
    );

    # For best results, postponed merges should be applied in right order.
    # Similarly, we do not only select the last one for a specific id.

    while ( my $req = $rs->next ) {
        $req->done(2)->store;
        print "Merging auth " . $req->authid . " to " . ( $req->authid_new // 'NULL' ) . ".\n" if $verbose;
        my $newmarc =
            $req->authid_new
            ? GetAuthority( $req->authid_new )
            : undef;

        # Following merge call handles both modifications and deletes
        merge(
            {
                mergefrom      => $req->authid,
                MARCfrom       => scalar $req->oldmarc,
                mergeto        => $req->authid_new,
                MARCto         => $newmarc,
                override_limit => 1,
            }
        );
        $req->done(1)->store;
    }
    my $timeneeded = gettimeofday - $starttime;




);
use C4::Log qw( cronlogaction );
use Koha::Biblios;
use Getopt::Long              qw( GetOptions );
use Pod::Usage                qw( pod2usage );
use Time::HiRes               qw( time );
use POSIX                     qw( ceil strftime );
use Module::Load::Conditional qw( can_load );

use Koha::Database;

my $tagtolink;
my $allowrelink = C4::Context->preference("LinkerRelink") // '';

my $command_line_options = join( " ", @ARGV );
my $result               = GetOptions(
    'v|verbose'      => \$verbose,
    't|test'         => \$test_only,
    'l|link-report'  => \$link_report,


cronlogaction( { info => $command_line_options } );

my $linker_module = "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
  "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
unless ( can_load( modules => { $linker_module => undef } ) ) {
    $linker_module = 'C4::Linker::Default';
    unless ( can_load( modules => { $linker_module => undef } ) ) {

my %unlinked_headings;
my %linked_headings;
my %fuzzy_headings;
my $dbh             = C4::Context->dbh;
my @updated_biblios = ();
my $indexer         = Koha::SearchEngine::Indexer->new( { index => $Koha::SearchEngine::BIBLIOS_INDEX } );

my $schema = Koha::Database->schema;
$schema->txn_begin;
process_bibs( $linker, $bib_limit, $auth_limit, $commit, { tagtolink => $tagtolink, allowrelink => $allowrelink } );

exit 0;

sub process_bibs {
    my ( $linker, $bib_limit, $auth_limit, $commit, $args ) = @_;
    my $tagtolink   = $args->{tagtolink};
    my $allowrelink = $args->{allowrelink};
    my $bib_where   = '';
    my $starttime   = time();
    if ($bib_limit) {
        $bib_where = "WHERE $bib_limit";
    }
    my $sql = "SELECT biblionumber FROM biblio $bib_where ORDER BY biblionumber ASC";
      "SELECT biblionumber FROM biblio $bib_where ORDER BY biblionumber ASC";
    my $sth = $dbh->prepare($sql);
    $sth->execute();
    my $linker_args = { tagtolink => $tagtolink, allowrelink => $allowrelink };

    for ( values %unlinked_headings ) { $headings_unlinked += $_; }
    for ( values %fuzzy_headings )    { $headings_fuzzy    += $_; }

    my $endtime   = time();
    my $totaltime = ceil( ( $endtime - $starttime ) * 1000 );
    $starttime = strftime( '%D %T', localtime($starttime) );
    $endtime   = strftime( '%D %T', localtime($endtime) );

    my $summary = <<_SUMMARY_;



_LINKED_HEADER_

        @keys = sort { $linked_headings{$b} <=> $linked_headings{$a} or "\L$a" cmp "\L$b" } keys %linked_headings;
            $linked_headings{$b} <=> $linked_headings{$a} or "\L$a" cmp "\L$b"
        } keys %linked_headings;
        foreach my $key (@keys) {
            print "$key:\t" . $linked_headings{$key} . " occurrences\n";
        }


_UNLINKED_HEADER_

        @keys = sort { $unlinked_headings{$b} <=> $unlinked_headings{$a} or "\L$a" cmp "\L$b" } keys %unlinked_headings;
            $unlinked_headings{$b} <=> $unlinked_headings{$a}
              or "\L$a" cmp "\L$b"
        } keys %unlinked_headings;
        foreach my $key (@keys) {
            print "$key:\t" . $unlinked_headings{$key} . " occurrences\n";
        }


_FUZZY_HEADER_

        @keys = sort { $fuzzy_headings{$b} <=> $fuzzy_headings{$a} or "\L$a" cmp "\L$b" } keys %fuzzy_headings;
            $fuzzy_headings{$b} <=> $fuzzy_headings{$a} or "\L$a" cmp "\L$b"
        } keys %fuzzy_headings;
        foreach my $key (@keys) {
            print "$key:\t" . $fuzzy_headings{$key} . " occurrences\n";
        }

sub process_bib {
    my $linker       = shift;
    my $biblionumber = shift;
    my $args         = shift;
    my $tagtolink    = $args->{tagtolink};
    my $allowrelink  = $args->{allowrelink};
    my $biblio       = Koha::Biblios->find($biblionumber);
    my $record;
    eval { $record = $biblio->metadata->record; };

    unless ( defined $record ) {
        warn "Could not retrieve bib $biblionumber from the database - record is corrupt.";
        $num_bad_bibs++;

            );
        }
        if ( not $test_only ) {
            ModBiblio(
                $record,
                $biblionumber,
                $frameworkcode,
                {
                    disable_autolink  => 1,
                    skip_holds_queue  => 1,
                    skip_record_index => 1
                }
            );
            push @updated_biblios, $biblionumber;

            #Last param is to note ModBiblio was called from linking script and bib should not be linked again
            $num_bibs_modified++;
        }




use Koha::Script;
use C4::Context;
use C4::AuthoritiesMarc qw( DelAuthority );
use C4::Log             qw( cronlogaction );
use Getopt::Long        qw( GetOptions );

use Koha::SearchEngine::Search;

my @authtypes;
my ( $confirm, $test, $want_help );
my $command_line_options = join( " ", @ARGV );
GetOptions(
    'aut|authtypecode:s' => \@authtypes,
    'c|confirm'          => \$confirm,

    'h|help'             => \$want_help,
);

if ( $want_help || !( $test || $confirm ) ) {
    print_usage();
    exit 0;
}

    print "*** Testing only, authorities will not be deleted. ***\n";
}
if (@authtypes) {
    print "Restricted to authority type(s) : " . join( ',', @authtypes ) . ".\n";
}

my $searcher = Koha::SearchEngine::Search->new( { index => 'biblios' } );
my $checksearch;
if ( C4::Context->preference("SearchEngine") eq 'Zebra' ) {

    # Check server state
    my $errZebraConnection = C4::Context->Zconn( "biblioserver", 0 )->errcode();
    if ( $errZebraConnection == 10000 ) {
        die "Zebra server seems not to be available. This script needs Zebra runs.";
    } elsif ($errZebraConnection) {
        die "Error from Zebra: $errZebraConnection";
    }
    $checksearch = q{an,alwaysmatches=''};
} else {
else {
    $checksearch = q{an:*};
}

# Check search on authority number as at least one result
my ( $err, $res, $nb ) = $searcher->simple_search_compat( $checksearch, 0, 10 );
unless ( $nb > 0 ) {
    die "Searching authority number in biblio records seems not to be available : $checksearch";
}

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

# prepare the request to retrieve all authorities of the requested types
my $rqsql = q{ SELECT authid,authtypecode FROM auth_header };
$rqsql .= q{ WHERE authtypecode IN (} . join( ',', map { '?' } @authtypes ) . ')' if @authtypes;
my $rqselect = $dbh->prepare($rqsql);
$| = 1;

$rqselect->execute(@authtypes);
my $counter      = 0;
my $totdeleted   = 0;
my $totundeleted = 0;
while ( my $data = $rqselect->fetchrow_hashref ) {
    $counter++;
    print 'authid=' . $data->{'authid'};
    print ' type=' . $data->{'authtypecode'};
    my $bibliosearch = 'an:' . $data->{'authid'};

    # search for biblios mapped
    my ( $err, $res, $used ) = $searcher->simple_search_compat( $bibliosearch, 0, 10 );
    if ( defined $err ) {
        print "\n";
        warn "Error: $err on search for biblios $bibliosearch\n";
        next;
    }
    unless ( $used > 0 ) {
        unless ($test) {
            DelAuthority( { authid => $data->{'authid'}, skip_merge => 1 } );
            print " : deleted";
        } else {
            print " : can be deleted";
- 

Return to bug 29238

Lines 26-35 use C4::Biblio qw( Link Here

(-)a/misc/link_bibs_to_authorities.pl (-38 / +36 lines)
26	);	26	);
27	use C4::Log qw( cronlogaction );	27	use C4::Log qw( cronlogaction );
28	use Koha::Biblios;	28	use Koha::Biblios;
29	use Getopt::Long qw( GetOptions );	29	use Getopt::Long qw( GetOptions );
30	use Pod::Usage qw( pod2usage );	30	use Pod::Usage qw( pod2usage );
31	use Time::HiRes qw( time );	31	use Time::HiRes qw( time );
32	use POSIX qw( ceil strftime );	32	use POSIX qw( ceil strftime );
33	use Module::Load::Conditional qw( can_load );	33	use Module::Load::Conditional qw( can_load );
34		34
35	use Koha::Database;	35	use Koha::Database;
Lines 54-61 my $commit = 100; Link Here
54	my $tagtolink;	54	my $tagtolink;
55	my $allowrelink = C4::Context->preference("LinkerRelink") // '';	55	my $allowrelink = C4::Context->preference("LinkerRelink") // '';
56		56
57	my $command_line_options = join(" ", @ARGV);	57	my $command_line_options = join( " ", @ARGV );
58	my $result = GetOptions(	58	my $result = GetOptions(
59	'v\|verbose' => \$verbose,	59	'v\|verbose' => \$verbose,
60	't\|test' => \$test_only,	60	't\|test' => \$test_only,
61	'l\|link-report' => \$link_report,	61	'l\|link-report' => \$link_report,
Lines 74-81 if ( not $result or $want_help ) { Link Here
74		74
75	cronlogaction( { info => $command_line_options } );	75	cronlogaction( { info => $command_line_options } );
76		76
77	my $linker_module =	77	my $linker_module = "C4::Linker::" . ( C4::Context->preference("LinkerModule") \|\| 'Default' );
78	"C4::Linker::" . ( C4::Context->preference("LinkerModule") \|\| 'Default' );
79	unless ( can_load( modules => { $linker_module => undef } ) ) {	78	unless ( can_load( modules => { $linker_module => undef } ) ) {
80	$linker_module = 'C4::Linker::Default';	79	$linker_module = 'C4::Linker::Default';
81	unless ( can_load( modules => { $linker_module => undef } ) ) {	80	unless ( can_load( modules => { $linker_module => undef } ) ) {
Lines 96-122 my $num_bad_bibs = 0; Link Here
96	my %unlinked_headings;	95	my %unlinked_headings;
97	my %linked_headings;	96	my %linked_headings;
98	my %fuzzy_headings;	97	my %fuzzy_headings;
99	my $dbh = C4::Context->dbh;	98	my $dbh = C4::Context->dbh;
100	my @updated_biblios = ();	99	my @updated_biblios = ();
101	my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });	100	my $indexer = Koha::SearchEngine::Indexer->new( { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
102		101
103	my $schema = Koha::Database->schema;	102	my $schema = Koha::Database->schema;
104	$schema->txn_begin;	103	$schema->txn_begin;
105	process_bibs( $linker, $bib_limit, $auth_limit, $commit, { tagtolink => $tagtolink, allowrelink => $allowrelink });	104	process_bibs( $linker, $bib_limit, $auth_limit, $commit, { tagtolink => $tagtolink, allowrelink => $allowrelink } );
106		105
107	exit 0;	106	exit 0;
108		107
109	sub process_bibs {	108	sub process_bibs {
110	my ( $linker, $bib_limit, $auth_limit, $commit, $args ) = @_;	109	my ( $linker, $bib_limit, $auth_limit, $commit, $args ) = @_;
111	my $tagtolink = $args->{tagtolink};	110	my $tagtolink = $args->{tagtolink};
112	my $allowrelink = $args->{allowrelink};	111	my $allowrelink = $args->{allowrelink};
113	my $bib_where = '';	112	my $bib_where = '';
114	my $starttime = time();	113	my $starttime = time();
115	if ($bib_limit) {	114	if ($bib_limit) {
116	$bib_where = "WHERE $bib_limit";	115	$bib_where = "WHERE $bib_limit";
117	}	116	}
118	my $sql =	117	my $sql = "SELECT biblionumber FROM biblio $bib_where ORDER BY biblionumber ASC";
119	"SELECT biblionumber FROM biblio $bib_where ORDER BY biblionumber ASC";
120	my $sth = $dbh->prepare($sql);	118	my $sth = $dbh->prepare($sql);
121	$sth->execute();	119	$sth->execute();
122	my $linker_args = { tagtolink => $tagtolink, allowrelink => $allowrelink };	120	my $linker_args = { tagtolink => $tagtolink, allowrelink => $allowrelink };
Lines 141-150 sub process_bibs { Link Here
141	for ( values %unlinked_headings ) { $headings_unlinked += $_; }	139	for ( values %unlinked_headings ) { $headings_unlinked += $_; }
142	for ( values %fuzzy_headings ) { $headings_fuzzy += $_; }	140	for ( values %fuzzy_headings ) { $headings_fuzzy += $_; }
143		141
144	my $endtime = time();	142	my $endtime = time();
145	my $totaltime = ceil (($endtime - $starttime) * 1000);	143	my $totaltime = ceil( ( $endtime - $starttime ) * 1000 );
146	$starttime = strftime('%D %T', localtime($starttime));	144	$starttime = strftime( '%D %T', localtime($starttime) );
147	$endtime = strftime('%D %T', localtime($endtime));	145	$endtime = strftime( '%D %T', localtime($endtime) );
148		146
149	my $summary = <<_SUMMARY_;	147	my $summary = <<_SUMMARY_;
150		148
Lines 173-181 Linked headings (from most frequent to least): Link Here
173		171
174	_LINKED_HEADER_	172	_LINKED_HEADER_
175		173
176	@keys = sort {	174	@keys = sort { $linked_headings{$b} <=> $linked_headings{$a} or "\L$a" cmp "\L$b" } keys %linked_headings;
177	$linked_headings{$b} <=> $linked_headings{$a} or "\L$a" cmp "\L$b"
178	} keys %linked_headings;
179	foreach my $key (@keys) {	175	foreach my $key (@keys) {
180	print "$key:\t" . $linked_headings{$key} . " occurrences\n";	176	print "$key:\t" . $linked_headings{$key} . " occurrences\n";
181	}	177	}
Lines 187-196 Unlinked headings (from most frequent to least): Link Here
187		183
188	_UNLINKED_HEADER_	184	_UNLINKED_HEADER_
189		185
190	@keys = sort {	186	@keys = sort { $unlinked_headings{$b} <=> $unlinked_headings{$a} or "\L$a" cmp "\L$b" } keys %unlinked_headings;
191	$unlinked_headings{$b} <=> $unlinked_headings{$a}
192	or "\L$a" cmp "\L$b"
193	} keys %unlinked_headings;
194	foreach my $key (@keys) {	187	foreach my $key (@keys) {
195	print "$key:\t" . $unlinked_headings{$key} . " occurrences\n";	188	print "$key:\t" . $unlinked_headings{$key} . " occurrences\n";
196	}	189	}
Lines 202-210 Fuzzily-matched headings (from most frequent to least): Link Here
202		195
203	_FUZZY_HEADER_	196	_FUZZY_HEADER_
204		197
205	@keys = sort {	198	@keys = sort { $fuzzy_headings{$b} <=> $fuzzy_headings{$a} or "\L$a" cmp "\L$b" } keys %fuzzy_headings;
206	$fuzzy_headings{$b} <=> $fuzzy_headings{$a} or "\L$a" cmp "\L$b"
207	} keys %fuzzy_headings;
208	foreach my $key (@keys) {	199	foreach my $key (@keys) {
209	print "$key:\t" . $fuzzy_headings{$key} . " occurrences\n";	200	print "$key:\t" . $fuzzy_headings{$key} . " occurrences\n";
210	}	201	}
Lines 215-226 _FUZZY_HEADER_ Link Here
215	sub process_bib {	206	sub process_bib {
216	my $linker = shift;	207	my $linker = shift;
217	my $biblionumber = shift;	208	my $biblionumber = shift;
218	my $args = shift;	209	my $args = shift;
219	my $tagtolink = $args->{tagtolink};	210	my $tagtolink = $args->{tagtolink};
220	my $allowrelink = $args->{allowrelink};	211	my $allowrelink = $args->{allowrelink};
221	my $biblio = Koha::Biblios->find($biblionumber);	212	my $biblio = Koha::Biblios->find($biblionumber);
222	my $record;	213	my $record;
223	eval { $record = $biblio->metadata->record; };	214	eval { $record = $biblio->metadata->record; };
		215
224	unless ( defined $record ) {	216	unless ( defined $record ) {
225	warn "Could not retrieve bib $biblionumber from the database - record is corrupt.";	217	warn "Could not retrieve bib $biblionumber from the database - record is corrupt.";
226	$num_bad_bibs++;	218	$num_bad_bibs++;
Lines 262-273 sub process_bib { Link Here
262	);	254	);
263	}	255	}
264	if ( not $test_only ) {	256	if ( not $test_only ) {
265	ModBiblio( $record, $biblionumber, $frameworkcode, {	257	ModBiblio(
266	disable_autolink => 1,	258	$record,
267	skip_holds_queue => 1,	259	$biblionumber,
268	skip_record_index =>1	260	$frameworkcode,
269	});	261	{
		262	disable_autolink => 1,
		263	skip_holds_queue => 1,
		264	skip_record_index => 1
		265	}
		266	);
270	push @updated_biblios, $biblionumber;	267	push @updated_biblios, $biblionumber;
		268
271	#Last param is to note ModBiblio was called from linking script and bib should not be linked again	269	#Last param is to note ModBiblio was called from linking script and bib should not be linked again
272	$num_bibs_modified++;	270	$num_bibs_modified++;
273	}	271	}

Lines 25-38 use Modern::Perl; Link Here

(-)a/misc/migration_tools/remove_unused_authorities.pl (-27 / +29 lines)
25	use Koha::Script;	25	use Koha::Script;
26	use C4::Context;	26	use C4::Context;
27	use C4::AuthoritiesMarc qw( DelAuthority );	27	use C4::AuthoritiesMarc qw( DelAuthority );
28	use C4::Log qw( cronlogaction );	28	use C4::Log qw( cronlogaction );
29	use Getopt::Long qw( GetOptions );	29	use Getopt::Long qw( GetOptions );
30		30
31	use Koha::SearchEngine::Search;	31	use Koha::SearchEngine::Search;
32		32
33	my @authtypes;	33	my @authtypes;
34	my ($confirm, $test, $want_help);	34	my ( $confirm, $test, $want_help );
35	my $command_line_options = join(" ", @ARGV);	35	my $command_line_options = join( " ", @ARGV );
36	GetOptions(	36	GetOptions(
37	'aut\|authtypecode:s' => \@authtypes,	37	'aut\|authtypecode:s' => \@authtypes,
38	'c\|confirm' => \$confirm,	38	'c\|confirm' => \$confirm,
Lines 40-46 GetOptions( Link Here
40	'h\|help' => \$want_help,	40	'h\|help' => \$want_help,
41	);	41	);
42		42
43	if ( $want_help \|\| !($test \|\| $confirm) ) {	43	if ( $want_help \|\| !( $test \|\| $confirm ) ) {
44	print_usage();	44	print_usage();
45	exit 0;	45	exit 0;
46	}	46	}
Lines 51-106 if ($test) { Link Here
51	print "* Testing only, authorities will not be deleted. *\n";	51	print "* Testing only, authorities will not be deleted. *\n";
52	}	52	}
53	if (@authtypes) {	53	if (@authtypes) {
54	print "Restricted to authority type(s) : ".join(',', @authtypes).".\n";	54	print "Restricted to authority type(s) : " . join( ',', @authtypes ) . ".\n";
55	}	55	}
56		56
57	my $searcher = Koha::SearchEngine::Search->new( { index => 'biblios' } );	57	my $searcher = Koha::SearchEngine::Search->new( { index => 'biblios' } );
58	my $checksearch;	58	my $checksearch;
59	if ( C4::Context->preference("SearchEngine") eq 'Zebra' ) {	59	if ( C4::Context->preference("SearchEngine") eq 'Zebra' ) {
		60
60	# Check server state	61	# Check server state
61	my $errZebraConnection = C4::Context->Zconn("biblioserver",0)->errcode();	62	my $errZebraConnection = C4::Context->Zconn( "biblioserver", 0 )->errcode();
62	if ( $errZebraConnection == 10000 ) {	63	if ( $errZebraConnection == 10000 ) {
63	die "Zebra server seems not to be available. This script needs Zebra runs.";	64	die "Zebra server seems not to be available. This script needs Zebra runs.";
64	} elsif ( $errZebraConnection ) {	65	} elsif ($errZebraConnection) {
65	die "Error from Zebra: $errZebraConnection";	66	die "Error from Zebra: $errZebraConnection";
66	}	67	}
67	$checksearch = q{an,alwaysmatches=''};	68	$checksearch = q{an,alwaysmatches=''};
68	}	69	} else {
69	else {
70	$checksearch = q{an:*};	70	$checksearch = q{an:*};
71	}	71	}
		72
72	# Check search on authority number as at least one result	73	# Check search on authority number as at least one result
73	my ($err,$res,$nb) = $searcher->simple_search_compat($checksearch,0,10);	74	my ( $err, $res, $nb ) = $searcher->simple_search_compat( $checksearch, 0, 10 );
74	unless ($nb > 0) {	75	unless ( $nb > 0 ) {
75	die "Searching authority number in biblio records seems not to be available : $checksearch";	76	die "Searching authority number in biblio records seems not to be available : $checksearch";
76	}	77	}
77		78
78	my $dbh=C4::Context->dbh;	79	my $dbh = C4::Context->dbh;
		80
79	# prepare the request to retrieve all authorities of the requested types	81	# prepare the request to retrieve all authorities of the requested types
80	my $rqsql = q{ SELECT authid,authtypecode FROM auth_header };	82	my $rqsql = q{ SELECT authid,authtypecode FROM auth_header };
81	$rqsql .= q{ WHERE authtypecode IN (}.join(',',map{ '?' }@authtypes).')' if @authtypes;	83	$rqsql .= q{ WHERE authtypecode IN (} . join( ',', map { '?' } @authtypes ) . ')' if @authtypes;
82	my $rqselect = $dbh->prepare($rqsql);	84	my $rqselect = $dbh->prepare($rqsql);
83	$\|=1;	85	$\| = 1;
84		86
85	$rqselect->execute(@authtypes);	87	$rqselect->execute(@authtypes);
86	my $counter=0;	88	my $counter = 0;
87	my $totdeleted=0;	89	my $totdeleted = 0;
88	my $totundeleted=0;	90	my $totundeleted = 0;
89	while (my $data=$rqselect->fetchrow_hashref){	91	while ( my $data = $rqselect->fetchrow_hashref ) {
90	$counter++;	92	$counter++;
91	print 'authid='.$data->{'authid'};	93	print 'authid=' . $data->{'authid'};
92	print ' type='.$data->{'authtypecode'};	94	print ' type=' . $data->{'authtypecode'};
93	my $bibliosearch = 'an:'.$data->{'authid'};	95	my $bibliosearch = 'an:' . $data->{'authid'};
		96
94	# search for biblios mapped	97	# search for biblios mapped
95	my ($err,$res,$used) = $searcher->simple_search_compat($bibliosearch,0,10);	98	my ( $err, $res, $used ) = $searcher->simple_search_compat( $bibliosearch, 0, 10 );
96	if (defined $err) {	99	if ( defined $err ) {
97	print "\n";	100	print "\n";
98	warn "Error: $err on search for biblios $bibliosearch\n";	101	warn "Error: $err on search for biblios $bibliosearch\n";
99	next;	102	next;
100	}	103	}
101	unless ($used > 0){	104	unless ( $used > 0 ) {
102	unless ($test) {	105	unless ($test) {
103	DelAuthority({ authid => $data->{'authid'}, skip_merge => 1 });	106	DelAuthority( { authid => $data->{'authid'}, skip_merge => 1 } );
104	print " : deleted";	107	print " : deleted";
105	} else {	108	} else {
106	print " : can be deleted";	109	print " : can be deleted";
107	-

Lines 2-27 Link Here

(-)a/misc/cronjobs/merge_authorities.pl (-19 / +24 lines)
2		2
3	use Modern::Perl;	3	use Modern::Perl;
4	use Getopt::Long qw( GetOptions );	4	use Getopt::Long qw( GetOptions );
5	use Pod::Usage qw( pod2usage );	5	use Pod::Usage qw( pod2usage );
6	use Time::HiRes qw( gettimeofday );	6	use Time::HiRes qw( gettimeofday );
7		7
8	use Koha::Script -cron;	8	use Koha::Script -cron;
9	use C4::AuthoritiesMarc qw( GetAuthority merge );	9	use C4::AuthoritiesMarc qw( GetAuthority merge );
10	use C4::Log qw( cronlogaction );	10	use C4::Log qw( cronlogaction );
11	use Koha::Authority::MergeRequests;	11	use Koha::Authority::MergeRequests;
12		12
13	use constant RESET_HOURS => 24;	13	use constant RESET_HOURS => 24;
14	use constant REMOVE_DAYS => 30;	14	use constant REMOVE_DAYS => 30;
15		15
16	my ( $params );	16	my ($params);
17	my $command_line_options = join(" ", @ARGV);	17	my $command_line_options = join( " ", @ARGV );
18	GetOptions(	18	GetOptions(
19	'h' => \$params->{help},	19	'h' => \$params->{help},
20	'v' => \$params->{verbose},	20	'v' => \$params->{verbose},
21	'b' => \$params->{batch},	21	'b' => \$params->{batch},
22	);	22	);
23		23
24	$\|=1; # flushes output	24	$\| = 1; # flushes output
25	if ( $params->{batch} ) {	25	if ( $params->{batch} ) {
26	cronlogaction( { info => $command_line_options } );	26	cronlogaction( { info => $command_line_options } );
27	handle_batch($params);	27	handle_batch($params);
Lines 30-63 if ( $params->{batch} ) { Link Here
30	}	30	}
31		31
32	sub handle_batch {	32	sub handle_batch {
33	my $params = shift;	33	my $params = shift;
34	my $verbose = $params->{verbose};	34	my $verbose = $params->{verbose};
35		35
36	my $starttime = gettimeofday;	36	my $starttime = gettimeofday;
37	print "Started merging\n" if $verbose;	37	print "Started merging\n" if $verbose;
38		38
39	Koha::Authority::MergeRequests->cron_cleanup({ reset_hours => RESET_HOURS, remove_days => REMOVE_DAYS });	39	Koha::Authority::MergeRequests->cron_cleanup( { reset_hours => RESET_HOURS, remove_days => REMOVE_DAYS } );
40	my $rs = Koha::Authority::MergeRequests->search(	40	my $rs = Koha::Authority::MergeRequests->search(
41	{ done => 0 },	41	{ done => 0 },
42	{ order_by => { -asc => 'id' }}, # IMPORTANT	42	{ order_by => { -asc => 'id' } }, # IMPORTANT
43	);	43	);
		44
44	# For best results, postponed merges should be applied in right order.	45	# For best results, postponed merges should be applied in right order.
45	# Similarly, we do not only select the last one for a specific id.	46	# Similarly, we do not only select the last one for a specific id.
46		47
47	while( my $req = $rs->next ) {	48	while ( my $req = $rs->next ) {
48	$req->done(2)->store;	49	$req->done(2)->store;
49	print "Merging auth " . $req->authid . " to " . ( $req->authid_new // 'NULL' ) . ".\n" if $verbose;	50	print "Merging auth " . $req->authid . " to " . ( $req->authid_new // 'NULL' ) . ".\n" if $verbose;
50	my $newmarc = $req->authid_new	51	my $newmarc =
		52	$req->authid_new
51	? GetAuthority( $req->authid_new )	53	? GetAuthority( $req->authid_new )
52	: undef;	54	: undef;
		55
53	# Following merge call handles both modifications and deletes	56	# Following merge call handles both modifications and deletes
54	merge({	57	merge(
55	mergefrom => $req->authid,	58	{
56	MARCfrom => scalar $req->oldmarc,	59	mergefrom => $req->authid,
57	mergeto => $req->authid_new,	60	MARCfrom => scalar $req->oldmarc,
58	MARCto => $newmarc,	61	mergeto => $req->authid_new,
59	override_limit => 1,	62	MARCto => $newmarc,
60	});	63	override_limit => 1,
		64	}
		65	);
61	$req->done(1)->store;	66	$req->done(1)->store;
62	}	67	}
63	my $timeneeded = gettimeofday - $starttime;	68	my $timeneeded = gettimeofday - $starttime;