misc/maintenance/update_authorities.pl

   1 #!/usr/bin/perl
   2
   3 # Copyright Rijksmuseum 2017
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 3 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 use Modern::Perl;
  21
  22 use Getopt::Long;
  23 use List::MoreUtils qw/uniq/;
  24 use Pod::Usage;
  25
  26 use C4::AuthoritiesMarc qw/AddAuthority DelAuthority GetAuthority merge/;
  27
  28 my ( @authid, $confirm, $delete, $help, $merge, $reference, $renumber, $verbose );
  29 GetOptions(
  30     'authid:s'    => \@authid,
  31     'confirm'     => \$confirm,
  32     'delete'      => \$delete,
  33     'help'        => \$help,
  34     'merge'       => \$merge,
  35     'reference:i' => \$reference,
  36     'renumber'    => \$renumber,
  37     'verbose'     => \$verbose,
  38 );
  39
  40 @authid = map { split /[,]/, $_; } @authid;
  41 print "No changes will be made\n" unless $confirm;
  42 pod2usage(1) if $help;
  43
  44 if ( $delete and $merge and $renumber ) {
  45     pod2usage(q|Only one action parameter can be passed (delete, merge or renumber)|);
  46 }
  47
  48 if( $delete ) {
  49     delete_auth( \@authid );
  50 } elsif( $merge ) {
  51     pod2usage(q|Reference parameter is missing|) unless $reference;
  52     merge_auth( \@authid, $reference );
  53 } elsif( $renumber ) {
  54     renumber( \@authid );
  55 } else {
  56     pod2usage(1);
  57 }
  58
  59 sub delete_auth {
  60     my ( $auths ) = @_;
  61     foreach my $authid ( uniq(@$auths) ) {
  62         if( $confirm ) {
  63             DelAuthority({ authid => $authid }); # triggers a merge (read: cleanup)
  64             print "Removing $authid\n" if $verbose;
  65         } else {
  66             print "Would have removed $authid\n" if $verbose;
  67         }
  68     }
  69 }
  70
  71 sub merge_auth {
  72     my ( $auths, $reference ) = @_;
  73
  74     return unless $reference;
  75
  76     my $marc_ref = GetAuthority( $reference ) || die "Reference record $reference not found\n";
  77     # First update all linked biblios of reference
  78     merge({ mergefrom => $reference, MARCfrom => $marc_ref, mergeto => $reference, MARCto => $marc_ref, override_limit => 1 }) if $confirm;
  79
  80     # Merge all authid's into reference
  81     my $marc;
  82     foreach my $authid ( uniq(@$auths) ) {
  83         next if $authid == $reference;
  84         $marc = GetAuthority($authid);
  85         if( !$marc ) {
  86             print "Authority id $authid ignored, does not exist.\n";
  87             next;
  88         }
  89         if( $confirm ) {
  90             merge({
  91                 mergefrom      => $authid,
  92                 MARCfrom       => $marc,
  93                 mergeto        => $reference,
  94                 MARCto         => $marc_ref,
  95                 override_limit => 1
  96             });
  97             DelAuthority({ authid => $authid, skip_merge => 1 });
  98             print "Record $authid merged into reference $reference.\n" if $verbose;
  99         } else {
 100             print "Would have merged record $authid into reference $reference.\n" if $verbose;
 101         }
 102     }
 103 }
 104
 105 sub renumber {
 106     my ( $auths ) = @_;
 107     foreach my $authid ( uniq(@$auths) ) {
 108         if( my $authority = Koha::Authorities->find($authid) ) {
 109             my $marc = GetAuthority( $authid );
 110             if( $confirm ) {
 111                 AddAuthority( $marc, $authid, $authority->authtypecode );
 112                     # AddAuthority contains an update of 001, 005 etc.
 113                 print "Renumbered $authid\n" if $verbose;
 114             } else {
 115                 print "Would have renumbered $authid\n" if $verbose;
 116             }
 117         } else {
 118             print "Record $authid not found!\n"  if $verbose;
 119         }
 120     }
 121 }
 122
 123 =head1 NAME
 124
 125 update_authorities.pl
 126
 127 =head1 DESCRIPTION
 128
 129 Script to perform various authority related maintenance tasks.
 130 This version supports deleting an authority record and updating all linked
 131 biblio records.
 132 Furthermore it supports merging authority records with one reference record,
 133 and updating all linked biblio records.
 134 It also allows you to force a renumber, i.e. save the authid into field 001.
 135
 136 =head1 SYNOPSIS
 137
 138 update_authorities.pl -c -authid 1,2,3 -delete
 139
 140 update_authorities.pl -c -authid 1 -authid 2 -authid 3 -delete
 141
 142 update_authorities.pl -c -authid 1,2 -merge -reference 3
 143
 144 update_authorities.pl -c -merge -reference 4
 145
 146 update_authorities.pl -c -authid 1,2,3 -renumber
 147
 148 =head1 OPTIONS
 149
 150 authid: List authority numbers separated by commas or repeat the
 151 parameter.
 152
 153 confirm: Needed to commit changes.
 154
 155 delete: Delete the listed authority numbers and remove its references from
 156 linked biblio records.
 157
 158 merge: Merge the passed authid's into reference and update all linked biblio
 159 records. If you do not pass authid's, the linked biblio records of reference
 160 will be updated only.
 161
 162 renumber: Save authid into field 001.
 163
 164 =head1 AUTHOR
 165
 166 Marcel de Rooy, Rijksmuseum Amsterdam, The Netherlands
 167
 168 =cut