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 426-431 sub nsb_clean { Link Here
426
}
427
}
427
428
428
429
430
=head2 SanitizeRecord
431
432
SanitizeRecord($marcrecord);
433
434
Sanitize a record
435
This routine is called in the maintenance script misc/maintenance/batch_sanitize_records.pl.
436
It cleans any string with '&...', replacing it by '&'
437
438
=cut
439
440
sub SanitizeRecord {
441
    my ( $record, $biblionumber ) = @_;
442
    my $string;
443
    my $record_modified = 0;
444
    my $frameworkcode   = C4::Biblio::GetFrameworkCode($biblionumber);
445
    my ( $url_field, $url_subfield ) =
446
      C4::Biblio::GetMarcFromKohaField( 'biblioitems.url', $frameworkcode );
447
    foreach my $field ( $record->fields() ) {
448
        if ( $field->is_control_field() ) {
449
            my $value           = $field->data();
450
            my $sanitized_value = _entity_clean($value);
451
            $record_modified = 1 if $sanitized_value ne $value;
452
            $field->update($sanitized_value);
453
        }
454
        else {
455
            my @subfields = $field->subfields();
456
            my @new_subfields;
457
            foreach my $subfield (@subfields) {
458
                next
459
                  if $url_field eq $field->tag()
460
                      and $url_subfield eq $subfield->[0];
461
                my $value           = $subfield->[1];
462
                my $sanitized_value = _entity_clean($value);
463
                push @new_subfields, $subfield->[0] => $sanitized_value;
464
                $record_modified = 1 if $sanitized_value ne $value;
465
            }
466
            if ( scalar(@new_subfields) > 0 ) {
467
                my $new_field = eval {
468
                    MARC::Field->new(
469
                        $field->tag(),        $field->indicator(1),
470
                        $field->indicator(2), @new_subfields
471
                    );
472
                };
473
                if ($@) {
474
                    warn "error : $@";
475
                }
476
                else {
477
                    $field->replace_with($new_field);
478
                }
479
480
            }
481
        }
482
    }
483
484
    return $record, $record_modified;
485
}
486
487
sub _entity_clean {
488
    my ($string) = @_;
489
    $string =~ s/(&)(amp;)+/$1/g;
490
    return $string;
491
}
492
429
=head1 INTERNAL FUNCTIONS
493
=head1 INTERNAL FUNCTIONS
430
494
431
=head2 _default_marc21_charconv_to_utf8
495
=head2 _default_marc21_charconv_to_utf8
(-)a/misc/maintenance/batch_sanitize_records.pl (+222 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
    my ( $cleaned_record, $has_been_modified ) =
113
      C4::Charset::SanitizeRecord( $record, $biblionumber );
114
    if ($has_been_modified) {
115
        my $frameworkcode = C4::Biblio::GetFrameworkCode($record);
116
117
        C4::Biblio::ModBiblio( $cleaned_record, $biblionumber, $frameworkcode )
118
            if $confirm;
119
        push @changes, $biblionumber;
120
        say " Done!" if $verbose;
121
    }
122
    else {
123
        say " Nothing todo." if $verbose;
124
    }
125
}
126
127
if ($verbose) {
128
    say "Total: "
129
      . @changes
130
      . " records "
131
      . ( $confirm ? "cleaned!" : "to clean." );
132
}
133
134
if ( $reindex and $confirm and @changes ) {
135
    say "Now, reindexing using -b -v" if $verbose;
136
    my $kohapath = C4::Context->config('intranetdir');
137
    my $cmd      = qq|
138
        $kohapath/misc/migration_tools/rebuild_zebra.pl -b -v -where "biblionumber IN ( |
139
      . join( ',', @changes ) . q| )"
140
    |;
141
    system($cmd);
142
}
143
144
sub biblios_to_sanitize {
145
    my $dbh   = C4::Context->dbh;
146
    my $query = q{
147
        SELECT biblionumber
148
        FROM biblioitems
149
        WHERE marcxml
150
        LIKE "%&amp;amp;%"
151
    };
152
    return @{ $dbh->selectcol_arrayref( $query, { Slice => {} }, ) };
153
}
154
155
=head1 NAME
156
157
batch_sanitize_biblios - This script sanitize a biblio, replacing '&amp;amp;amp;etc.' with '&amp;' in it.
158
159
=head1 SYNOPSIS
160
161
batch_sanitize_biblios.pl [-h|--help] [-v|--verbose] [-c|--confirm] [--biblionumbers=BIBLIONUMBER_LIST] [-f|--filename=FILENAME] [--auto-search] [--reindex]
162
163
Replace '&amp;' by '&' in a record, you can either give some biblionumbers or a file with biblionumbers or ask for an auto-search
164
165
=head1 OPTIONS
166
167
=over
168
169
=item B<-h|--help>
170
171
Print a brief help message
172
173
=item B<-v|--verbose>
174
175
Verbose mode.
176
177
=item B<-c|--confirm>
178
179
This flag must be provided in order for the script to actually
180
sanitize records. If it is not supplied, the script will
181
only report on the record list to process.
182
183
=item B<--biblionumbers=BIBLIONUMBER_LIST>
184
185
Give a biblionumber list using this parameter. They must be separated by comma.
186
187
=item B<-f|--filename=FILENAME>
188
189
Give a biblionumber list using a filename. One biblionumber by line or separate them with a withespace character.
190
191
=item B<--auto_search>
192
193
Automatically search records containing "&amp;" in biblioitems.marcxml or in the specified fields.
194
195
=item B<--reindex>
196
197
Reindex the modified records.
198
199
=back
200
201
=head1 AUTHOR
202
203
Alex Arnaud <alex.arnaud@biblibre.com>
204
Christophe Croullebois <christophe.croullebois@biblibre.com>
205
Jonathan Druart <jonathan.druart@biblibre.com>
206
207
=head1 COPYRIGHT
208
209
Copyright 2014 BibLibre
210
211
=head1 LICENSE
212
213
This file is part of Koha.
214
215
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
216
Foundation; either version 3 of the License, or (at your option) any later version.
217
218
You should have received a copy of the GNU General Public License along
219
with Koha; if not, write to the Free Software Foundation, Inc.,
220
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
221
222
=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