misc/migration_tools/switch_marc21_series_info.pl

   1 #!/usr/bin/perl
   2
   3 # Copyright 2013 Michael Hafen <mdhafen@tech.washk12.org>
   4 #
   5 # This file is part of Koha.
   6 #
   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.
  11 #
  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.
  16 #
  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>.
  19
  20 use strict;
  21 use warnings;
  22
  23 # Script to switch the MARC21 440$anv and 490$av information
  24
  25 BEGIN {
  26     # find Koha's Perl modules
  27     # test carefully before changing this
  28     use FindBin;
  29     eval { require "$FindBin::Bin/../kohalib.pl" };
  30 }
  31
  32 use Koha::Script;
  33 use C4::Biblio;
  34 use C4::Context;
  35 use Getopt::Long;
  36
  37 my $commit;
  38 my $add_links;
  39 my $update_frameworks;
  40 my $show_help;
  41 my $verbose;
  42 my $result = GetOptions(
  43     'c'      => \$commit,
  44     'l'      => \$add_links,
  45     'f'      => \$update_frameworks,
  46     'h|help' => \$show_help,
  47     'v'      => \$verbose,
  48     );
  49
  50 # warn and exit if we're running UNIMARC
  51 if (C4::Context->preference('MARCFLAVOUR') eq 'UNIMARC') {
  52     print "This script is useless when you're running UNIMARC\n";
  53     exit 0;
  54 }
  55 if ( ! $result || $show_help ) {
  56     print_usage();
  57     exit 0;
  58 }
  59
  60 my $dbh = C4::Context->dbh;
  61
  62 my $count_sth = $dbh->prepare(
  63     q|
  64     SELECT COUNT(biblionumber)
  65     FROM biblio_metadata
  66     WHERE format='marcxml'
  67         AND `schema`=?
  68         AND (
  69             ExtractValue(metadata,'//datafield[@tag="440"]/subfield[@code="a"]')
  70                 OR ExtractValue(metadata,'//datafield[@tag="440"]/subfield[@code="v"]')
  71                 OR ExtractValue(metadata,'//datafield[@tag="440"]/subfield[@code="n"]')
  72                 OR ExtractValue(metadata,'//datafield[@tag="490"]/subfield[@code="a"]')
  73                 OR ExtractValue(metadata,'//datafield[@tag="490"]/subfield[@code="v"]')
  74             )
  75     |
  76 );
  77
  78 my $bibs_sth = $dbh->prepare(
  79     q|
  80     SELECT biblionumber
  81     FROM biblio_metadata
  82     WHERE format='marcxml'
  83         AND `schema`=?
  84         AND (
  85             ExtractValue(metadata,'//datafield[@tag="440"]/subfield[@code="a"]')
  86                 OR ExtractValue(metadata,'//datafield[@tag="440"]/subfield[@code="v"]')
  87                 OR ExtractValue(metadata,'//datafield[@tag="440"]/subfield[@code="n"]')
  88                 OR ExtractValue(metadata,'//datafield[@tag="490"]/subfield[@code="a"]')
  89                 OR ExtractValue(metadata,'//datafield[@tag="490"]/subfield[@code="v"]')
  90             )
  91     |
  92 );
  93
  94 unless ( $commit ) {
  95     print_usage();
  96 }
  97
  98 print "Examining MARC records...\n";
  99 $count_sth->execute( C4::Context->preference('marcflavour') );
 100 my ( $num_records ) = $count_sth->fetchrow;
 101
 102 unless ( $commit ) {
 103     if ( $num_records ) {
 104         print "This action would change $num_records MARC records\n";
 105     }
 106     else {
 107         print "There appears to be no series information to change\n";
 108     }
 109     print "Please run this again with the '-c' option to change the records\n";
 110     exit 0;
 111 }
 112
 113 print "Changing $num_records MARC records...\n";
 114
 115 #  MARC21 specific
 116 my %fields = (
 117     '440' => {
 118         'a' => 'title',
 119         'n' => 'number',
 120         'p' => 'part',
 121         'v' => 'volume',
 122         'x' => 'issn',
 123         '6' => 'link',
 124         '8' => 'ln',
 125         'w' => 'control',
 126         '0' => 'auth',
 127     },
 128     '490' => {
 129         'a' => 'title',
 130         'v' => 'volume',
 131         'x' => 'issn',
 132         '6' => 'link',
 133         '8' => 'ln',
 134     },
 135     );
 136
 137 $bibs_sth->execute( C4::Context->preference('marcflavour') );
 138 while ( my ( $biblionumber ) = $bibs_sth->fetchrow ) {
 139     my $framework = GetFrameworkCode( $biblionumber ) || '';
 140     my ( @newfields );
 141
 142     # Get biblio marc
 143     my $biblio = GetMarcBiblio({ biblionumber => $biblionumber });
 144
 145     foreach my $field ( $biblio->field( '440' ) ) {
 146         my @newsubfields;
 147         my @linksubfields;
 148         my $has_links = '0';
 149         foreach my $subfield ( sort keys %{ $fields{'440'} } ) {
 150             my @values = $field->subfield( $subfield );
 151
 152             if ( $add_links && @values ) {
 153                 if ( $subfield eq 'w' || $subfield eq '0' ) {
 154                     $has_links = '1';
 155                 }
 156                 foreach my $v ( @values ) {
 157                     push @linksubfields, ( $subfield, $v );
 158                 }
 159             }
 160
 161             if ( $subfield eq 'a' ) {
 162                 my @numbers = $field->subfield( 'n' );
 163                 my @parts = $field->subfield( 'p' );
 164                 my $i = 0;
 165                 while ( $i < @numbers || $i < @parts ) {
 166                     my @strings = grep {$_} ( $values[$i], $numbers[$i], $parts[$i] );
 167                     $values[$i] = join ' ', @strings;
 168                     $i++;
 169                 }
 170             }
 171
 172             if ( $fields{'490'}{$subfield} ) {
 173                 foreach my $v ( @values ) {
 174                     push @newsubfields, ( $subfield, $v );
 175                 }
 176             }
 177         }
 178
 179         if ( $has_links && @linksubfields ) {
 180             my $link_field = MARC::Field->new(
 181                 '830',
 182                 $field->indicator(1), $field->indicator(2),
 183                 @linksubfields
 184                 );
 185             push @newfields, $link_field;
 186         }
 187
 188         if ( @newsubfields ) {
 189             my $new_field = MARC::Field->new( '490', $has_links, '',
 190                                               @newsubfields );
 191             push @newfields, $new_field;
 192         }
 193
 194         $biblio->delete_fields( $field );
 195     }
 196
 197     foreach my $field ( $biblio->field( '490' ) ) {
 198         my @newsubfields;
 199         foreach my $subfield ( sort keys %{ $fields{'490'} } ) {
 200             my @values = $field->subfield( $subfield );
 201
 202             if ( $fields{'440'}{$subfield} ) {
 203                 foreach my $v ( @values ) {
 204                     push @newsubfields, ( $subfield, $v );
 205                 }
 206             }
 207         }
 208
 209         if ( @newsubfields ) {
 210             my $new_field = MARC::Field->new( '440', '', '',
 211                                               @newsubfields );
 212             push @newfields, $new_field;
 213         }
 214
 215         $biblio->delete_fields( $field );
 216     }
 217     $biblio->insert_fields_ordered( @newfields );
 218
 219     if ( $verbose ) {
 220         print "Changing MARC for biblio number $biblionumber.\n";
 221     }
 222     else {
 223         print ".";
 224     }
 225     ModBiblioMarc( $biblio, $biblionumber, $framework );
 226 }
 227 print "\n";
 228
 229 if ( $update_frameworks ) {
 230     print "Updating Koha to MARC mappings for seriestitle and volume\n";
 231
 232     # set new mappings for koha fields
 233     $dbh->do(
 234 "UPDATE marc_subfield_structure SET kohafield='seriestitle'
 235   WHERE tagfield='490' AND tagsubfield='a'"
 236     );
 237     $dbh->do(
 238 "UPDATE marc_subfield_structure SET kohafield='volume'
 239   WHERE tagfield='490' AND tagsubfield='v'"
 240     );
 241
 242     # empty old koha fields
 243     $dbh->do(
 244 "UPDATE marc_subfield_structure SET kohafield=''
 245   WHERE kohafield='seriestitle' AND tagfield='440' AND tagsubfield='a'"
 246         );
 247     $dbh->do(
 248 "UPDATE marc_subfield_structure SET kohafield=''
 249   WHERE kohafield='volume' AND tagfield='440' AND tagsubfield='v'"
 250         );
 251 }
 252
 253 sub print_usage {
 254     print <<_USAGE_;
 255 $0: switch MARC21 440 tag and 490 tag contents
 256
 257 Parameters:
 258     -c            Commit the changes to the marc records.
 259
 260     -l            Add 830 tags with authority information from 440.  Otherwise
 261                   this information will be ignored.
 262
 263     -f            Also update the Koha field to MARC framework mappings for the
 264                   seriestitle and volume Koha fields.
 265
 266     -v            Show more information as the records are being changed.
 267
 268     --help or -h  show this message.
 269
 270 _USAGE_
 271 }