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

(-)a/t/db_dependent/Labels/t_Label.t (-5 / +171 lines)
Lines 2-8 Link Here
2
2
3
# This file is part of Koha.
3
# This file is part of Koha.
4
#
4
#
5
# Copyright 2020 Koha Development team
5
# Copyright 2020, 2026 Koha Development team
6
# Copyright (C) 2017  Mark Tompsett
6
# Copyright (C) 2017  Mark Tompsett
7
#
7
#
8
# Koha is free software; you can redistribute it and/or modify it
8
# Koha is free software; you can redistribute it and/or modify it
Lines 21-45 Link Here
21
use Modern::Perl;
21
use Modern::Perl;
22
22
23
use Test::NoWarnings;
23
use Test::NoWarnings;
24
use Test::More tests => 7;
24
use Test::More tests => 11;
25
use t::lib::TestBuilder;
25
use t::lib::TestBuilder;
26
use t::lib::Mocks;
26
use t::lib::Mocks;
27
27
28
use MARC::Record;
28
use MARC::Record;
29
use MARC::Field;
29
use MARC::Field;
30
use Data::Dumper;
30
use Data::Dumper;
31
use File::Temp qw( tempfile );
31
32
32
use C4::Items;
33
use C4::Items;
33
use C4::Biblio;
34
use C4::Biblio;
34
use C4::Labels::Layout;
35
use C4::Labels::Layout;
36
use C4::Creators::PDF;
35
37
36
use Koha::Database;
38
use Koha::Database;
37
39
38
use_ok('C4::Labels::Label');
40
use_ok('C4::Labels::Label');
39
41
40
my $database = Koha::Database->new();
42
my $schema = Koha::Database->new->schema;
41
my $schema   = $database->schema();
43
$schema->storage->txn_begin;
42
$schema->storage->txn_begin();
43
44
44
my $batch_id;
45
my $batch_id;
45
my ( $llx, $lly ) = ( 0, 0 );
46
my ( $llx, $lly ) = ( 0, 0 );
Lines 152-157 is_deeply( Link Here
152
is( $barcode_width,  '2.104', );
153
is( $barcode_width,  '2.104', );
153
is( $barcode_height, '0.01', );
154
is( $barcode_height, '0.01', );
154
155
156
# ========================================
157
# Subtest: draw_label_text() deep assertions
158
# ========================================
159
subtest 'draw_label_text() returns correct text structure' => sub {
160
    plan tests => 8;
161
162
    my $label_bib = C4::Labels::Label->new(
163
        %$label_info,
164
        format_string => $format_string,
165
        printing_type => 'BIB',
166
        justify       => 'L',
167
    );
168
    my $text_result = $label_bib->create_label();
169
170
    ok( defined $text_result, 'create_label(BIB) returns defined value' );
171
    is( ref $text_result, 'ARRAY', 'Return value is an arrayref' );
172
173
SKIP: {
174
        skip 'No label text returned', 6 unless ref $text_result eq 'ARRAY' && @$text_result;
175
176
        my $first_line = $text_result->[0];
177
        ok( exists $first_line->{'text_llx'},  'First line has text_llx key' );
178
        ok( exists $first_line->{'text_lly'},  'First line has text_lly key' );
179
        ok( exists $first_line->{'font'},      'First line has font key' );
180
        ok( exists $first_line->{'font_size'}, 'First line has font_size key' );
181
        ok( exists $first_line->{'line'},      'First line has line key' );
182
183
        if ( scalar @$text_result > 1 ) {
184
            cmp_ok(
185
                $text_result->[1]{'text_lly'}, '<', $first_line->{'text_lly'},
186
                'Second line text_lly is less than first (text flows downward)'
187
            );
188
        } else {
189
            pass('Only one text line returned - skip lly ordering check');
190
        }
191
    }
192
};
193
194
# ========================================
195
# Subtest: draw_guide_box()
196
# ========================================
197
subtest 'draw_guide_box() returns PDF stream when enabled' => sub {
198
    plan tests => 3;
199
200
    my $label_with_box = C4::Labels::Label->new(
201
        %$label_info,
202
        format_string => $format_string,
203
        guidebox      => 1,
204
        llx           => 10,
205
        lly           => 20,
206
        width         => 100,
207
        height        => 50,
208
    );
209
    my $box_stream = $label_with_box->draw_guide_box();
210
    ok( $box_stream, 'draw_guide_box returns truthy when guidebox enabled' );
211
    like( $box_stream, qr/10 20 100 50 re/, 'PDF stream contains expected rectangle coordinates' );
212
213
    my $label_no_box = C4::Labels::Label->new(
214
        %$label_info,
215
        format_string => $format_string,
216
        guidebox      => 0,
217
    );
218
    ok( !$label_no_box->draw_guide_box(), 'draw_guide_box returns falsy when guidebox disabled' );
219
};
220
221
# ========================================
222
# Subtest: barcode() with all supported types
223
# ========================================
224
subtest 'barcode() generates all supported barcode types' => sub {
225
    plan tests => 7;
226
227
    my $pdf = C4::Creators::PDF->new( InitVars => 1 );
228
    $pdf->Page();
229
230
    my @barcode_tests = (
231
        { type => 'CODE39',         barcode => 'TEST97531',     desc => 'CODE39' },
232
        { type => 'CODE39MOD',      barcode => 'TEST97531',     desc => 'CODE39MOD (modulo43 checksum)' },
233
        { type => 'CODE39MOD10',    barcode => 'TEST97531',     desc => 'CODE39MOD10 (modulo10 checksum)' },
234
        { type => 'COOP2OF5',       barcode => '97531',         desc => 'COOP2OF5 (numeric)' },
235
        { type => 'INDUSTRIAL2OF5', barcode => '97531',         desc => 'INDUSTRIAL2OF5 (numeric)' },
236
        { type => 'EAN13',          barcode => '5901234123457', desc => 'EAN13 (13-digit)' },
237
    );
238
239
    for my $bc_test (@barcode_tests) {
240
        my $bc_label = C4::Labels::Label->new(
241
            %$label_info,
242
            format_string => $format_string,
243
            printing_type => 'BAR',
244
            barcode_type  => $bc_test->{type},
245
            barcode       => $bc_test->{barcode},
246
        );
247
        my $result = eval { $bc_label->create_label(); 1; };
248
        ok( $result, "barcode() $bc_test->{desc} generates without error" ) or diag($@);
249
    }
250
251
    # Verify the PDF output has content
252
    my ( $out_fh, $out_file ) = tempfile( SUFFIX => '.pdf', UNLINK => 1 );
253
    open( $out_fh, '>', $out_file );
254
    select $out_fh;
255
    eval { $pdf->End(); };
256
    select STDOUT;
257
    close $out_fh;
258
    ok( -s $out_file, 'PDF with barcodes has content' );
259
};
260
261
# ========================================
262
# Subtest: create_label() printing type orchestration
263
# ========================================
264
subtest 'create_label() printing type orchestration' => sub {
265
    plan tests => 4;
266
267
    my $pdf = C4::Creators::PDF->new( InitVars => 1 );
268
    $pdf->Page();
269
270
    # BIB - returns label_text (text only)
271
    my $label_bib = C4::Labels::Label->new(
272
        %$label_info,
273
        format_string => $format_string,
274
        printing_type => 'BIB',
275
    );
276
    my $bib_result = $label_bib->create_label();
277
    ok( defined $bib_result, 'BIB printing type returns label text' );
278
279
    # BAR - returns undef (barcode only)
280
    my $label_bar = C4::Labels::Label->new(
281
        %$label_info,
282
        format_string => $format_string,
283
        printing_type => 'BAR',
284
        barcode_type  => 'CODE39',
285
        barcode       => 'ORCHTEST1',
286
    );
287
    my $bar_result = $label_bar->create_label();
288
    ok( !defined $bar_result, 'BAR printing type returns undef (barcode only)' );
289
290
    # BIBBAR - returns label_text (both text and barcode)
291
    my $label_bibbar = C4::Labels::Label->new(
292
        %$label_info,
293
        format_string => $format_string,
294
        printing_type => 'BIBBAR',
295
        barcode_type  => 'CODE39',
296
        barcode       => 'ORCHTEST2',
297
    );
298
    my $bibbar_result = $label_bibbar->create_label();
299
    ok( defined $bibbar_result, 'BIBBAR printing type returns label text' );
300
301
    # BARBIB - returns label_text (both text and barcode)
302
    my $label_barbib = C4::Labels::Label->new(
303
        %$label_info,
304
        format_string => $format_string,
305
        printing_type => 'BARBIB',
306
        barcode_type  => 'CODE39',
307
        barcode       => 'ORCHTEST3',
308
    );
309
    my $barbib_result = $label_barbib->create_label();
310
    ok( defined $barbib_result, 'BARBIB printing type returns label text' );
311
312
    # Clean up PDF session
313
    my ( $out_fh, $out_file ) = tempfile( SUFFIX => '.pdf', UNLINK => 1 );
314
    open( $out_fh, '>', $out_file );
315
    select $out_fh;
316
    eval { $pdf->End(); };
317
    select STDOUT;
318
    close $out_fh;
319
};
320
155
$schema->storage->txn_rollback();
321
$schema->storage->txn_rollback();
156
322
157
1;
323
1;
(-)a/t/db_dependent/Patroncards/t_Patroncard.t (-1 / +387 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# This file is part of Koha.
4
#
5
# Copyright 2026 Koha Development team
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::NoWarnings;
23
use Test::More tests => 8;
24
use Test::Warn;
25
use t::lib::TestBuilder;
26
use t::lib::Mocks;
27
28
use File::Temp qw( tempfile );
29
30
use C4::Creators::PDF;
31
use Koha::Database;
32
33
use_ok('C4::Patroncards::Patroncard');
34
35
my $schema = Koha::Database->new->schema;
36
$schema->storage->txn_begin;
37
38
my $builder = t::lib::TestBuilder->new;
39
40
# Build test data
41
my $branch   = $builder->build( { source => 'Branch' } );
42
my $category = $builder->build( { source => 'Category' } );
43
my $patron   = $builder->build_object(
44
    {
45
        class => 'Koha::Patrons',
46
        value => {
47
            firstname    => 'Testfirst',
48
            surname      => 'Testsurname',
49
            cardnumber   => 'CARD12345',
50
            branchcode   => $branch->{branchcode},
51
            categorycode => $category->{categorycode},
52
        }
53
    }
54
);
55
56
t::lib::Mocks::mock_userenv( { branchcode => $branch->{branchcode} } );
57
58
# ----------------------------------------
59
# Helper: build a Patroncard with given layout
60
# ----------------------------------------
61
sub build_patroncard {
62
    my (%overrides) = @_;
63
    my $layout = $overrides{layout} || {
64
        units => 'POINT',
65
        text  => [
66
            '<firstname> <surname>',
67
            { llx => 10, lly => 80, font => 'TR', font_size => 10, text_alignment => 'L' },
68
            '<cardnumber>',
69
            { llx => 10, lly => 60, font => 'TR', font_size => 8, text_alignment => 'C' },
70
        ],
71
        barcode => [
72
            {
73
                type         => $overrides{barcode_type} || 'CODE39',
74
                data         => $overrides{barcode_data} || 'CARD12345',
75
                llx          => 10,
76
                lly          => 10,
77
                height_scale => 0.01,
78
                width_scale  => 0.8,
79
                text_print   => '',
80
            }
81
        ],
82
        images => $overrides{images} || {},
83
    };
84
    return C4::Patroncards::Patroncard->new(
85
        batch_id        => 1,
86
        borrower_number => $patron->borrowernumber,
87
        llx             => 36,
88
        lly             => 36,
89
        height          => 200,
90
        width           => 300,
91
        layout          => $layout,
92
        text_wrap_cols  => 40,
93
    );
94
}
95
96
# ========================================
97
# Subtest: draw_guide_box()
98
# ========================================
99
subtest 'draw_guide_box()' => sub {
100
    plan tests => 3;
101
102
    my $pdf = C4::Creators::PDF->new( InitVars => 0 );
103
    $pdf->Page();
104
105
    my $card   = build_patroncard();
106
    my $result = eval { $card->draw_guide_box($pdf); 1; };
107
    ok( $result, 'draw_guide_box($pdf) succeeds without error' ) or diag($@);
108
109
    # Without $pdf argument should return -1
110
    my $bad_result;
111
    warning_like { $bad_result = $card->draw_guide_box(); }
112
    qr/No pdf object passed in/,
113
        'draw_guide_box() without $pdf warns appropriately';
114
    is( $bad_result, -1, 'draw_guide_box() without $pdf returns -1' );
115
116
    # Clean up PDF session
117
    my ( $out_fh, $out_file ) = tempfile( SUFFIX => '.pdf', UNLINK => 1 );
118
    open( $out_fh, '>', $out_file );
119
    select $out_fh;
120
    eval { $pdf->End(); };
121
    select STDOUT;
122
    close $out_fh;
123
};
124
125
# ========================================
126
# Subtest: draw_guide_grid()
127
# ========================================
128
subtest 'draw_guide_grid()' => sub {
129
    plan tests => 4;
130
131
    my $pdf = C4::Creators::PDF->new( InitVars => 0 );
132
    $pdf->Page();
133
134
    # Test with POINT units
135
    # Bug 41718: draw_guide_grid() in Patroncard.pm uses hardcoded "Courier" font
136
    # name and calls StrWidth without font/size args, producing warnings
137
    my $card_point = build_patroncard();
138
    my $result;
139
    {
140
        local $SIG{__WARN__} = sub { };
141
        $result = eval { $card_point->draw_guide_grid($pdf); 1; };
142
    }
143
    ok( $result, 'draw_guide_grid() with POINT units succeeds' ) or diag($@);
144
145
    # Test with MM units
146
    my $card_mm = build_patroncard(
147
        layout => {
148
            units   => 'MM',
149
            text    => [],
150
            barcode => [
151
                {
152
                    type       => 'CODE39', data => 'X', llx => 0, lly => 0, height_scale => 0.01, width_scale => 0.8,
153
                    text_print => ''
154
                }
155
            ],
156
            images => {},
157
        }
158
    );
159
    {
160
        local $SIG{__WARN__} = sub { };
161
        $result = eval { $card_mm->draw_guide_grid($pdf); 1; };
162
    }
163
    ok( $result, 'draw_guide_grid() with MM units succeeds' ) or diag($@);
164
165
    # Without $pdf argument
166
    my $bad_result;
167
    warning_like { $bad_result = $card_point->draw_guide_grid(); }
168
    qr/No pdf object passed in/,
169
        'draw_guide_grid() without $pdf warns appropriately';
170
    is( $bad_result, -1, 'draw_guide_grid() without $pdf returns -1' );
171
172
    # Clean up PDF session
173
    my ( $out_fh, $out_file ) = tempfile( SUFFIX => '.pdf', UNLINK => 1 );
174
    open( $out_fh, '>', $out_file );
175
    select $out_fh;
176
    eval { $pdf->End(); };
177
    select STDOUT;
178
    close $out_fh;
179
};
180
181
# ========================================
182
# Subtest: draw_text()
183
# ========================================
184
subtest 'draw_text()' => sub {
185
    plan tests => 4;
186
187
    my $pdf = C4::Creators::PDF->new( InitVars => 0 );
188
    $pdf->Page();
189
190
    my $card   = build_patroncard();
191
    my $result = eval { $card->draw_text($pdf); 1; };
192
    ok( $result, 'draw_text($pdf) succeeds without error' ) or diag($@);
193
194
    # Without $pdf argument
195
    my $bad_result;
196
    warning_like { $bad_result = $card->draw_text(); }
197
    qr/No pdf object passed in/,
198
        'draw_text() without $pdf warns appropriately';
199
    is( $bad_result, -1, 'draw_text() without $pdf returns -1' );
200
201
    # With empty text layout - should return undef gracefully
202
    my $card_no_text = build_patroncard(
203
        layout => {
204
            units   => 'POINT',
205
            text    => 'not_an_array',
206
            barcode => [
207
                {
208
                    type       => 'CODE39', data => 'X', llx => 0, lly => 0, height_scale => 0.01, width_scale => 0.8,
209
                    text_print => ''
210
                }
211
            ],
212
            images => {},
213
        }
214
    );
215
    my $no_text_result = eval { $card_no_text->draw_text($pdf); 1; };
216
    ok( $no_text_result, 'draw_text() with non-ARRAY text layout returns gracefully' ) or diag($@);
217
218
    # Clean up PDF session
219
    my ( $out_fh, $out_file ) = tempfile( SUFFIX => '.pdf', UNLINK => 1 );
220
    open( $out_fh, '>', $out_file );
221
    select $out_fh;
222
    eval { $pdf->End(); };
223
    select STDOUT;
224
    close $out_fh;
225
};
226
227
# ========================================
228
# Subtest: draw_barcode()
229
# ========================================
230
subtest 'draw_barcode()' => sub {
231
    plan tests => 3;
232
233
    my $pdf = C4::Creators::PDF->new( InitVars => 0 );
234
    $pdf->Page();
235
236
    # CODE39
237
    my $card_c39 = build_patroncard( barcode_type => 'CODE39', barcode_data => 'CARD12345' );
238
    my $result   = eval { $card_c39->draw_barcode($pdf); 1; };
239
    ok( $result, 'draw_barcode() CODE39 succeeds' ) or diag($@);
240
241
    # COOP2OF5
242
    my $card_coop = build_patroncard( barcode_type => 'COOP2OF5', barcode_data => '12345' );
243
    $result = eval { $card_coop->draw_barcode($pdf); 1; };
244
    ok( $result, 'draw_barcode() COOP2OF5 succeeds' ) or diag($@);
245
246
    # INDUSTRIAL2OF5
247
    my $card_ind = build_patroncard( barcode_type => 'INDUSTRIAL2OF5', barcode_data => '12345' );
248
    $result = eval { $card_ind->draw_barcode($pdf); 1; };
249
    ok( $result, 'draw_barcode() INDUSTRIAL2OF5 succeeds' ) or diag($@);
250
251
    # Clean up PDF session
252
    my ( $out_fh, $out_file ) = tempfile( SUFFIX => '.pdf', UNLINK => 1 );
253
    open( $out_fh, '>', $out_file );
254
    select $out_fh;
255
    eval { $pdf->End(); };
256
    select STDOUT;
257
    close $out_fh;
258
};
259
260
# ========================================
261
# Subtest: draw_image()
262
# ========================================
263
subtest 'draw_image()' => sub {
264
    plan tests => 3;
265
266
    my $pdf = C4::Creators::PDF->new( InitVars => 0 );
267
    $pdf->Page();
268
269
    # Create a minimal JPEG using GD
270
    my $jpeg_data;
271
    eval { require GD; };
272
    if ($@) {
273
274
        # Fallback: minimal JPEG binary
275
        $jpeg_data = pack(
276
            "H*",
277
            "ffd8ffe000104a46494600010100000100010000"
278
                . "ffdb004300080606070605080707070909080a0c14"
279
                . "0d0c0b0b0c1912130f141d1a1f1e1d1a1c1c2024"
280
                . "2e2720222c231c1c2837292c30313434341f27393d"
281
                . "38323c2e333432ffc0000b08000100010101011100"
282
                . "ffc4001f000001050101010101010000000000000000"
283
                . "0102030405060708090a0bffda00080101000003f1"
284
                . "00fb52800001ffd9"
285
        );
286
    } else {
287
        my $im    = GD::Image->new( 4, 4, 1 );
288
        my $white = $im->colorAllocate( 255, 255, 255 );
289
        my $red   = $im->colorAllocate( 255, 0,   0 );
290
        $im->filledRectangle( 0, 0, 3, 3, $white );
291
        $im->setPixel( 1, 1, $red );
292
        $jpeg_data = $im->jpeg(100);
293
    }
294
295
    my $images = {
296
        img1 => {
297
            data_source => [ { image_source => 'db' } ],
298
            data        => $jpeg_data,
299
            Tx          => 5,
300
            Ty          => 5,
301
            Sx          => 50,
302
            Sy          => 50,
303
            Ox          => 0,
304
            Oy          => 0,
305
            scale       => 1,
306
            alt         => { data => $jpeg_data, Sx => 50, Sy => 50 },
307
        },
308
    };
309
310
    my $card_img = build_patroncard( images => $images );
311
    my $result;
312
    {
313
        local $SIG{__WARN__} = sub { };    # suppress possible JPEG color warnings
314
        $result = eval { $card_img->draw_image($pdf); 1; };
315
    }
316
    ok( $result, 'draw_image() with JPEG data succeeds' ) or diag($@);
317
318
    # Test with image_source => 'none' (should skip)
319
    my $images_none = {
320
        img1 => {
321
            data_source => [ { image_source => 'none' } ],
322
            data        => $jpeg_data,
323
            Tx          => 5,
324
            Ty          => 5,
325
            Sx          => 50,
326
            Sy          => 50,
327
            Ox          => 0,
328
            Oy          => 0,
329
            scale       => 1,
330
            alt         => { data => $jpeg_data, Sx => 50, Sy => 50 },
331
        },
332
    };
333
    my $card_no_img = build_patroncard( images => $images_none );
334
    $result = eval { $card_no_img->draw_image($pdf); 1; };
335
    ok( $result, 'draw_image() with image_source=none skips gracefully' ) or diag($@);
336
337
    # Without $pdf argument
338
    my $bad_result;
339
    warning_like { $bad_result = $card_img->draw_image(); }
340
    qr/No pdf object passed in/,
341
        'draw_image() without $pdf warns appropriately';
342
343
    # Clean up PDF session
344
    my ( $out_fh, $out_file ) = tempfile( SUFFIX => '.pdf', UNLINK => 1 );
345
    open( $out_fh, '>', $out_file );
346
    select $out_fh;
347
    eval { $pdf->End(); };
348
    select STDOUT;
349
    close $out_fh;
350
};
351
352
# ========================================
353
# Subtest: End-to-end PDF output
354
# ========================================
355
subtest 'End-to-end PDF output' => sub {
356
    plan tests => 2;
357
358
    my $pdf = C4::Creators::PDF->new( InitVars => 0 );
359
    $pdf->Page();
360
361
    my $card = build_patroncard();
362
    eval {
363
        $card->draw_guide_box($pdf);
364
        $card->draw_text($pdf);
365
        $card->draw_barcode($pdf);
366
    };
367
368
    my ( $out_fh, $out_file ) = tempfile( SUFFIX => '.pdf', UNLINK => 1 );
369
    open( $out_fh, '>', $out_file );
370
    select $out_fh;
371
    eval { $pdf->End(); };
372
    select STDOUT;
373
    close $out_fh;
374
375
    ok( -s $out_file, 'End-to-end PDF file has content' );
376
377
    # Verify PDF header
378
    open( my $check_fh, '<', $out_file ) or die "Cannot open $out_file: $!";
379
    my $header;
380
    read( $check_fh, $header, 5 );
381
    close $check_fh;
382
    is( $header, '%PDF-', 'Output file has valid PDF header' );
383
};
384
385
$schema->storage->txn_rollback();
386
387
1;

Return to bug 41719