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