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

(-)a/Koha/CSV.pm (+226 lines)
Line 0 Link Here
1
package Koha::CSV;
2
3
# Copyright 2026 Theke Solutions
4
#
5
# This file is part of Koha.
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 <https://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use Text::CSV_XS;
23
use C4::Context;
24
25
use base qw(Class::Accessor);
26
27
__PACKAGE__->mk_accessors(qw( binary formula always_quote eol sep_char ));
28
29
=head1 NAME
30
31
Koha::CSV - Wrapper around Text::CSV_XS with Koha-specific defaults
32
33
=head1 SYNOPSIS
34
35
    my $csv = Koha::CSV->new();
36
    $csv->combine(@fields);
37
    my $line = $csv->string();
38
39
    # Override defaults
40
    my $csv = Koha::CSV->new( { sep_char => ';', always_quote => 1 } );
41
42
=head1 DESCRIPTION
43
44
This class wraps Text::CSV_XS providing consistent defaults and methods
45
used across Koha for CSV generation and parsing.
46
47
Configuration is inherited from Koha system preferences where applicable,
48
but can be overridden per instance.
49
50
=head2 Configuration Inheritance
51
52
=over 4
53
54
=item * B<sep_char> - Defaults to I<CSVDelimiter> system preference (or ',' if not set)
55
56
=item * B<binary> - Always 1 (required for UTF-8 support)
57
58
=item * B<formula> - Always 'empty' (security: prevents formula injection)
59
60
=item * B<always_quote> - Defaults to 0, can be overridden
61
62
=item * B<eol> - Defaults to "\n", can be overridden
63
64
=back
65
66
=cut
67
68
=head2 new
69
70
    my $csv = Koha::CSV->new();
71
    my $csv = Koha::CSV->new({ sep_char => ';', always_quote => 1 });
72
73
Creates a new Koha::CSV object. Accepts optional parameters to override defaults.
74
75
Parameters:
76
- sep_char: CSV delimiter (defaults to CSVDelimiter system preference)
77
- always_quote: Whether to quote all fields (defaults to 0)
78
- eol: End of line character (defaults to "\n")
79
80
Note: binary and formula parameters are fixed for security and cannot be overridden.
81
82
=cut
83
84
sub new {
85
    my ( $class, $params ) = @_;
86
    $params //= {};
87
88
    # Get delimiter from Koha configuration if not explicitly provided
89
    my $sep_char = $params->{sep_char} // C4::Context->csv_delimiter();
90
91
    my $self = $class->SUPER::new(
92
        {
93
            binary       => 1,                                  # Always 1 for UTF-8
94
            formula      => 'empty',                            # Always 'empty' for security
95
            always_quote => $params->{always_quote} // 0,       # Overridable
96
            eol          => $params->{eol}          // "\n",    # Overridable
97
            sep_char     => $sep_char,                          # From Koha config or override
98
        }
99
    );
100
101
    $self->{_csv} = Text::CSV_XS->new(
102
        {
103
            binary       => $self->binary,
104
            formula      => $self->formula,
105
            always_quote => $self->always_quote,
106
            eol          => $self->eol,
107
            sep_char     => $self->sep_char,
108
        }
109
    );
110
111
    return $self;
112
}
113
114
=head2 combine
115
116
    $csv->combine(@fields);
117
118
Combines fields into a CSV line. Returns true on success.
119
120
=cut
121
122
sub combine {
123
    my ( $self, @fields ) = @_;
124
    return $self->{_csv}->combine(@fields);
125
}
126
127
=head2 string
128
129
    my $line = $csv->string();
130
131
Returns the combined CSV line as a string.
132
133
=cut
134
135
sub string {
136
    my ($self) = @_;
137
    return $self->{_csv}->string();
138
}
139
140
=head2 add_row
141
142
    my $line = $csv->add_row(@fields);
143
    # or
144
    my $line = $csv->add_row(\@fields);
145
146
Convenience method that combines fields and returns the CSV line as a string.
147
Accepts either an array or arrayref of fields.
148
149
=cut
150
151
sub add_row {
152
    my ( $self, @fields ) = @_;
153
154
    # Handle arrayref or array
155
    @fields = @{ $fields[0] } if @fields == 1 && ref $fields[0] eq 'ARRAY';
156
157
    $self->combine(@fields) or return;
158
    return $self->string();
159
}
160
161
=head2 parse
162
163
    $csv->parse($line);
164
165
Parses a CSV line. Returns true on success.
166
167
=cut
168
169
sub parse {
170
    my ( $self, $line ) = @_;
171
    return $self->{_csv}->parse($line);
172
}
173
174
=head2 fields
175
176
    my @fields = $csv->fields();
177
178
Returns the parsed fields from the last parse() call.
179
180
=cut
181
182
sub fields {
183
    my ($self) = @_;
184
    return $self->{_csv}->fields();
185
}
186
187
=head2 print
188
189
    $csv->print($fh, \@fields);
190
191
Prints fields to a filehandle as a CSV line.
192
193
=cut
194
195
sub print {
196
    my ( $self, $fh, $fields ) = @_;
197
    return $self->{_csv}->print( $fh, $fields );
198
}
199
200
=head2 getline
201
202
    my $fields = $csv->getline($fh);
203
204
Reads and parses a line from a filehandle. Returns arrayref of fields.
205
206
=cut
207
208
sub getline {
209
    my ( $self, $fh ) = @_;
210
    return $self->{_csv}->getline($fh);
211
}
212
213
=head2 error_diag
214
215
    my $error = $csv->error_diag();
216
217
Returns error diagnostics from the last operation.
218
219
=cut
220
221
sub error_diag {
222
    my ($self) = @_;
223
    return $self->{_csv}->error_diag();
224
}
225
226
1;
(-)a/t/Koha/CSV.t (-1 / +140 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# Copyright 2026 Theke Solutions
4
#
5
# This file is part of Koha.
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 <https://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use Test::More tests => 8;
23
use Test::Warn;
24
use Test::NoWarnings;
25
26
use t::lib::Mocks;
27
28
use C4::Context;
29
30
BEGIN {
31
    use_ok('Koha::CSV');
32
}
33
34
subtest 'new() tests' => sub {
35
    plan tests => 5;
36
37
    my $csv = Koha::CSV->new();
38
    isa_ok( $csv, 'Koha::CSV', 'Object created' );
39
    is( $csv->binary,       1,       'binary defaults to 1' );
40
    is( $csv->formula,      'empty', 'formula defaults to empty' );
41
    is( $csv->always_quote, 0,       'always_quote defaults to 0' );
42
    is( $csv->eol,          "\n",    'eol defaults to newline' );
43
};
44
45
subtest 'new() with CSVDelimiter preference tests' => sub {
46
    plan tests => 3;
47
48
    t::lib::Mocks::mock_preference( 'CSVDelimiter', ',' );
49
    my $csv = Koha::CSV->new();
50
    is( $csv->sep_char, ',', 'Uses comma from preference' );
51
52
    t::lib::Mocks::mock_preference( 'CSVDelimiter', ';' );
53
    $csv = Koha::CSV->new();
54
    is( $csv->sep_char, ';', 'Uses semicolon from preference' );
55
56
    t::lib::Mocks::mock_preference( 'CSVDelimiter', 'tabulation' );
57
    $csv = Koha::CSV->new();
58
    is( $csv->sep_char, "\t", 'Converts tabulation to tab character' );
59
};
60
61
subtest 'new() with overrides tests' => sub {
62
    plan tests => 3;
63
64
    my $csv = Koha::CSV->new(
65
        {
66
            sep_char     => '|',
67
            always_quote => 1,
68
            eol          => "\r\n",
69
        }
70
    );
71
72
    is( $csv->sep_char,     '|',    'sep_char overridden' );
73
    is( $csv->always_quote, 1,      'always_quote overridden' );
74
    is( $csv->eol,          "\r\n", 'eol overridden' );
75
};
76
77
subtest 'add_row() tests' => sub {
78
    plan tests => 4;
79
80
    t::lib::Mocks::mock_preference( 'CSVDelimiter', ',' );
81
    my $csv = Koha::CSV->new();
82
83
    # Test with array
84
    my $line = $csv->add_row( 'Title', 'Author', 'Year' );
85
    is( $line, "Title,Author,Year\n", 'add_row with array' );
86
87
    # Test with arrayref
88
    $line = $csv->add_row( [ 'Book 1', 'Smith, John', '2024' ] );
89
    is( $line, "\"Book 1\",\"Smith, John\",2024\n", 'add_row with arrayref and quoted field' );
90
91
    # Test with special characters
92
    $line = $csv->add_row( [ 'Title with "quotes"', 'Normal', 'Value' ] );
93
    is( $line, "\"Title with \"\"quotes\"\"\",Normal,Value\n", 'add_row with quotes escaped' );
94
95
    # Test with empty fields
96
    $line = $csv->add_row( [ 'Field1', '', 'Field3' ] );
97
    is( $line, "Field1,,Field3\n", 'add_row with empty field' );
98
};
99
100
subtest 'combine() and string() tests' => sub {
101
    plan tests => 3;
102
103
    t::lib::Mocks::mock_preference( 'CSVDelimiter', ',' );
104
    my $csv = Koha::CSV->new();
105
106
    my $status = $csv->combine( 'A', 'B', 'C' );
107
    ok( $status, 'combine returns true on success' );
108
109
    my $line = $csv->string();
110
    is( $line, "A,B,C\n", 'string returns combined line' );
111
112
    # Test with always_quote
113
    $csv = Koha::CSV->new( { always_quote => 1 } );
114
    $csv->combine( 'A', 'B', 'C' );
115
    $line = $csv->string();
116
    is( $line, "\"A\",\"B\",\"C\"\n", 'always_quote wraps all fields' );
117
};
118
119
subtest 'print() tests' => sub {
120
    plan tests => 2;
121
122
    t::lib::Mocks::mock_preference( 'CSVDelimiter', ',' );
123
    my $csv = Koha::CSV->new();
124
125
    # Create temp file
126
    my $output = '';
127
    open my $fh, '>', \$output or die "Cannot open string as file: $!";
128
129
    my $status = $csv->print( $fh, [ 'Header1', 'Header2', 'Header3' ] );
130
    ok( $status, 'print returns true on success' );
131
132
    $csv->print( $fh, [ 'Value1', 'Value2', 'Value3' ] );
133
    close $fh;
134
135
    is(
136
        $output,
137
        "Header1,Header2,Header3\nValue1,Value2,Value3\n",
138
        'print writes correct CSV to filehandle'
139
    );
140
};

Return to bug 41619