misc/migration_tools/remove_unused_authorities.pl

   1 #!/usr/bin/perl
   2
   3 #script to administer Authorities without biblio
   4
   5 # Copyright 2009 BibLibre
   6 # written 2009-05-04 by paul dot poulain at biblibre.com
   7 #
   8 # This file is part of Koha.
   9 #
  10 # Koha is free software; you can redistribute it and/or modify it
  11 # under the terms of the GNU General Public License as published by
  12 # the Free Software Foundation; either version 3 of the License, or
  13 # (at your option) any later version.
  14 #
  15 # Koha is distributed in the hope that it will be useful, but
  16 # WITHOUT ANY WARRANTY; without even the implied warranty of
  17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  18 # GNU General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU General Public License
  21 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  22
  23 use strict;
  24 use warnings;
  25
  26 use Koha::Script;
  27 use C4::Context;
  28 use C4::AuthoritiesMarc;
  29 use Getopt::Long;
  30
  31 use Koha::SearchEngine::Search;
  32
  33 my @authtypes;
  34 my $want_help = 0;
  35 my $test = 0;
  36 GetOptions(
  37     'aut|authtypecode:s' => \@authtypes,
  38     't|test'             => \$test,
  39     'h|help'             => \$want_help
  40 );
  41
  42 if ($want_help) {
  43     print_usage();
  44     exit 0;
  45 }
  46
  47 if ($test) {
  48     print "testing only, authorities will not be deleted.\n";
  49 }
  50
  51 my $errZebraConnection = C4::Context->Zconn("biblioserver",0)->errcode();
  52 if ( $errZebraConnection == 10000 ) {
  53     die "Zebra server seems not to be available. This script needs Zebra runs."
  54 } elsif ( $errZebraConnection ) {
  55     die "Error from Zebra: $errZebraConnection";
  56 }
  57
  58 my $dbh=C4::Context->dbh;
  59 my $thresholdmin=0;
  60 my $thresholdmax=0;
  61 my @results;
  62 # prepare the request to retrieve all authorities of the requested types
  63 my $rqsql = "SELECT * from auth_header where 1";
  64 $rqsql .= " AND authtypecode IN (".join(",",map{$dbh->quote($_)}@authtypes).")" if @authtypes;
  65 my $rqselect = $dbh->prepare($rqsql);
  66 $|=1;
  67
  68 $rqselect->execute;
  69 my $counter=0;
  70 my $totdeleted=0;
  71 my $totundeleted=0;
  72 my $searcher = Koha::SearchEngine::Search->new({index => 'biblios'});
  73 while (my $data=$rqselect->fetchrow_hashref){
  74     my $query;
  75     $query= "an=".$data->{'authid'};
  76     # search for biblios mapped
  77     my ($err,$res,$used) = $searcher->simple_search_compat($query,0,10);
  78     if (defined $err) {
  79         warn "error: $err on search $query\n";
  80         next;
  81     }
  82     print ".";
  83     print "$counter\n" unless $counter++ % 100;
  84     # if found, delete, otherwise, just count
  85     if ($used>=$thresholdmin and $used<=$thresholdmax){
  86         DelAuthority({ authid => $data->{'authid'} }) unless $test;
  87         $totdeleted++;
  88     } else {
  89         $totundeleted++;
  90     }
  91 }
  92
  93 print "$counter authorities parsed, $totdeleted deleted and $totundeleted unchanged because used\n";
  94
  95
  96 sub print_usage {
  97     print <<_USAGE_;
  98 $0: Remove unused authority records
  99
 100 This script removes authority records that do not have any biblio
 101 records attached to them.
 102
 103 If the --aut option is supplied, only authority records of that
 104 particular type will be checked for usage.  --aut can be repeated.
 105
 106 If --aut is not supplied, all authority records will be checked.
 107
 108 Use --test to perform a test run.  This script does not ask the
 109 operator to confirm the deletion of each authority record.
 110
 111 parameters
 112     --aut|authtypecode TYPE       the list of authtypes to check
 113     --test or -t                  test mode, don't delete really, just count
 114     --help or -h                  show this message.
 115
 116 _USAGE_
 117 }