3 # Copyright 2013 Michael Hafen <mdhafen@tech.washk12.org>
5 # This file is part of Koha.
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.
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.
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>.
23 # Script to switch the MARC21 440$anv and 490$av information
26 use C4::Biblio qw( GetFrameworkCode GetMarcBiblio ModBiblioMarc );
28 use Getopt::Long qw( GetOptions );
32 my $update_frameworks;
35 my $result = GetOptions(
38 'f' => \$update_frameworks,
39 'h|help' => \$show_help,
43 # warn and exit if we're running UNIMARC
44 if (C4::Context->preference('MARCFLAVOUR') eq 'UNIMARC') {
45 print "This script is useless when you're running UNIMARC\n";
48 if ( ! $result || $show_help ) {
53 my $dbh = C4::Context->dbh;
55 my $count_sth = $dbh->prepare(
57 SELECT COUNT(biblionumber)
59 WHERE format='marcxml'
62 ExtractValue(metadata,'//datafield[@tag="440"]/subfield[@code="a"]')
63 OR ExtractValue(metadata,'//datafield[@tag="440"]/subfield[@code="v"]')
64 OR ExtractValue(metadata,'//datafield[@tag="440"]/subfield[@code="n"]')
65 OR ExtractValue(metadata,'//datafield[@tag="490"]/subfield[@code="a"]')
66 OR ExtractValue(metadata,'//datafield[@tag="490"]/subfield[@code="v"]')
71 my $bibs_sth = $dbh->prepare(
75 WHERE format='marcxml'
78 ExtractValue(metadata,'//datafield[@tag="440"]/subfield[@code="a"]')
79 OR ExtractValue(metadata,'//datafield[@tag="440"]/subfield[@code="v"]')
80 OR ExtractValue(metadata,'//datafield[@tag="440"]/subfield[@code="n"]')
81 OR ExtractValue(metadata,'//datafield[@tag="490"]/subfield[@code="a"]')
82 OR ExtractValue(metadata,'//datafield[@tag="490"]/subfield[@code="v"]')
91 print "Examining MARC records...\n";
92 $count_sth->execute( C4::Context->preference('marcflavour') );
93 my ( $num_records ) = $count_sth->fetchrow;
97 print "This action would change $num_records MARC records\n";
100 print "There appears to be no series information to change\n";
102 print "Please run this again with the '-c' option to change the records\n";
106 print "Changing $num_records MARC records...\n";
130 $bibs_sth->execute( C4::Context->preference('marcflavour') );
131 while ( my ( $biblionumber ) = $bibs_sth->fetchrow ) {
132 my $framework = GetFrameworkCode( $biblionumber ) || '';
136 my $biblio = GetMarcBiblio({ biblionumber => $biblionumber });
138 foreach my $field ( $biblio->field( '440' ) ) {
142 foreach my $subfield ( sort keys %{ $fields{'440'} } ) {
143 my @values = $field->subfield( $subfield );
145 if ( $add_links && @values ) {
146 if ( $subfield eq 'w' || $subfield eq '0' ) {
149 foreach my $v ( @values ) {
150 push @linksubfields, ( $subfield, $v );
154 if ( $subfield eq 'a' ) {
155 my @numbers = $field->subfield( 'n' );
156 my @parts = $field->subfield( 'p' );
158 while ( $i < @numbers || $i < @parts ) {
159 my @strings = grep {$_} ( $values[$i], $numbers[$i], $parts[$i] );
160 $values[$i] = join ' ', @strings;
165 if ( $fields{'490'}{$subfield} ) {
166 foreach my $v ( @values ) {
167 push @newsubfields, ( $subfield, $v );
172 if ( $has_links && @linksubfields ) {
173 my $link_field = MARC::Field->new(
175 $field->indicator(1), $field->indicator(2),
178 push @newfields, $link_field;
181 if ( @newsubfields ) {
182 my $new_field = MARC::Field->new( '490', $has_links, '',
184 push @newfields, $new_field;
187 $biblio->delete_fields( $field );
190 foreach my $field ( $biblio->field( '490' ) ) {
192 foreach my $subfield ( sort keys %{ $fields{'490'} } ) {
193 my @values = $field->subfield( $subfield );
195 if ( $fields{'440'}{$subfield} ) {
196 foreach my $v ( @values ) {
197 push @newsubfields, ( $subfield, $v );
202 if ( @newsubfields ) {
203 my $new_field = MARC::Field->new( '440', '', '',
205 push @newfields, $new_field;
208 $biblio->delete_fields( $field );
210 $biblio->insert_fields_ordered( @newfields );
213 print "Changing MARC for biblio number $biblionumber.\n";
218 ModBiblioMarc( $biblio, $biblionumber );
222 if ( $update_frameworks ) {
223 print "Updating Koha to MARC mappings for seriestitle and volume\n";
225 # set new mappings for koha fields
227 "UPDATE marc_subfield_structure SET kohafield='biblio.seriestitle'
228 WHERE tagfield='490' AND tagsubfield='a'"
231 "UPDATE marc_subfield_structure SET kohafield='biblioitems.volume'
232 WHERE tagfield='490' AND tagsubfield='v'"
235 # empty old koha fields
237 "UPDATE marc_subfield_structure SET kohafield=''
238 WHERE kohafield='biblio.seriestitle' AND tagfield='440' AND tagsubfield='a'"
241 "UPDATE marc_subfield_structure SET kohafield=''
242 WHERE kohafield='biblioitems.volume' AND tagfield='440' AND tagsubfield='v'"
245 "UPDATE marc_subfield_structure SET kohafield=''
246 WHERE kohafield='biblioitems.number' AND tagfield='440' AND tagsubfield='n'"
252 $0: switch MARC21 440 tag and 490 tag contents
255 -c Commit the changes to the marc records.
257 -l Add 830 tags with authority information from 440. Otherwise
258 this information will be ignored.
260 -f Also update the Koha field to MARC framework mappings for the
261 seriestitle and volume Koha fields.
263 -v Show more information as the records are being changed.
265 --help or -h show this message.