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

(-)a/Koha/CSV/Patrons.pm (+134 lines)
Line 0 Link Here
1
package Koha::CSV::Patrons;
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 base 'Koha::CSV';
23
24
=head1 NAME
25
26
Koha::CSV::Patrons - CSV generator for patron exports
27
28
=head1 SYNOPSIS
29
30
    my $csv = Koha::CSV::Patrons->new({ fields => \@fields });
31
32
    # Print headers
33
    $csv->print_headers($fh);
34
35
    # Print patron rows
36
    foreach my $patron (@patrons) {
37
        $csv->print_patron($fh, $patron);
38
    }
39
40
=head1 DESCRIPTION
41
42
Specialized CSV generator for patron exports with configurable fields.
43
44
=cut
45
46
=head2 new
47
48
    my $csv = Koha::CSV::Patrons->new({ fields => \@fields });
49
50
Creates a new Koha::CSV::Patrons object. Accepts optional fields parameter
51
to specify which patron fields to export.
52
53
=cut
54
55
sub new {
56
    my ( $class, $params ) = @_;
57
    my $self = $class->SUPER::new($params);
58
59
    $self->{_fields} = $params->{fields} || [];
60
61
    return $self;
62
}
63
64
=head2 fields
65
66
    my $fields = $csv->fields();
67
    $csv->fields(\@new_fields);
68
69
Get or set the list of fields to export.
70
71
=cut
72
73
sub fields {
74
    my ( $self, $fields ) = @_;
75
76
    if ($fields) {
77
        $self->{_fields} = $fields;
78
    }
79
80
    return $self->{_fields};
81
}
82
83
=head2 print_headers
84
85
    $csv->print_headers($fh);
86
87
Prints the CSV headers (field names) to a filehandle.
88
89
=cut
90
91
sub print_headers {
92
    my ( $self, $fh ) = @_;
93
    return $self->print( $fh, $self->{_fields} );
94
}
95
96
=head2 format_patron
97
98
    my $row = $csv->format_patron($patron);
99
100
Formats a Koha::Patron object into an arrayref of CSV fields based on
101
the configured field list.
102
103
=cut
104
105
sub format_patron {
106
    my ( $self, $patron ) = @_;
107
108
    my $category = $patron->category;
109
    my $member   = $patron->unblessed;
110
111
    # Add category fields
112
    $member->{description}   = $category->description;
113
    $member->{category_type} = $category->category_type;
114
115
    # Extract requested fields, handling undefined and reference values
116
    my @row = map { ( defined $member->{$_} && !ref $member->{$_} ) ? $member->{$_} : '' } @{ $self->{_fields} };
117
118
    return \@row;
119
}
120
121
=head2 print_patron
122
123
    $csv->print_patron($fh, $patron);
124
125
Formats and prints a Koha::Patron to a filehandle as a CSV row.
126
127
=cut
128
129
sub print_patron {
130
    my ( $self, $fh, $patron ) = @_;
131
    return $self->print( $fh, $self->format_patron($patron) );
132
}
133
134
1;
(-)a/misc/export_borrowers.pl (-21 / +13 lines)
Lines 20-30 Link Here
20
# Script to export borrowers
20
# Script to export borrowers
21
21
22
use Modern::Perl;
22
use Modern::Perl;
23
use Text::CSV;
23
24
use Getopt::Long qw( GetOptions :config no_ignore_case );
24
use Getopt::Long qw( GetOptions :config no_ignore_case );
25
25
26
use Koha::Script;
26
use Koha::Script;
27
use C4::Context;
27
use C4::Context;
28
use Koha::CSV::Patrons;
28
use Koha::Patrons;
29
use Koha::Patrons;
29
30
30
binmode STDOUT, ":encoding(UTF-8)";
31
binmode STDOUT, ":encoding(UTF-8)";
Lines 94-131 unless ($separator) { Link Here
94
    $separator = C4::Context->csv_delimiter;
95
    $separator = C4::Context->csv_delimiter;
95
}
96
}
96
97
97
my $csv = Text::CSV->new( { sep_char => $separator, binary => 1, formula => 'empty' } );
98
my $csv = Koha::CSV::Patrons->new( { sep_char => $separator } );
98
99
99
# If the user did not specify any field to export, we assume they want them all
100
# If the user did not specify any field to export, we assume they want them all
100
# We retrieve the first borrower information to get field names
101
# We retrieve the first borrower information to get field names
101
my ($borrowernumber) = $sth->fetchrow_array or die "No borrower to export";
102
my ($borrowernumber) = $sth->fetchrow_array or die "No borrower to export";
102
my $patron           = Koha::Patrons->find($borrowernumber);               # FIXME Now is_expired is no longer available
103
my $patron           = Koha::Patrons->find($borrowernumber);
103
    # We will have to use Koha::Patron and allow method calls
104
my $category         = $patron->category;
104
my $category = $patron->category;
105
my $member           = $patron->unblessed;
105
my $member   = $patron->unblessed;
106
$member->{description}   = $category->description;
106
$member->{description}   = $category->description;
107
$member->{category_type} = $category->category_type;
107
$member->{category_type} = $category->category_type;
108
108
109
@fields = keys %$member unless (@fields);
109
@fields = keys %$member unless (@fields);
110
110
111
# Set fields for CSV export
112
$csv->fields( \@fields );
113
111
if ($show_header) {
114
if ($show_header) {
112
    $csv->combine(@fields);
115
    $csv->print_headers(*STDOUT);
113
    print $csv->string . "\n";
114
}
116
}
115
117
116
$csv->combine( map { ( defined $member->{$_} and !ref $member->{$_} ) ? $member->{$_} : '' } @fields );
118
$csv->print_patron( *STDOUT, $patron );
117
die "Invalid character at borrower $borrowernumber: [" . $csv->error_input . "]\n"
118
    if ( !defined( $csv->string ) );
119
print $csv->string . "\n";
120
119
121
while ( my $borrowernumber = $sth->fetchrow_array ) {
120
while ( my $borrowernumber = $sth->fetchrow_array ) {
122
    my $patron   = Koha::Patrons->find($borrowernumber);
121
    my $patron = Koha::Patrons->find($borrowernumber);
123
    my $category = $patron->category;
122
    $csv->print_patron( *STDOUT, $patron );
124
    my $member   = $patron->unblessed;
125
    $member->{description}   = $category->description;
126
    $member->{category_type} = $category->category_type;
127
    $csv->combine( map { ( defined $member->{$_} and !ref $member->{$_} ) ? $member->{$_} : '' } @fields );
128
    die "Invalid character at borrower $borrowernumber: [" . $csv->error_input . "]\n"
129
        if ( !defined( $csv->string ) );
130
    print $csv->string . "\n";
131
}
123
}
(-)a/t/db_dependent/Koha/CSV/Patrons.t (-1 / +138 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 => 7;
23
use Test::NoWarnings;
24
25
use t::lib::TestBuilder;
26
use t::lib::Mocks;
27
28
BEGIN {
29
    use_ok('Koha::CSV::Patrons');
30
}
31
32
my $schema  = Koha::Database->new->schema;
33
my $builder = t::lib::TestBuilder->new;
34
35
subtest 'new() tests' => sub {
36
    plan tests => 2;
37
38
    my $csv = Koha::CSV::Patrons->new();
39
    isa_ok( $csv, 'Koha::CSV::Patrons', 'Object created' );
40
41
    $csv = Koha::CSV::Patrons->new( { fields => [qw( cardnumber surname firstname )] } );
42
    is_deeply( $csv->fields(), [qw( cardnumber surname firstname )], 'Fields set correctly' );
43
};
44
45
subtest 'fields() tests' => sub {
46
    plan tests => 2;
47
48
    my $csv = Koha::CSV::Patrons->new();
49
    is_deeply( $csv->fields(), [], 'Empty fields by default' );
50
51
    $csv->fields( [qw( email phone )] );
52
    is_deeply( $csv->fields(), [qw( email phone )], 'Fields updated' );
53
};
54
55
subtest 'format_patron() tests' => sub {
56
    plan tests => 4;
57
58
    $schema->storage->txn_begin;
59
60
    t::lib::Mocks::mock_preference( 'CSVDelimiter', ',' );
61
62
    my $category = $builder->build_object( { class => 'Koha::Patron::Categories' } );
63
    my $patron   = $builder->build_object(
64
        {
65
            class => 'Koha::Patrons',
66
            value => {
67
                categorycode => $category->categorycode,
68
                surname      => 'Test',
69
                firstname    => 'Patron',
70
                email        => 'test@example.com',
71
            }
72
        }
73
    );
74
75
    my $csv =
76
        Koha::CSV::Patrons->new( { fields => [qw( cardnumber surname firstname email description category_type )] } );
77
78
    my $row = $csv->format_patron($patron);
79
80
    isa_ok( $row, 'ARRAY', 'format_patron returns arrayref' );
81
    is( scalar @$row, 6,        'Correct number of fields' );
82
    is( $row->[1],    'Test',   'Surname field correct' );
83
    is( $row->[2],    'Patron', 'Firstname field correct' );
84
85
    $schema->storage->txn_rollback;
86
};
87
88
subtest 'print_headers() tests' => sub {
89
    plan tests => 2;
90
91
    t::lib::Mocks::mock_preference( 'CSVDelimiter', ',' );
92
93
    my $csv = Koha::CSV::Patrons->new( { fields => [qw( cardnumber surname firstname )] } );
94
95
    my $output = '';
96
    open my $fh, '>', \$output or die "Cannot open string as file: $!";
97
98
    my $status = $csv->print_headers($fh);
99
    ok( $status, 'print_headers returns true' );
100
101
    close $fh;
102
103
    is( $output, "cardnumber,surname,firstname\n", 'Headers printed correctly' );
104
};
105
106
subtest 'print_patron() tests' => sub {
107
    plan tests => 2;
108
109
    $schema->storage->txn_begin;
110
111
    t::lib::Mocks::mock_preference( 'CSVDelimiter', ',' );
112
113
    my $category = $builder->build_object( { class => 'Koha::Patron::Categories' } );
114
    my $patron   = $builder->build_object(
115
        {
116
            class => 'Koha::Patrons',
117
            value => {
118
                categorycode => $category->categorycode,
119
                surname      => 'Smith',
120
                firstname    => 'John',
121
            }
122
        }
123
    );
124
125
    my $csv = Koha::CSV::Patrons->new( { fields => [qw( surname firstname )] } );
126
127
    my $output = '';
128
    open my $fh, '>', \$output or die "Cannot open string as file: $!";
129
130
    my $status = $csv->print_patron( $fh, $patron );
131
    ok( $status, 'print_patron returns true' );
132
133
    close $fh;
134
135
    like( $output, qr/Smith,John/, 'Patron data printed correctly' );
136
137
    $schema->storage->txn_rollback;
138
};

Return to bug 41622