Koha/misc/migration_tools/remove_unused_authorities.pl
Fridolin Somers bf60a9c88c
Bug 21865: improve remove_unused_authorities.pl script
remove_unused_authorities.pl script can be improved.

This patch changes changes verbosity so than test mode can be used
to know the autorities that are used and those that can be deleted.
It also writes a line in output if limited authority type(s).

This patch also removes the unused vars $thresholdmin and $thresholdmax.

It also changes the query to use SQL with parameters for authority types.

Test plan :
1) On a catalog create a new authority
2) Be sure catalog is well indexed
3) Run misc/migration_tools/remove_unused_authorities.pl -t
4) You will see the line :
   *** Testing only, authorities will not be deleted. ***
5) You will see lines of :
   authid=x type=y : used X time(s)
6) You will see the line for the authority created in 1) :
   authid=x type=y : can be deleted
7) You will see at the end :
   x authorities parsed
   y can be deleted because unused
   z unchanged because used
8) Run misc/migration_tools/remove_unused_authorities.pl
9) You don't see the line :
   *** Testing only, authorities will not be deleted. ***
10) You will see lines of :
   authid=x type=y : used X time(s)
11) You will see the line for the authority created in 1) :
   authid=x type=y : deleted
12) You will see at the end :
   x authorities parsed
   y deleted because unused
   z unchanged because used
13) Run misc/migration_tools/remove_unused_authorities.pl --auth NP --auth CO
14) You see the line :
    Restricted to authority type(s) : NP,CO.

Signed-off-by: Bernardo Gonzalez Kriegel <bgkriegel@gmail.com>
Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>
2020-04-14 16:53:58 +01:00

128 lines
3.7 KiB
Perl
Executable file

#!/usr/bin/perl
#script to administer Authorities without biblio
# Copyright 2009 BibLibre
# written 2009-05-04 by paul dot poulain at biblibre.com
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.
use Modern::Perl;
use Koha::Script;
use C4::Context;
use C4::AuthoritiesMarc;
use Getopt::Long;
use Koha::SearchEngine::Search;
my @authtypes;
my $want_help = 0;
my $test = 0;
GetOptions(
'aut|authtypecode:s' => \@authtypes,
't|test' => \$test,
'h|help' => \$want_help
);
if ($want_help) {
print_usage();
exit 0;
}
if ($test) {
print "*** Testing only, authorities will not be deleted. ***\n";
}
if (@authtypes) {
print "Restricted to authority type(s) : ".join(',', @authtypes).".\n";
}
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";
}
my $dbh=C4::Context->dbh;
my @results;
# 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;
my $searcher = Koha::SearchEngine::Search->new({index => 'biblios'});
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'} });
print " : deleted";
} else {
print " : can be deleted";
}
$totdeleted++;
} else {
$totundeleted++;
print " : used $used time(s)";
}
print "\n";
}
print "$counter authorities parsed\n";
unless ($test) {
print "$totdeleted deleted because unused\n";
} else {
print "$totdeleted can be deleted because unused\n";
}
print "$totundeleted unchanged because used\n";
sub print_usage {
print <<_USAGE_;
$0: Remove unused authority records
This script removes authority records that do not have any biblio
records attached to them.
If the --aut option is supplied, only authority records of that
particular type will be checked for usage. --aut can be repeated.
If --aut is not supplied, all authority records will be checked.
Use --test to perform a test run. This script does not ask the
operator to confirm the deletion of each authority record.
parameters
--aut|authtypecode TYPE the list of authtypes to check
--test or -t test mode, don't delete really, just count
--help or -h show this message.
_USAGE_
}