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 under the
  11 # terms of the GNU General Public License as published by the Free Software
  12 # Foundation; either version 2 of the License, or (at your option) any later
  13 # version.
  14 #
  15 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  16 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  17 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License along
  20 # with Koha; if not, write to the Free Software Foundation, Inc.,
  21 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  22
  23 use strict;
  24 use warnings;
  25
  26 use C4::Context;
  27 use C4::AuthoritiesMarc;
  28 use Getopt::Long;
  29
  30 my ($test,@authtypes);
  31 my $want_help = 0;
  32 GetOptions(
  33     'aut|authtypecode:s'    => \@authtypes,
  34     't'    => \$test,
  35     'h|help'        => \$want_help
  36 );
  37
  38 if ($want_help) {
  39     print_usage();
  40     exit 0;
  41 }
  42
  43 my $dbh=C4::Context->dbh;
  44 @authtypes or @authtypes = qw( NC );
  45 my $thresholdmin=0;
  46 my $thresholdmax=0;
  47 my @results;
  48 # prepare the request to retrieve all authorities of the requested types
  49 my $rqselect = $dbh->prepare(
  50     qq{SELECT * from auth_header where authtypecode IN (}
  51     . join(",",map{$dbh->quote($_)}@authtypes)
  52     . ")"
  53 );
  54 $|=1;
  55
  56 $rqselect->execute;
  57 my $counter=0;
  58 my $totdeleted=0;
  59 my $totundeleted=0;
  60 while (my $data=$rqselect->fetchrow_hashref){
  61     my $query;
  62     $query= "an=".$data->{'authid'};
  63     # search for biblios mapped
  64     my ($err,$res,$used) = C4::Search::SimpleSearch($query,0,10);
  65     if (defined $err) {
  66         warn "error: $err on search $query\n";
  67         next;
  68     }
  69     print ".";
  70     print "$counter\n" unless $counter++ % 100;
  71     # if found, delete, otherwise, just count
  72     if ($used>=$thresholdmin and $used<=$thresholdmax){
  73         DelAuthority($data->{'authid'}) unless $test;
  74         $totdeleted++;
  75     } else {
  76         $totundeleted++;
  77     }
  78 }
  79
  80 print "$counter authorities parsed, $totdeleted deleted and $totundeleted unchanged because used\n";
  81
  82
  83 sub print_usage {
  84     print <<_USAGE_;
  85 $0: Removes unused authorities.
  86
  87 This script will parse all authoritiestypes given as parameter, and remove authorities without any biblio attached.
  88 warning : there is no individual confirmation !
  89 parameters
  90     --aut|authtypecode TYPE       the list of authtypes to check
  91     --t|test                      test mode, don't delete really, just count
  92     --help or -h                  show this message.
  93
  94 _USAGE_
  95 }