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