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' => \$reference, |
35 |
'renumber' => \$renumber, |
36 |
'verbose' => \$verbose, |
37 |
); |
38 |
|
39 |
@authid = map { split /[,]/, $_; } @authid; |
40 |
if( $delete ) { |
41 |
delete( \@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 { |
53 |
my ( $auths ) = @_; |
54 |
foreach my $authid ( uniq(@$auths) ) { |
55 |
DelAuthority( $authid ); # triggers a merge (read: cleanup) |
56 |
print "Removing $authid\n" if $verbose; |
57 |
} |
58 |
} |
59 |
|
60 |
sub merge_auth { |
61 |
if( !$reference ) { |
62 |
"Reference parameter is missing\n"; |
63 |
return; |
64 |
} |
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 |
It also allows you to force a renumber, i.e. save the authid into field 001. |
105 |
|
106 |
=head1 SYNOPSIS |
107 |
|
108 |
update_authorities.pl -authid 1,2,3 -delete |
109 |
|
110 |
update_authorities.pl -authid 1 -authid 2 -authid 3 -delete |
111 |
|
112 |
update_authorities.pl -authid 1,2 -merge -reference 3 |
113 |
|
114 |
update_authorities.pl -merge -reference 4 |
115 |
|
116 |
update_authorities.pl -authid 1,2,3 -renumber |
117 |
|
118 |
=head1 OPTIONS |
119 |
|
120 |
authid: List authority numbers separated by commas or repeat the |
121 |
parameter. |
122 |
|
123 |
delete: Delete the listed authority numbers and remove its references from |
124 |
linked biblio records. |
125 |
|
126 |
merge: Merge the passed authid's into reference and update all linked biblio |
127 |
records. If you do not pass authid's, the linked biblio records of reference |
128 |
will be updated only. |
129 |
|
130 |
renumber: Save authid into field 001. |
131 |
|
132 |
=head1 AUTHOR |
133 |
|
134 |
Marcel de Rooy, Rijksmuseum Amsterdam, The Netherlands |
135 |
|
136 |
=cut |