View | Details | Raw Unified | Return to bug 18071
Collapse All | Expand All

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

Return to bug 18071