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