View | Details | Raw Unified | Return to bug 8218
Collapse All | Expand All

(-)a/C4/Charset.pm (+64 lines)
Lines 41-46 BEGIN { Link Here
41
        SetMarcUnicodeFlag
41
        SetMarcUnicodeFlag
42
        StripNonXmlChars
42
        StripNonXmlChars
43
        nsb_clean
43
        nsb_clean
44
        SanitizeRecord
44
    );
45
    );
45
}
46
}
46
47
Lines 424-429 sub nsb_clean { Link Here
424
}
425
}
425
426
426
427
428
=head2 SanitizeRecord
429
430
SanitizeRecord($marcrecord);
431
432
Sanitize a record
433
This routine is called in the maintenance script misc/maintenance/batch_sanitize_records.pl.
434
It cleans any string with '&...', replacing it by '&'
435
436
=cut
437
438
sub SanitizeRecord {
439
    my ( $record, $biblionumber ) = @_;
440
    my $string;
441
    my $record_modified = 0;
442
    my $frameworkcode   = C4::Biblio::GetFrameworkCode($biblionumber);
443
    my ( $url_field, $url_subfield ) =
444
      C4::Biblio::GetMarcFromKohaField( 'biblioitems.url', $frameworkcode );
445
    foreach my $field ( $record->fields() ) {
446
        if ( $field->is_control_field() ) {
447
            my $value           = $field->data();
448
            my $sanitized_value = _entity_clean($value);
449
            $record_modified = 1 if $sanitized_value ne $value;
450
            $field->update($sanitized_value);
451
        }
452
        else {
453
            my @subfields = $field->subfields();
454
            my @new_subfields;
455
            foreach my $subfield (@subfields) {
456
                next
457
                  if $url_field eq $field->tag()
458
                      and $url_subfield eq $subfield->[0];
459
                my $value           = $subfield->[1];
460
                my $sanitized_value = _entity_clean($value);
461
                push @new_subfields, $subfield->[0] => $sanitized_value;
462
                $record_modified = 1 if $sanitized_value ne $value;
463
            }
464
            if ( scalar(@new_subfields) > 0 ) {
465
                my $new_field = eval {
466
                    MARC::Field->new(
467
                        $field->tag(),        $field->indicator(1),
468
                        $field->indicator(2), @new_subfields
469
                    );
470
                };
471
                if ($@) {
472
                    warn "error : $@";
473
                }
474
                else {
475
                    $field->replace_with($new_field);
476
                }
477
478
            }
479
        }
480
    }
481
482
    return $record, $record_modified;
483
}
484
485
sub _entity_clean {
486
    my ($string) = @_;
487
    $string =~ s/(&)(amp;)+/$1/g;
488
    return $string;
489
}
490
427
=head1 INTERNAL FUNCTIONS
491
=head1 INTERNAL FUNCTIONS
428
492
429
=head2 _default_marc21_charconv_to_utf8
493
=head2 _default_marc21_charconv_to_utf8
(-)a/misc/maintenance/batch_sanitize_records.pl (+224 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# This file is part of Koha.
4
#
5
# Copyright 2014 BibLibre
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 Modern::Perl;
21
use C4::Charset qw( SanitizeRecord );
22
use C4::Context;
23
use DBI;
24
use C4::Biblio;
25
use Getopt::Long;
26
use Pod::Usage;
27
28
my ( $help, $verbose, $confirm, $biblionumbers, $reindex, $filename,
29
    $auto_search );
30
my $result = GetOptions(
31
    'h|help'          => \$help,
32
    'v|verbose'       => \$verbose,
33
    'c|confirm'       => \$confirm,
34
    'biblionumbers:s' => \$biblionumbers,
35
    'reindex'         => \$reindex,
36
    'f|filename:s'    => \$filename,
37
    'auto-search'     => \$auto_search,
38
) || pod2usage(1);
39
40
if ($help) {
41
    pod2usage(0);
42
}
43
44
unless ( $filename or $biblionumbers or $auto_search ) {
45
    pod2usage(
46
        -exitval => 1,
47
        -message =>
48
          qq{\n\tAt least one record number source should be provided.\n}
49
    );
50
}
51
52
if (   $filename and $biblionumbers
53
    or $filename and $auto_search
54
    or $biblionumbers and $auto_search )
55
{
56
    pod2usage(
57
        -exitval => 1,
58
        -message => qq{\n\tOnly one record number source should be provided.\n}
59
    );
60
}
61
62
my @biblionumbers;
63
64
# We first detect if we have a file or biblos directly entered by command line
65
#or if we want to use findAmp() sub
66
if ($auto_search) {
67
    @biblionumbers = biblios_to_sanitize();
68
}
69
elsif ($filename) {
70
    if ( -e $filename ) {
71
        open( my $fh, '<', $filename ) || die("Can't open $filename ($!)");
72
        while (<$fh>) {
73
            chomp;
74
            my $line = $_;
75
            push @biblionumbers, split( " |,", $line );
76
        }
77
        close $fh;
78
    }
79
    else {
80
        pod2usage(
81
            -exitval => 1,
82
            -message =>
83
qq{\n\tThis filename does not exist. Please verify the path is correct.\n}
84
        );
85
    }
86
}
87
else {
88
    @biblionumbers = split m|,|, $biblionumbers if $biblionumbers;
89
}
90
91
# We remove spaces
92
s/(^\s*|\s*$)//g for @biblionumbers;
93
94
# Remove empty lines
95
@biblionumbers = grep { !/^$/ } @biblionumbers;
96
97
say @biblionumbers . " records to process" if $verbose;
98
99
my @changes;
100
for my $biblionumber (@biblionumbers) {
101
    print "processing record $biblionumber..." if $verbose;
102
    unless ( $biblionumber =~ m|^\d+$| ) {
103
        say " skipping. ERROR: Invalid biblionumber." if $verbose;
104
        next;
105
    }
106
    my $record = C4::Biblio::GetMarcBiblio($biblionumber);
107
    unless ($record) {
108
        say " skipping. ERROR: Invalid record." if $verbose;
109
        next;
110
    }
111
112
    unless ($confirm) {
113
        say " will be processed" if $verbose;
114
        next;
115
    }
116
    my ( $cleaned_record, $has_been_modified ) =
117
      C4::Charset::SanitizeRecord( $record, $biblionumber );
118
    if ($has_been_modified) {
119
        my $frameworkcode = C4::Biblio::GetFrameworkCode($record);
120
        C4::Biblio::ModBiblio( $cleaned_record, $biblionumber, $frameworkcode );
121
        push @changes, $biblionumber;
122
        say " Done!" if $verbose;
123
    }
124
    else {
125
        say " Nothing todo." if $verbose;
126
    }
127
}
128
129
if ($verbose) {
130
    say "Total: "
131
      . @changes
132
      . " records "
133
      . ( $confirm ? "cleaned!" : "to clean." );
134
}
135
136
if ( $reindex and $confirm and @changes ) {
137
    say "Now, reindexing using -b -v" if $verbose;
138
    my $kohapath = C4::Context->config('intranetdir');
139
    my $cmd      = qq|
140
        $kohapath/misc/migration_tools/rebuild_zebra.pl -b -v -where "biblionumber IN ( |
141
      . join( ',', @changes ) . q| )"
142
    |;
143
    system($cmd);
144
}
145
146
sub biblios_to_sanitize {
147
    my $dbh   = C4::Context->dbh;
148
    my $query = q{
149
        SELECT biblionumber
150
        FROM biblioitems
151
        WHERE marcxml
152
        LIKE "%&amp;amp;%"
153
    };
154
    return @{ $dbh->selectcol_arrayref( $query, { Slice => {} }, ) };
155
}
156
157
=head1 NAME
158
159
batch_sanitize_biblios - This script sanitize a biblio, replacing '&amp;amp;amp;etc.' with '&amp;' in it.
160
161
=head1 SYNOPSIS
162
163
batch_sanitize_biblios.pl [-h|--help] [-v|--verbose] [-c|--confirm] [--biblionumbers=BIBLIONUMBER_LIST] [-f|--filename=FILENAME] [--auto-search] [--reindex]
164
165
Replace '&amp;' by '&' in a record, you can either give some biblionumbers or a file with biblionumbers or ask for an auto-search
166
167
=head1 OPTIONS
168
169
=over
170
171
=item B<-h|--help>
172
173
Print a brief help message
174
175
=item B<-v|--verbose>
176
177
Verbose mode.
178
179
=item B<-c|--confirm>
180
181
This flag must be provided in order for the script to actually
182
sanitize records. If it is not supplied, the script will
183
only report on the record list to process.
184
185
=item B<--biblionumbers=BIBLIONUMBER_LIST>
186
187
Give a biblionumber list using this parameter. They must be separated by comma.
188
189
=item B<-f|--filename=FILENAME>
190
191
Give a biblionumber list using a filename. One biblionumber by line or separate them with a withespace character.
192
193
=item B<--auto_search>
194
195
Automatically search records containing "&amp;" in biblioitems.marcxml or in the specified fields.
196
197
=item B<--reindex>
198
199
Reindex the modified records.
200
201
=back
202
203
=head1 AUTHOR
204
205
Alex Arnaud <alex.arnaud@biblibre.com>
206
Christophe Croullebois <christophe.croullebois@biblibre.com>
207
Jonathan Druart <jonathan.druart@biblibre.com>
208
209
=head1 COPYRIGHT
210
211
Copyright 2014 BibLibre
212
213
=head1 LICENSE
214
215
This file is part of Koha.
216
217
Koha is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software
218
Foundation; either version 3 of the License, or (at your option) any later version.
219
220
You should have received a copy of the GNU General Public License along
221
with Koha; if not, write to the Free Software Foundation, Inc.,
222
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
223
224
=cut
(-)a/t/db_dependent/Charset.t (-1 / +51 lines)
Line 0 Link Here
0
- 
1
use Modern::Perl;
2
use Test::More tests => 4;
3
use MARC::Record;
4
5
use C4::Biblio qw( AddBiblio SetFieldMapping GetMarcFromKohaField );
6
use C4::Context;
7
use C4::Charset qw( SanitizeRecord );
8
9
my $dbh = C4::Context->dbh;
10
$dbh->{RaiseError} = 1;
11
$dbh->{AutoCommit} = 0;
12
13
my $frameworkcode = q||;
14
15
$dbh->do(q|
16
    DELETE FROM marc_subfield_structure WHERE kohafield='biblioitems.url'
17
|);
18
$dbh->do(qq|
19
    INSERT INTO marc_subfield_structure(frameworkcode,kohafield,tagfield,tagsubfield)
20
    VALUES ('$frameworkcode', 'biblioitems.url', '856', 'u')
21
|);
22
my ( $url_field, $url_subfield ) = C4::Biblio::GetMarcFromKohaField('biblioitems.url', $frameworkcode);
23
24
my $title = q|My title & a word & another word|;
25
my $url = q|http://www.example.org/index.pl?arg1=val1&amp;arg2=val2|;
26
my $record = MARC::Record->new();
27
$record->append_fields(
28
    MARC::Field->new('100', ' ', ' ', a => 'my author'),
29
    MARC::Field->new('245', ' ', ' ', a => $title),
30
    MARC::Field->new($url_field, ' ', ' ', $url_subfield => $url ),
31
);
32
33
my ($biblionumber, $biblioitemnumber) = AddBiblio($record, $frameworkcode);
34
my ( $sanitized_record, $has_been_modified ) = C4::Charset::SanitizeRecord( $record, $biblionumber );
35
is( $has_been_modified, 0, 'SanitizeRecord: the record has not been modified' );
36
is( $url, $sanitized_record->subfield($url_field, $url_subfield), 'SanitizeRecord: the url has not been modified');
37
38
$title = q|My title &amp;amp;amp; a word &amp;amp; another word|;
39
$record = MARC::Record->new();
40
$record->append_fields(
41
    MARC::Field->new('100', ' ', ' ', a => 'my author'),
42
    MARC::Field->new('245', ' ', ' ', a => $title),
43
    MARC::Field->new($url_field, ' ', ' ', $url_subfield => $url ),
44
);
45
46
($biblionumber, $biblioitemnumber) = AddBiblio($record, $frameworkcode);
47
( $sanitized_record, $has_been_modified ) = C4::Charset::SanitizeRecord( $record, $biblionumber );
48
is( $has_been_modified, 1, 'SanitizeRecord: the record has been modified' );
49
is( $url, $sanitized_record->subfield($url_field, $url_subfield), 'SanitizeRecord: the url has not been modified');
50
51
$dbh->rollback;

Return to bug 8218