misc/maintenance/MARC21_utf8_flag_fix.pl

   1 #!/usr/bin/perl
   2 #
   3 # Copyright 2009 Liblime
   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 use MARC::Record;
  24 use MARC::File::XML;
  25 use Getopt::Long qw(:config auto_help auto_version);
  26 use Pod::Usage;
  27
  28 use C4::Biblio;
  29 use C4::Charset;
  30 use C4::Context;
  31 use C4::Debug;
  32
  33 BEGIN {
  34     # find Koha's Perl modules
  35     # test carefully before changing this
  36     use FindBin;
  37     eval { require "$FindBin::Bin/../kohalib.pl" };
  38 }
  39
  40 our $debug;
  41
  42 ## OPTIONS
  43 my $help    = 0;
  44 my $man     = 0;
  45 my $verbose = 0;
  46
  47 my $limit;      # undef, not zero.
  48 my $offset  = 0;
  49 my $dump    = 0;
  50 my $summary = 1;
  51 my $fix     = 0;
  52
  53 GetOptions(
  54     'help|?'    => \$help,
  55     'man'       => \$man,
  56     'verbose=i' => \$verbose,
  57     'limit=i'   => \$limit,
  58     'offset=i'  => \$offset,
  59     'dump!'     => \$dump,
  60     'summary!'  => \$summary,
  61     'fix!'      => \$fix,
  62 ) or pod2usage(2);
  63 pod2usage( -verbose => 2 ) if ($man);
  64 pod2usage( -verbose => 2 ) if ($help and $verbose);
  65 pod2usage(1) if $help;
  66
  67 if ($debug) {
  68     $summary++;
  69     $verbose++;
  70 }
  71
  72 my $marcflavour = C4::Context->preference('marcflavour') or die "No marcflavour (MARC21 or UNIMARC) set in syspref";
  73 ($marcflavour eq 'MARC21') or die "marcflavour must be MARC21, not $marcflavour";
  74
  75 my $all = C4::Context->dbh->prepare("SELECT COUNT(*) FROM biblioitems");
  76 $all->execute;
  77 my $total = $all->fetchrow;
  78
  79 my $count_query = "SELECT COUNT(*) FROM biblioitems WHERE substr(marc, 10, 1)  = ?";
  80 my $query       = "SELECT     *    FROM biblioitems WHERE substr(marc, 10, 1) <> ?";
  81
  82 my $sth = C4::Context->dbh->prepare($count_query);
  83 $sth->execute('a');
  84 my $count    = $sth->fetchrow;
  85 my $badcount = $total-$count;
  86
  87 if ($summary) {
  88     print  "# biblioitems with leader/09 = 'a'\n";
  89     printf "# %9s match\n",   $count;
  90     printf "# %9s  BAD \n",   $badcount;
  91     printf "# %9s total\n\n", $total;
  92     printf "# Examining %s BAD record(s), offset %d:\n", ($limit || 'all'), $offset;
  93 }
  94
  95 my $bad_recs = C4::Context->dbh->prepare($query);
  96 $bad_recs->execute('a');
  97 $limit or $limit = $bad_recs->rows();   # limit becomes max if unspecified
  98 $limit += $offset if $offset;           # increase limit for offset
  99 my $i = 0;
 100
 101 MARC::File::XML->default_record_format($marcflavour) or die "FAILED MARC::File::XML->default_record_format($marcflavour)";
 102
 103 while ( my $row = $bad_recs->fetchrow_hashref() ) {
 104     (++$i > $limit) and last;
 105     (  $i > $offset) or next;
 106     my $xml = $row->{marcxml};
 107     $xml =~ s/.*(\<leader\>)/$1/s;
 108     $xml =~ s/(\<\/leader\>).*/$1/s;
 109     # $xml now pared down to just the <leader> element
 110     printf "# %4d of %4d: biblionumber %s : %s\n", $i, $badcount, $row->{biblionumber}, $xml;
 111     my $stripped = StripNonXmlChars($row->{marcxml});
 112     ($stripped eq $row->{marcxml}) or printf STDERR "%d NON-XML Characters removed!!\n", (length($row->{marcxml}) - length($stripped));
 113     my $record = eval { MARC::Record::new_from_xml( $stripped, 'utf8', $marcflavour ) };
 114     if ($@ or not $record) {
 115         print STDERR "ERROR in MARC::Record::new_from_xml(\$marcxml, 'utf8', $marcflavour): $@\n\tSkipping $row->{biblionumber}\n";
 116         next;
 117     }
 118     if ($fix) {
 119         SetMarcUnicodeFlag($record, $marcflavour);
 120         if (ModBiblioMarc($record, $row->{biblionumber})) {
 121             printf "# %4d of %4d: biblionumber %s : <leader>%s</leader>\n", $i, $badcount, $row->{biblionumber}, $record->leader();
 122         } else {
 123             print STDERR "ERROR in ModBiblioMarc(\$record, $row->{biblionumber})\n";
 124         }
 125     }
 126     $dump and print $row->{marcxml}, "\n";
 127 }
 128
 129 __END__
 130
 131 =head1 NAME
 132
 133 MARC21_utf8_flag_fix.pl - Repair missing leader position 9 value ("a" for MARC21 - UTF8).
 134
 135 =head1 SYNOPSIS
 136
 137 MARC21_utf8_flag_fix.pl [ -h | -m ] [ -v ] [ -d ] [ -s ] [ -l N ] [ -o N ] [ -f ]
 138
 139  Help Options:
 140    -h --help -?   Brief help message
 141    -m --man       Full documentation, same as --help --verbose
 142       --version   Prints version info
 143
 144  Feedback Options:
 145    -d --dump      Dump MARCXML of biblioitems processed, default OFF
 146    -s --summary   Print initial summary of good and bad biblioitems counted, default ON
 147    -v --verbose   Increase verbosity of output, default OFF
 148
 149  Run Options:
 150    -f --fix       Save repaired leaders to biblioitems.marcxml,
 151    -l --limit     Number of biblioitems to display or fix
 152    -o --offset    Number of biblioitems to skip (not displayed or fixed)
 153
 154 =head1 OPTIONS
 155
 156 =over 8
 157
 158 =item B<--fix>
 159
 160 This is the most important option.  Without it, the script just tells you about the problem records.
 161 With --fix, the script fixes the same records.
 162
 163 =item B<--limit=N>
 164
 165 Like a LIMIT statement in SQL, this constrains the number of records targeted by the script to an integer N.
 166 The default is to target all records with bad leaders.
 167
 168 =item B<--offset=N>
 169
 170 Like an OFFSET statement in SQL, this tells the script to skip N of the targeted records.
 171 The default is 0, i.e. skip none of them.
 172
 173 =back
 174
 175 The binary ON/OFF options can be negated like:
 176    B<--nosummary>   Do not display summary.
 177    B<--nodump>      Do not dump MARCXML.
 178    B<--nofix>       Do not change any records.  This is the default mode.
 179
 180 =head1 DESCRIPTION
 181
 182 Koha expects to have all MARXML records internalized in UTF-8 encoding.  This
 183 presents a problem when records have been inserted with the leader/09 showing
 184 blank for MARC8 encoding.  This script is used to determine the extent of the
 185 problem and to fix the affected leaders.
 186
 187 As the name suggests, this script is only useful for MARC21 and will die for marcflavour UNIMARC.
 188
 189 Run MARC21_utf8_flag_fix.pl the first time with no options, and assuming you agree that the leaders
 190 presented need fixing, run it again with B<--fix>.
 191
 192 =head1 USAGE EXAMPLES
 193
 194 B<MARC21_utf8_flag_fix.pl>
 195
 196 In the most basic form, displays summary of biblioitems examined
 197 and the leader from any found without /09 = a.
 198
 199 B<MARC21_utf8_flag_fix.pl --fix>
 200
 201 Fixes the same biblioitems, displaying summary and each leader before/after change.
 202
 203 B<MARC21_utf8_flag_fix.pl --limit=3 --offset=15 --nosummary --dump>
 204
 205 Dumps MARCXML from the 16th, 17th and 18th bad records found.
 206
 207 B<MARC21_utf8_flag_fix.pl -l 3 -o 15 -s 0 -d>
 208
 209 Same thing as previous example in terse form.
 210
 211 =head1 TO DO
 212
 213 Allow biblionumbers to be piped into STDIN as the selection mechanism.
 214
 215 =head1 SEE ALSO
 216
 217 C4::Biblio
 218
 219 =cut