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 under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
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.
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.
23 # Script to switch the MARC21 440$anv and 490$av information
26 # find Koha's Perl modules
27 # test carefully before changing this
29 eval { require "$FindBin::Bin/../kohalib.pl" };
38 my $update_frameworks;
41 my $result = GetOptions(
44 'f' => \$update_frameworks,
45 'h|help' => \$show_help,
49 # warn and exit if we're running UNIMARC
50 if (C4::Context->preference('MARCFLAVOUR') eq 'UNIMARC') {
51 print "This script is useless when you're running UNIMARC\n";
54 if ( ! $result || $show_help ) {
59 my $dbh = C4::Context->dbh;
61 my $count_sth = $dbh->prepare( 'SELECT COUNT(biblionumber) FROM biblio CROSS JOIN biblioitems USING (biblionumber) WHERE ExtractValue(marcxml,\'//datafield[@tag="440"]/subfield[@code="a"]\') OR ExtractValue(marcxml,\'//datafield[@tag="440"]/subfield[@code="v"]\') OR ExtractValue(marcxml,\'//datafield[@tag="440"]/subfield[@code="n"]\') OR ExtractValue(marcxml,\'//datafield[@tag="490"]/subfield[@code="a"]\') OR ExtractValue(marcxml,\'//datafield[@tag="490"]/subfield[@code="v"]\')' );
63 my $bibs_sth = $dbh->prepare( 'SELECT biblionumber FROM biblio CROSS JOIN biblioitems USING (biblionumber) WHERE ExtractValue(marcxml,\'//datafield[@tag="440"]/subfield[@code="a"]\') OR ExtractValue(marcxml,\'//datafield[@tag="440"]/subfield[@code="v"]\') OR ExtractValue(marcxml,\'//datafield[@tag="440"]/subfield[@code="n"]\') OR ExtractValue(marcxml,\'//datafield[@tag="490"]/subfield[@code="a"]\') OR ExtractValue(marcxml,\'//datafield[@tag="490"]/subfield[@code="v"]\')' );
69 print "Examining MARC records...\n";
70 $count_sth->execute();
71 my ( $num_records ) = $count_sth->fetchrow;
75 print "This action would change $num_records MARC records\n";
78 print "There appears to be no series information to change\n";
80 print "Please run this again with the '-c' option to change the records\n";
84 print "Changing $num_records MARC records...\n";
108 $bibs_sth->execute();
109 while ( my ( $biblionumber ) = $bibs_sth->fetchrow ) {
110 my $framework = GetFrameworkCode( $biblionumber ) || '';
114 my $biblio = GetMarcBiblio( $biblionumber );
116 foreach my $field ( $biblio->field( '440' ) ) {
120 foreach my $subfield ( sort keys %{ $fields{'440'} } ) {
121 my @values = $field->subfield( $subfield );
123 if ( $add_links && @values ) {
124 if ( $subfield eq 'w' || $subfield eq '0' ) {
127 foreach my $v ( @values ) {
128 push @linksubfields, ( $subfield, $v );
132 if ( $subfield eq 'a' ) {
133 my @numbers = $field->subfield( 'n' );
134 my @parts = $field->subfield( 'p' );
136 while ( $i < @numbers || $i < @parts ) {
137 my @strings = grep {$_} ( $values[$i], $numbers[$i], $parts[$i] );
138 $values[$i] = join ' ', @strings;
143 if ( $fields{'490'}{$subfield} ) {
144 foreach my $v ( @values ) {
145 push @newsubfields, ( $subfield, $v );
150 if ( $has_links && @linksubfields ) {
151 my $link_field = MARC::Field->new(
153 $field->indicator(1), $field->indicator(2),
156 push @newfields, $link_field;
159 if ( @newsubfields ) {
160 my $new_field = MARC::Field->new( '490', $has_links, '',
162 push @newfields, $new_field;
165 $biblio->delete_fields( $field );
168 foreach my $field ( $biblio->field( '490' ) ) {
170 foreach my $subfield ( sort keys %{ $fields{'490'} } ) {
171 my @values = $field->subfield( $subfield );
173 if ( $fields{'440'}{$subfield} ) {
174 foreach my $v ( @values ) {
175 push @newsubfields, ( $subfield, $v );
180 if ( @newsubfields ) {
181 my $new_field = MARC::Field->new( '440', '', '',
183 push @newfields, $new_field;
186 $biblio->delete_fields( $field );
188 $biblio->insert_fields_ordered( @newfields );
191 print "Changing MARC for biblio number $biblionumber.\n";
196 ModBiblioMarc( $biblio, $biblionumber, $framework );
200 if ( $update_frameworks ) {
201 print "Updating Koha to MARC mappings for seriestitle and volume\n";
203 # set new mappings for koha fields
205 "UPDATE marc_subfield_structure SET kohafield='seriestitle'
206 WHERE tagfield='490' AND tagsubfield='a'"
209 "UPDATE marc_subfield_structure SET kohafield='volume'
210 WHERE tagfield='490' AND tagsubfield='v'"
213 # empty old koha fields
215 "UPDATE marc_subfield_structure SET kohafield=''
216 WHERE kohafield='seriestitle' AND tagfield='440' AND tagsubfield='a'"
219 "UPDATE marc_subfield_structure SET kohafield=''
220 WHERE kohafield='volume' AND tagfield='440' AND tagsubfield='v'"
226 $0: switch MARC21 440 tag and 490 tag contents
229 -c Commit the changes to the marc records.
231 -l Add 830 tags with authority information from 440. Otherwise
232 this information will be ignored.
234 -f Also update the Koha field to MARC framework mappings for the
235 seriestitle and volume Koha fields.
237 -v Show more information as the records are being changed.
239 --help or -h show this message.