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 Modern::Perl;
  24
  25 use Koha::Script;
  26 use C4::Context;
  27 use C4::AuthoritiesMarc;
  28 use Getopt::Long qw( GetOptions );
  29
  30 use Koha::SearchEngine::Search;
  31
  32 my @authtypes;
  33 my ($confirm, $test, $want_help);
  34 GetOptions(
  35     'aut|authtypecode:s' => \@authtypes,
  36     'c|confirm'          => \$confirm,
  37     't|test'             => \$test,
  38     'h|help'             => \$want_help,
  39 );
  40
  41 if ( $want_help || !($test || $confirm) ) {
  42     print_usage();
  43     exit 0;
  44 }
  45 if ($test) {
  46     print "*** Testing only, authorities will not be deleted. ***\n";
  47 }
  48 if (@authtypes) {
  49     print "Restricted to authority type(s) : ".join(',', @authtypes).".\n";
  50 }
  51
  52 my $searcher = Koha::SearchEngine::Search->new( { index => 'biblios' } );
  53 my $checksearch;
  54 if ( C4::Context->preference("SearchEngine") eq 'Zebra' ) {
  55     # Check server state
  56     my $errZebraConnection = C4::Context->Zconn("biblioserver",0)->errcode();
  57     if ( $errZebraConnection == 10000 ) {
  58         die "Zebra server seems not to be available. This script needs Zebra runs.";
  59     } elsif ( $errZebraConnection ) {
  60         die "Error from Zebra: $errZebraConnection";
  61     }
  62     $checksearch = q{an,alwaysmatches=''};
  63 }
  64 else {
  65     $checksearch = q{an:*};
  66 }
  67 # Check search on authority number as at least one result
  68 my ($err,$res,$nb) = $searcher->simple_search_compat($checksearch,0,10);
  69 unless ($nb > 0) {
  70     die "Searching authority number in biblio records seems not to be available : $checksearch";
  71 }
  72
  73 my $dbh=C4::Context->dbh;
  74 # prepare the request to retrieve all authorities of the requested types
  75 my $rqsql = q{ SELECT authid,authtypecode FROM auth_header };
  76 $rqsql .= q{ WHERE authtypecode IN (}.join(',',map{ '?' }@authtypes).')' if @authtypes;
  77 my $rqselect = $dbh->prepare($rqsql);
  78 $|=1;
  79
  80 $rqselect->execute(@authtypes);
  81 my $counter=0;
  82 my $totdeleted=0;
  83 my $totundeleted=0;
  84 while (my $data=$rqselect->fetchrow_hashref){
  85     $counter++;
  86     print 'authid='.$data->{'authid'};
  87     print ' type='.$data->{'authtypecode'};
  88     my $bibliosearch = 'an:'.$data->{'authid'};
  89     # search for biblios mapped
  90     my ($err,$res,$used) = $searcher->simple_search_compat($bibliosearch,0,10);
  91     if (defined $err) {
  92         print "\n";
  93         warn "Error: $err on search for biblios $bibliosearch\n";
  94         next;
  95     }
  96     unless ($used > 0){
  97         unless ($test) {
  98             DelAuthority({ authid => $data->{'authid'}, skip_merge => 1 });
  99             print " : deleted";
 100         } else {
 101             print " : can be deleted";
 102         }
 103         $totdeleted++;
 104     } else {
 105         $totundeleted++;
 106         print " : used $used time(s)";
 107     }
 108     print "\n";
 109 }
 110
 111 print "$counter authorities parsed\n";
 112 unless ($test) {
 113     print "$totdeleted deleted because unused\n";
 114 } else {
 115     print "$totdeleted can be deleted because unused\n";
 116 }
 117 print "$totundeleted unchanged because used\n";
 118
 119 sub print_usage {
 120     print <<_USAGE_;
 121 $0: Remove unused authority records
 122
 123 This script removes authority records that do not have any biblio
 124 records attached to them.
 125
 126 If the --aut option is supplied, only authority records of that
 127 particular type will be checked for usage.  --aut can be repeated.
 128
 129 If --aut is not supplied, all authority records will be checked.
 130
 131 Use --confirm Confirms you want to really run this script, otherwise prints this help.
 132
 133 Use --test to perform a test run.  This script does not ask the
 134 operator to confirm the deletion of each authority record.
 135
 136 parameters
 137     --aut|authtypecode TYPE       the list of authtypes to check
 138     --confirm or -c               confirm running of script
 139     --test or -t                  test mode, don't delete really, just count
 140     --help or -h                  show this message.
 141
 142 _USAGE_
 143 }