koha-dev.rot13.org Git - koha_fer/blob - 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 @authtypes;
  31 my $want_help = 0;
  32 my $test = 0;
  33 GetOptions(
  34     'aut|authtypecode:s' => \@authtypes,
  35     't|test'             => \$test,
  36     'h|help'             => \$want_help
  37 );
  38
  39 if ($want_help) {
  40     print_usage();
  41     exit 0;
  42 }
  43
  44 if ($test) {
  45     print "testing only, authorities will not be deleted.\n";
  46 }
  47
  48 my $dbh=C4::Context->dbh;
  49 @authtypes or @authtypes = qw( NC );
  50 my $thresholdmin=0;
  51 my $thresholdmax=0;
  52 my @results;
  53 # prepare the request to retrieve all authorities of the requested types
  54 my $rqselect = $dbh->prepare(
  55     qq{SELECT * from auth_header where authtypecode IN (}
  56     . join(",",map{$dbh->quote($_)}@authtypes)
  57     . ")"
  58 );
  59 $|=1;
  60
  61 $rqselect->execute;
  62 my $counter=0;
  63 my $totdeleted=0;
  64 my $totundeleted=0;
  65 while (my $data=$rqselect->fetchrow_hashref){
  66     my $query;
  67     $query= "an=".$data->{'authid'};
  68     # search for biblios mapped
  69     my ($err,$res,$used) = C4::Search::SimpleSearch($query,0,10);
  70     if (defined $err) {
  71         warn "error: $err on search $query\n";
  72         next;
  73     }
  74     print ".";
  75     print "$counter\n" unless $counter++ % 100;
  76     # if found, delete, otherwise, just count
  77     if ($used>=$thresholdmin and $used<=$thresholdmax){
  78         DelAuthority($data->{'authid'}) unless $test;
  79         $totdeleted++;
  80     } else {
  81         $totundeleted++;
  82     }
  83 }
  84
  85 print "$counter authorities parsed, $totdeleted deleted and $totundeleted unchanged because used\n";
  86
  87
  88 sub print_usage {
  89     print <<_USAGE_;
  90 $0: Removes unused authorities.
  91
  92 This script will parse all authoritiestypes given as parameter, and remove authorities without any biblio attached.
  93 warning : there is no individual confirmation !
  94 parameters
  95     --aut|authtypecode TYPE       the list of authtypes to check
  96     --test or -t                  test mode, don't delete really, just count
  97     --help or -h                  show this message.
  98
  99 _USAGE_
 100 }