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

(-)a/xt/db_translate.t (-1 / +279 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# Copyright (C) 2013 Tamil s.a.r.l.
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 Modern::Perl;
21
use Test::More qw/no_plan/;
22
use File::Find;
23
use IO::String;
24
use Text::CSV;
25
26
27
my $test;
28
$test = {
29
30
    base => "installer/data/mysql/",
31
32
    # FIXME: This array can be completed to reference other SQL files to be
33
    # tested, for various languages. 'Tester' analyzes SQL files, parse them,
34
    # and so must be adapted to each type of SQL file. For the time being two
35
    # tests are available: (1) for biblio framework: procedure
36
    # 'framework_biblios' and (2) for authorities frameworks: procedure
37
    # 'framework_authorities'.
38
    files => [
39
        #{
40
        #    source => 'en/marcflavour/marc21/mandatory/marc21_framework_DEFAULT.sql',
41
        #    target => 'es-ES/marcflavour/marc21/mandatory/marc21_framework_DEFAULT.sql',
42
        #    description => 'es-ES MARC21 biblio framework', 
43
        #    proc => 'framework_biblios',
44
        #},
45
        #{
46
        #    source => 'en/marcflavour/marc21/mandatory/authorities_normal_marc21.sql',
47
        #    target => 'es-ES/marcflavour/marc21/mandatory/authorities_normal_marc21.sql',
48
        #    description => 'es-ES MARC21 authoritity framework', 
49
        #    proc => 'framework_authorities',
50
        #},
51
        #{
52
        #    source => 'fr-FR/marcflavour/unimarc_complet/Obligatoire/framework_DEFAULT.sql',
53
        #    target => 'en/marcflavour/unimarc/mandatory/unimarc_framework_DEFAULT.sql',
54
        #    description => 'en UNIMARC biblio framework', 
55
        #    proc => 'framework_biblios',
56
        #},
57
        {
58
            source => 'en/mandatory/userflags.sql',
59
            target => 'fr-FR/1-Obligatoire/userflags.sql',
60
            description => 'fr-FR user flags',
61
            proc => 'p_userflags',
62
        },
63
        {
64
            source => 'en/mandatory/userpermissions.sql',
65
            target => 'fr-FR/1-Obligatoire/userpermissions.sql',
66
            description => 'fr-FR user flags',
67
            proc => 'p_userflags',
68
        },
69
        {
70
            source => 'en/mandatory/userflags.sql',
71
            target => 'de-DE/mandatory/userflags.sql',
72
            description => 'de-DE user flags',
73
            proc => 'p_userflags',
74
        },
75
        {
76
            source => 'en/mandatory/userpermissions.sql',
77
            target => 'de-DE/mandatory/userpermissions.sql',
78
            description => 'de-DE user permissions',
79
            proc => 'p_userflags',
80
        },
81
        {
82
            source => 'en/mandatory/userflags.sql',
83
            target => 'it-IT/necessari/userflags.sql',
84
            description => 'it-IT user flags',
85
            proc => 'p_userflags',
86
        },
87
        {
88
            source => 'en/mandatory/userflags.sql',
89
            target => 'es-ES/mandatory/userflags.sql',
90
            description => 'es-ES user flags',
91
            proc => 'p_userflags',
92
        },
93
        {
94
            source => 'en/mandatory/userflags.sql',
95
            target => 'pl-PL/mandatory/userflags.sql',
96
            description => 'pl-PL user flags',
97
            proc => 'p_userflags',
98
        },
99
        {
100
            source => 'en/mandatory/userflags.sql',
101
            target => 'uk-UA/mandatory/permissions_and_user_flags.sql',
102
            description => 'uk-UA user flags',
103
            proc => 'p_userflags',
104
        },
105
        {
106
            source => 'en/mandatory/userflags.sql',
107
            target => 'ru-RU/mandatory/permissions_and_user_flags.sql',
108
            description => 'ru-RU user flags',
109
            proc => 'p_userflags',
110
        },
111
        {
112
            source => 'en/mandatory/userflags.sql',
113
            target => 'nb-NO/1-Obligatorisk/userflags.sql',
114
            description => 'nb-NO user flags',
115
            proc => 'p_userflags',
116
        },
117
    ],
118
119
    current => undef,
120
121
    csv => Text::CSV->new(
122
        { binary => 1, quote_char => "'", escape_char => '\\', allow_whitespace => 1, } ),
123
124
    key => {},
125
126
    fh => { source => undef, target => undef },
127
128
    # Read source/targer files. Populate keys identifying inserted values in
129
    # SQL tables.
130
    # Parameter: <addkey> a function which build keys, by category of key... 
131
    populate => sub {
132
        my $addkey = shift;
133
134
        for my $where ( qw/source target/ ) {
135
            my $fh = $test->{fh}->{$where};
136
            while (<$fh>) {
137
                chop;
138
                next if /^ *--/;
139
                next unless /\((.*)\)/;
140
                $addkey->($where, $1);
141
            }
142
        }
143
    },
144
145
    missing => sub {
146
        my ($what, $label) = @_;
147
        my $s = $test->{key}->{source}->{$what};
148
        my $t = $test->{key}->{target}->{$what};
149
        my $count_source = scalar keys %$s;
150
        my $count_target = scalar keys %$t;
151
        return if $count_source == 0;
152
        ok( $count_source == $count_target,
153
            "Count master $label [$count_source] = count translated [$count_target]" );
154
        my @missing = sort grep { ! $t->{$_} } keys %$s;
155
        fail( "Missing $label in translated file: " . join(', ', @missing) ) if @missing;
156
        my @supernumerary = sort grep { ! $s->{$_} } keys %$t;
157
        fail( "Supernumerary $label found in translated file: " . join(', ', @supernumerary) )
158
            if @supernumerary;
159
    },
160
161
    def_open => sub {
162
        for my $where ( qw/source target/ ) {
163
            my $c = $test->{current};
164
            open my $fh, '<', $test->{base} . $c->{$where};
165
            ok( $fh, "$test->{current}->{description} - $where file '$c->{$where}' exists");
166
            $test->{fh}->{$where} = $fh;
167
        }
168
    },
169
170
    framework_biblios => sub {
171
        $test->{def_open}->();
172
        my $k = $test->{key} = {};
173
        my $addkey = sub {
174
            my ($where, $what) = @_;
175
            $what =~ s/\\"//g;
176
            my $io = IO::String->new(\$what);
177
            my $e = $test->{csv}->getline($io);
178
            return unless $e;
179
            given (scalar @$e) {
180
                when (7) {
181
                    $k->{$where}->{field}->{$e->[6] . $e->[0]} = 1;
182
                }
183
                when (17) {
184
                    $k->{$where}->{subfield}->{$e->[0] . '$' . $e->[1]} = 1;
185
                }
186
            }
187
        };
188
        $test->{populate}->($addkey);
189
        $test->{missing}->('field', 'fields');
190
        $test->{missing}->('subfield', 'subfields');
191
    },
192
193
    framework_authorities => sub {
194
        my $tr = shift;
195
        $test->{def_open}->($tr);
196
        my $k = $test->{key} = {};
197
        my $addkey = sub {
198
            my ($where, $what) = @_;
199
            $what =~ s/\\"//g;
200
            my $io = IO::String->new(\$what);
201
            my $e = $test->{csv}->getline($io);
202
            return unless $e;
203
            given (scalar @$e) {
204
                when (16) {
205
                    $k->{$where}->{subfield}->{
206
                        $e->[0] . $e->[1] . $e->[2]} = 1;
207
                }
208
                when (4) {
209
                    $k->{$where}->{type}->{$e->[0]} = 1;
210
                }
211
                when (7) {
212
                    $k->{$where}->{field}->{$e->[0] . $e->[1]} = 1;
213
                }
214
            }
215
        };
216
        $test->{populate}->($addkey);
217
        $test->{missing}->('type', 'auth types');
218
        $test->{missing}->('field', 'fields');
219
        $test->{missing}->('subfield', 'subfields');
220
    },
221
222
    p_userflags => sub {
223
        my $tr = shift;
224
        $test->{def_open}->($tr);
225
        my $k = $test->{key} = {};
226
        my $addkey = sub {
227
            my ($where, $what) = @_;
228
            $what =~ s/\\"//g;
229
            $what =~ s/''/\\'/g;
230
            return if $what =~ /bit.*flag/;
231
            my $io = IO::String->new(\$what);
232
            my $e = $test->{csv}->getline($io);
233
            return unless $e;
234
            given (scalar @$e) {
235
                when (4) {
236
                    $k->{$where}->{tag}->{$e->[0] . '-' . $e->[1]} = 1;
237
                }
238
                when (3) {
239
                    return if $e->[0] eq 'module_bit';
240
                    $k->{$where}->{perm}->{$e->[0] . '-' . $e->[1]} = 1;
241
                }
242
            }
243
        };
244
        $test->{populate}->($addkey);
245
        $test->{missing}->('tag', 'user tags');
246
        $test->{missing}->('perm', 'user permissions');
247
    },
248
249
    run => sub {
250
        for my $current (@{$test->{files}}) {
251
            my $proc_name = $current->{proc};
252
            my $proc = $test->{$proc_name};
253
            die "Unknown test procedure: $proc_name" unless $proc;
254
            $test->{current} = $current;
255
            $proc->();
256
        }
257
    },
258
259
};
260
261
262
$test->{run}->();
263
264
265
=head1 NAME
266
267
db_translate.t
268
269
=head1 DESCRIPTION
270
271
This test validate DB translation by comparing the master 'en' version whith
272
the translated version.
273
274
For example, 
275
276
prove -v xt/db_translate.t
277
278
=cut
279

Return to bug 11396