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, $commit, $delete, $help, $merge, $reference, $renumber, $verbose );
  29 GetOptions(
  30     'authid:s'    => \@authid,
  31     'commit'      => \$commit,
  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 if( $help ) {
  42     pod2usage(1);
  43 } elsif( !$commit ) {
  44     print "Please add -commit parameter\n";
  45     exit;
  46 } elsif( $delete ) {
  47     delete_auth( \@authid );
  48 } elsif( $merge ) {
  49     merge_auth( \@authid, $reference );
  50 } elsif( $renumber ) {
  51     renumber( \@authid );
  52 } else {
  53     pod2usage(1);
  54 }
  55
  56 sub delete_auth {
  57     my ( $auths ) = @_;
  58     foreach my $authid ( uniq(@$auths) ) {
  59         DelAuthority({ authid => $authid }); # triggers a merge (read: cleanup)
  60         print "Removing $authid\n" if $verbose;
  61     }
  62 }
  63
  64 sub merge_auth {
  65     my ( $auths, $reference ) = @_;
  66     if( !$reference ) {
  67         print "Reference parameter is missing\n";
  68         return;
  69     }
  70     my $marc_ref = GetAuthority( $reference ) || return;
  71     # First update all linked biblios of reference
  72     merge({ mergefrom => $reference, MARCfrom => $marc_ref, mergeto => $reference, MARCto => $marc_ref, override_limit => 1 });
  73
  74     # Merge all authid's into reference
  75     my $marc;
  76     foreach my $authid ( uniq(@$auths) ) {
  77         next if $authid == $reference;
  78         $marc = GetAuthority($authid);
  79         if( !$marc ) {
  80             print "Authority id $authid ignored, does not exist.\n";
  81             next;
  82         }
  83         merge({ mergefrom => $authid, MARCfrom => $marc, mergeto => $reference, MARCto => $marc_ref, override_limit => 1 });
  84         DelAuthority({ authid => $authid, skip_merge => 1 });
  85         print "Record $authid merged into reference.\n" if $verbose;
  86     }
  87 }
  88
  89 sub renumber {
  90     my ( $auths ) = @_;
  91     foreach my $authid ( uniq(@$auths) ) {
  92         if( my $obj = Koha::Authorities->find($authid) ) {
  93             my $marc = GetAuthority( $authid );
  94             AddAuthority( $marc, $authid, $obj->authtypecode );
  95                 # AddAuthority contains an update of 001, 005 etc.
  96             print "Renumbered $authid\n" if $verbose;
  97         } else {
  98             print "Record $authid not found!\n"  if $verbose;
  99         }
 100     }
 101 }
 102
 103 =head1 NAME
 104
 105 update_authorities.pl
 106
 107 =head1 DESCRIPTION
 108
 109 Script to perform various authority related maintenance tasks.
 110 This version supports deleting an authority record and updating all linked
 111 biblio records.
 112 Furthermore it supports merging authority records with one reference record,
 113 and updating all linked biblio records.
 114 It also allows you to force a renumber, i.e. save the authid into field 001.
 115
 116 =head1 SYNOPSIS
 117
 118 update_authorities.pl -c -authid 1,2,3 -delete
 119
 120 update_authorities.pl -c -authid 1 -authid 2 -authid 3 -delete
 121
 122 update_authorities.pl -c -authid 1,2 -merge -reference 3
 123
 124 update_authorities.pl -c -merge -reference 4
 125
 126 update_authorities.pl -c -authid 1,2,3 -renumber
 127
 128 =head1 OPTIONS
 129
 130 authid: List authority numbers separated by commas or repeat the
 131 parameter.
 132
 133 commit: Needed to commit changes.
 134
 135 delete: Delete the listed authority numbers and remove its references from
 136 linked biblio records.
 137
 138 merge: Merge the passed authid's into reference and update all linked biblio
 139 records. If you do not pass authid's, the linked biblio records of reference
 140 will be updated only.
 141
 142 renumber: Save authid into field 001.
 143
 144 =head1 AUTHOR
 145
 146 Marcel de Rooy, Rijksmuseum Amsterdam, The Netherlands
 147
 148 =cut