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

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