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