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