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