File Coverage

File:C4/Labels/Label.pm
Coverage:24.7%

linestmtbrancondsubtimecode
1package C4::Labels::Label;
2
3
5
5
5
5
1675
38
181
use strict;
4
5
5
5
5
46
29
1085
use warnings;
5
6
5
5
5
5
101801
12557
340
use Text::Wrap;
7
5
5
5
5
249596
6406
373
use Algorithm::CheckDigits;
8
5
5
5
5
786
17524
234
use Text::CSV_XS;
9
5
5
5
5
89
63
329
use Data::Dumper;
10
11
5
5
5
5
953
199
158
use C4::Context;
12
5
5
5
5
67
54
611
use C4::Debug;
13
5
5
5
5
628
28
2612
use C4::Biblio;
14
15BEGIN {
16
5
5
5
5
5
5
837
13063
106
414
    use version; our $VERSION = qv('1.0.0_1');
17}
18
19my $possible_decimal = qr/\d{3,}(?:\.\d+)?/; # at least three digits for a DDCN
20
21sub _check_params {
22
1
1
3
    my $given_params = {};
23
1
2
    my $exit_code = 0;
24
1
12
    my @valid_label_params = (
25        'batch_id',
26        'item_number',
27        'llx',
28        'lly',
29        'height',
30        'width',
31        'top_text_margin',
32        'left_text_margin',
33        'barcode_type',
34        'printing_type',
35        'guidebox',
36        'font',
37        'font_size',
38        'callnum_split',
39        'justify',
40        'format_string',
41        'text_wrap_cols',
42        'barcode',
43    );
44
1
50
4
    if (scalar(@_) >1) {
45
0
0
        $given_params = {@_};
46
0
0
0
0
        foreach my $key (keys %{$given_params}) {
47
0
0
0
            if (!(grep m/$key/, @valid_label_params)) {
48
0
0
                warn sprintf('Unrecognized parameter type of "%s".', $key);
49
0
0
                $exit_code = 1;
50            }
51        }
52    }
53    else {
54
1
50
129
        if (!(grep m/$_/, @valid_label_params)) {
55
0
0
            warn sprintf('Unrecognized parameter type of "%s".', $_);
56
0
0
            $exit_code = 1;
57        }
58    }
59
1
12
    return $exit_code;
60}
61
62sub _guide_box {
63
1
1
4
    my ( $llx, $lly, $width, $height ) = @_;
64
1
3
    my $obj_stream = "q\n"; # save the graphic state
65
1
3
    $obj_stream .= "0.5 w\n"; # border line width
66
1
2
    $obj_stream .= "1.0 0.0 0.0 RG\n"; # border color red
67
1
2
    $obj_stream .= "1.0 1.0 1.0 rg\n"; # fill color white
68
1
321
    $obj_stream .= "$llx $lly $width $height re\n"; # a rectangle
69
1
4
    $obj_stream .= "B\n"; # fill (and a little more)
70
1
3
    $obj_stream .= "Q\n"; # restore the graphic state
71
1
13
    return $obj_stream;
72}
73
74sub _get_label_item {
75
0
0
0
    my $item_number = shift;
76
0
0
0
    my $barcode_only = shift || 0;
77
0
0
    my $dbh = C4::Context->dbh;
78# FIXME This makes for a very bulky data structure; data from tables w/duplicate col names also gets overwritten.
79# Something like this, perhaps, but this also causes problems because we need more fields sometimes.
80# SELECT i.barcode, i.itemcallnumber, i.itype, bi.isbn, bi.issn, b.title, b.author
81
0
0
    my $sth = $dbh->prepare("SELECT bi.*, i.*, b.*,br.* FROM items AS i, biblioitems AS bi ,biblio AS b, branches AS br WHERE itemnumber=? AND i.biblioitemnumber=bi.biblioitemnumber AND bi.biblionumber=b.biblionumber AND i.homebranch=br.branchcode;");
82
0
0
    $sth->execute($item_number);
83
0
0
0
    if ($sth->err) {
84
0
0
        warn sprintf('Database returned the following error: %s', $sth->errstr);
85    }
86
0
0
    my $data = $sth->fetchrow_hashref;
87    # Replaced item's itemtype with the more user-friendly description...
88
0
0
    my $sth1 = $dbh->prepare("SELECT itemtype,description FROM itemtypes WHERE itemtype = ?");
89
0
0
    $sth1->execute($data->{'itemtype'});
90
0
0
0
    if ($sth1->err) {
91
0
0
        warn sprintf('Database returned the following error: %s', $sth1->errstr);
92    }
93
0
0
    my $data1 = $sth1->fetchrow_hashref;
94
0
0
    $data->{'itemtype'} = $data1->{'description'};
95
0
0
    $data->{'itype'} = $data1->{'description'};
96
0
0
0
    $barcode_only ? return $data->{'barcode'} : return $data;
97}
98
99sub _get_text_fields {
100
2
2
46
    my $format_string = shift;
101
2
63
    my $csv = Text::CSV_XS->new({allow_whitespace => 1});
102
2
259
    my $status = $csv->parse($format_string);
103
3
3
100
52
141
    my @sorted_fields = map {{ 'code' => $_, desc => $_ }}
104
2
200
                        map { $_ eq 'callnumber' ? 'itemcallnumber' : $_ } # see bug 5653
105                        $csv->fields();
106
2
37
    my $error = $csv->error_input();
107
2
50
60
    warn sprintf('Text field sort failed with this error: %s', $error) if $error;
108
2
42602
    return \@sorted_fields;
109}
110
111
112sub _split_lccn {
113
4
4
24
    my ($lccn) = @_;
114
4
21
    $_ = $lccn;
115    # lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996';
116
4
114
    my (@parts) = m/
117        ^([a-zA-Z]+) # HE # BS
118        (\d+(?:\.\d)*) # 8700.7 # 2545
119        \s*
120        (\.*\D+\d*) # .P6 # .E8
121        \s*
122        (.*) # T44 1983 # H39 1996 # everything else (except any bracketing spaces)
123        \s*
124        /x;
125
4
100
35
    unless (scalar @parts) {
126
1
122
        warn sprintf('regexp failed to match string: %s', $_);
127
1
4
        push @parts, $_; # if no match, just push the whole string.
128    }
129
4
73
    push @parts, split /\s+/, pop @parts; # split the last piece into an arbitrary number of pieces at spaces
130
4
50
25
    $debug and warn "split_lccn array: ", join(" | ", @parts), "\n";
131
4
62
    return @parts;
132}
133
134sub _split_ddcn {
135
3
3
30
    my ($ddcn) = @_;
136
3
24
    $_ = $ddcn;
137
3
28
    s/\///g; # in theory we should be able to simply remove all segmentation markers and arrive at the correct call number...
138
3
88
    my (@parts) = m/
139        ^([-a-zA-Z]*\s?(?:$possible_decimal)?) # R220.3 CD-ROM 787.87 # will require extra splitting
140        \s+
141        (.+) # H2793Z H32 c.2 EAS # everything else (except bracketing spaces)
142        \s*
143        /x;
144
3
50
31
    unless (scalar @parts) {
145
0
0
        warn sprintf('regexp failed to match string: %s', $_);
146
0
0
        push @parts, $_; # if no match, just push the whole string.
147    }
148
149
3
100
57
    if ($parts[0] =~ /^([-a-zA-Z]+)\s?($possible_decimal)$/) {
150
2
4
          shift @parts; # pull off the mathching first element, like example 1
151
2
10
        unshift @parts, $1, $2; # replace it with the two pieces
152    }
153
154
3
27
    push @parts, split /\s+/, pop @parts; # split the last piece into an arbitrary number of pieces at spaces
155
3
50
31
    $debug and print STDERR "split_ddcn array: ", join(" | ", @parts), "\n";
156
3
58
    return @parts;
157}
158
159## NOTE: Custom call number types go here. It may be necessary to create additional splitting algorithms if some custom call numbers
160## cannot be made to work here. Presently this splits standard non-ddcn, non-lccn fiction and biography call numbers.
161
162sub _split_ccn {
163
4
4
19
    my ($fcn) = @_;
164
4
16
    my @parts = ();
165    # Split call numbers based on spaces
166
4
24
    push @parts, split /\s+/, $fcn; # split the call number into an arbitrary number of pieces at spaces
167
4
100
67
54
    if ($parts[-1] !~ /^.*\d-\d.*$/ && $parts[-1] =~ /^(.*\d+)(\D.*)$/) {
168
3
14
        pop @parts; # pull off the matching last element
169
3
23
        push @parts, $1, $2; # replace it with the two pieces
170    }
171
4
50
25
    unless (scalar @parts) {
172
0
0
        warn sprintf('regexp failed to match string: %s', $_);
173
0
0
        push (@parts, $_);
174    }
175
4
50
17
    $debug and print STDERR "split_ccn array: ", join(" | ", @parts), "\n";
176
4
60
    return @parts;
177}
178
179sub _get_barcode_data {
180
0
0
    my ( $f, $item, $record ) = @_;
181
0
    my $kohatables = _desc_koha_tables();
182
0
    my $datastring = '';
183
0
    my $match_kohatable = join(
184        '|',
185        (
186
0
            @{ $kohatables->{'biblio'} },
187
0
            @{ $kohatables->{'biblioitems'} },
188
0
            @{ $kohatables->{'items'} },
189
0
            @{ $kohatables->{'branches'} }
190        )
191    );
192    FIELD_LIST:
193
0
    while ($f) {
194
0
        my $err = '';
195
0
        $f =~ s/^\s?//;
196
0
0
0
0
        if ( $f =~ /^'(.*)'.*/ ) {
197            # single quotes indicate a static text string.
198
0
            $datastring .= $1;
199
0
            $f = $';
200
0
            next FIELD_LIST;
201        }
202        elsif ( $f =~ /^($match_kohatable).*/ ) {
203
0
0
            if ($item->{$f}) {
204
0
                $datastring .= $item->{$f};
205            } else {
206
0
0
                $debug and warn sprintf("The '%s' field contains no data.", $f);
207            }
208
0
            $f = $';
209
0
            next FIELD_LIST;
210        }
211        elsif ( $f =~ /^([0-9a-z]{3})(\w)(\W?).*?/ ) {
212
0
            my ($field,$subf,$ws) = ($1,$2,$3);
213
0
            my $subf_data;
214
0
            my ($itemtag, $itemsubfieldcode) = &GetMarcFromKohaField("items.itemnumber",'');
215
0
            my @marcfield = $record->field($field);
216
0
0
            if(@marcfield) {
217
0
0
                if($field eq $itemtag) { # item-level data, we need to get the right item.
218                    ITEM_FIELDS:
219
0
                    foreach my $itemfield (@marcfield) {
220
0
0
                        if ( $itemfield->subfield($itemsubfieldcode) eq $item->{'itemnumber'} ) {
221
0
0
                            if ($itemfield->subfield($subf)) {
222
0
                                $datastring .= $itemfield->subfield($subf) . $ws;
223                            }
224                            else {
225
0
                                warn sprintf("The '%s' field contains no data.", $f);
226                            }
227
0
                            last ITEM_FIELDS;
228                        }
229                    }
230                } else { # bib-level data, we'll take the first matching tag/subfield.
231
0
0
                    if ($marcfield[0]->subfield($subf)) {
232
0
                        $datastring .= $marcfield[0]->subfield($subf) . $ws;
233                    }
234                    else {
235
0
                        warn sprintf("The '%s' field contains no data.", $f);
236                    }
237                }
238            }
239
0
            $f = $';
240
0
            next FIELD_LIST;
241        }
242        else {
243
0
            warn sprintf('Failed to parse label format string: %s', $f);
244
0
            last FIELD_LIST; # Failed to match
245        }
246    }
247
0
    return $datastring;
248}
249
250sub _desc_koha_tables {
251
0
0
        my $dbh = C4::Context->dbh();
252
0
        my $kohatables;
253
0
        for my $table ( 'biblio','biblioitems','items','branches' ) {
254
0
                my $sth = $dbh->column_info(undef,undef,$table,'%');
255
0
                while (my $info = $sth->fetchrow_hashref()){
256
0
0
                        push @{$kohatables->{$table}} , $info->{'COLUMN_NAME'} ;
257                }
258
0
                $sth->finish;
259        }
260
0
        return $kohatables;
261}
262
263### This series of functions calculates the position of text and barcode on individual labels
264### Please *do not* add printing types which are non-atomic. Instead, build code which calls the necessary atomic printing types to form the non-atomic types. See the ALT type
265### in labels/label-create-pdf.pl as an example.
266### NOTE: Each function must be passed seven parameters and return seven even if some are 0 or undef
267
268sub _BIB {
269
0
0
    my $self = shift;
270
0
    my $line_spacer = ($self->{'font_size'} * 1); # number of pixels between text rows (This is actually leading: baseline to baseline minus font size. Recommended starting point is 20% of font size.).
271
0
    my $text_lly = ($self->{'lly'} + ($self->{'height'} - $self->{'top_text_margin'}));
272
0
    return $self->{'llx'}, $text_lly, $line_spacer, 0, 0, 0, 0;
273}
274
275sub _BAR {
276
0
0
    my $self = shift;
277
0
    my $barcode_llx = $self->{'llx'} + $self->{'left_text_margin'}; # this places the bottom left of the barcode the left text margin distance to right of the left edge of the label ($llx)
278
0
    my $barcode_lly = $self->{'lly'} + $self->{'top_text_margin'}; # this places the bottom left of the barcode the top text margin distance above the bottom of the label ($lly)
279
0
    my $barcode_width = 0.8 * $self->{'width'}; # this scales the barcode width to 80% of the label width
280
0
    my $barcode_y_scale_factor = 0.01 * $self->{'height'}; # this scales the barcode height to 10% of the label height
281
0
    return 0, 0, 0, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
282}
283
284sub _BIBBAR {
285
0
0
    my $self = shift;
286
0
    my $barcode_llx = $self->{'llx'} + $self->{'left_text_margin'}; # this places the bottom left of the barcode the left text margin distance to right of the left edge of the label ($self->{'llx'})
287
0
    my $barcode_lly = $self->{'lly'} + $self->{'top_text_margin'}; # this places the bottom left of the barcode the top text margin distance above the bottom of the label ($lly)
288
0
    my $barcode_width = 0.8 * $self->{'width'}; # this scales the barcode width to 80% of the label width
289
0
    my $barcode_y_scale_factor = 0.01 * $self->{'height'}; # this scales the barcode height to 10% of the label height
290
0
    my $line_spacer = ($self->{'font_size'} * 1); # number of pixels between text rows (This is actually leading: baseline to baseline minus font size. Recommended starting point is 20% of font size.).
291
0
    my $text_lly = ($self->{'lly'} + ($self->{'height'} - $self->{'top_text_margin'}));
292
0
0
    $debug and warn "Label: llx $self->{'llx'}, lly $self->{'lly'}, Text: lly $text_lly, $line_spacer, Barcode: llx $barcode_llx, lly $barcode_lly, $barcode_width, $barcode_y_scale_factor\n";
293
0
    return $self->{'llx'}, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
294}
295
296sub _BARBIB {
297
0
0
    my $self = shift;
298
0
    my $barcode_llx = $self->{'llx'} + $self->{'left_text_margin'}; # this places the bottom left of the barcode the left text margin distance to right of the left edge of the label ($self->{'llx'})
299
0
    my $barcode_lly = ($self->{'lly'} + $self->{'height'}) - $self->{'top_text_margin'}; # this places the bottom left of the barcode the top text margin distance below the top of the label ($self->{'lly'})
300
0
    my $barcode_width = 0.8 * $self->{'width'}; # this scales the barcode width to 80% of the label width
301
0
    my $barcode_y_scale_factor = 0.01 * $self->{'height'}; # this scales the barcode height to 10% of the label height
302
0
    my $line_spacer = ($self->{'font_size'} * 1); # number of pixels between text rows (This is actually leading: baseline to baseline minus font size. Recommended starting point is 20% of font size.).
303
0
    my $text_lly = (($self->{'lly'} + $self->{'height'}) - $self->{'top_text_margin'} - (($self->{'lly'} + $self->{'height'}) - $barcode_lly));
304
0
    return $self->{'llx'}, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
305}
306
307sub new {
308
0
0
    my ($invocant, %params) = @_;
309
0
0
    my $type = ref($invocant) || $invocant;
310
0
    my $self = {
311        batch_id => $params{'batch_id'},
312        item_number => $params{'item_number'},
313        llx => $params{'llx'},
314        lly => $params{'lly'},
315        height => $params{'height'},
316        width => $params{'width'},
317        top_text_margin => $params{'top_text_margin'},
318        left_text_margin => $params{'left_text_margin'},
319        barcode_type => $params{'barcode_type'},
320        printing_type => $params{'printing_type'},
321        guidebox => $params{'guidebox'},
322        font => $params{'font'},
323        font_size => $params{'font_size'},
324        callnum_split => $params{'callnum_split'},
325        justify => $params{'justify'},
326        format_string => $params{'format_string'},
327        text_wrap_cols => $params{'text_wrap_cols'},
328        barcode => 0,
329    };
330
0
0
    if ($self->{'guidebox'}) {
331
0
        $self->{'guidebox'} = _guide_box($self->{'llx'}, $self->{'lly'}, $self->{'width'}, $self->{'height'});
332    }
333
0
    bless ($self, $type);
334
0
    return $self;
335}
336
337sub get_label_type {
338
0
0
    my $self = shift;
339
0
    return $self->{'printing_type'};
340}
341
342sub get_attr {
343
0
0
    my $self = shift;
344
0
0
    if (_check_params(@_) eq 1) {
345
0
        return -1;
346    }
347
0
    my ($attr) = @_;
348
0
0
    if (exists($self->{$attr})) {
349
0
        return $self->{$attr};
350    }
351    else {
352
0
        return -1;
353    }
354
0
    return;
355}
356
357sub create_label {
358
0
0
    my $self = shift;
359
0
    my $label_text = '';
360
0
    my ($text_llx, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor);
361    {
362
5
5
5
0
5
13214
119
10225
        no strict 'refs';
363
0
0
        ($text_llx, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor) = &{"_$self->{'printing_type'}"}($self); # an obfuscated call to the correct printing type sub
364    }
365
0
0
    if ($self->{'printing_type'} =~ /BIB/) {
366
0
        $label_text = draw_label_text( $self,
367                                        llx => $text_llx,
368                                        lly => $text_lly,
369                                        line_spacer => $line_spacer,
370                                    );
371    }
372
0
0
    if ($self->{'printing_type'} =~ /BAR/) {
373
0
        barcode( $self,
374                    llx => $barcode_llx,
375                    lly => $barcode_lly,
376                    width => $barcode_width,
377                    y_scale_factor => $barcode_y_scale_factor,
378        );
379    }
380
0
0
    return $label_text if $label_text;
381
0
    return;
382}
383
384sub draw_label_text {
385
0
0
    my ($self, %params) = @_;
386
0
    my @label_text = ();
387
0
    my $text_llx = 0;
388
0
    my $text_lly = $params{'lly'};
389
0
    my $font = $self->{'font'};
390
0
    my $item = _get_label_item($self->{'item_number'});
391
0
    my $label_fields = _get_text_fields($self->{'format_string'});
392
0
    my $record = GetMarcBiblio($item->{'biblionumber'});
393    # FIXME - returns all items, so you can't get data from an embedded holdings field.
394    # TODO - add a GetMarcBiblio1item(bibnum,itemnum) or a GetMarcItem(itemnum).
395
0
0
    my $cn_source = ($item->{'cn_source'} ? $item->{'cn_source'} : C4::Context->preference('DefaultClassificationSource'));
396    LABEL_FIELDS: # process data for requested fields on current label
397
0
    for my $field (@$label_fields) {
398
0
0
        if ($field->{'code'} eq 'itemtype') {
399
0
0
            $field->{'data'} = C4::Context->preference('item-level_itypes') ? $item->{'itype'} : $item->{'itemtype'};
400        }
401        else {
402
0
            $field->{'data'} = _get_barcode_data($field->{'code'},$item,$record);
403        }
404
0
0
0
        ($field->{'code'} eq 'title') ? (($font =~ /T/) ? ($font = 'TI') : ($font = ($font . 'O'))) : ($font = $font);
405
0
        my $field_data = $field->{'data'};
406
0
0
        if ($field_data) {
407
0
            $field_data =~ s/\n//g;
408
0
            $field_data =~ s/\r//g;
409        }
410
0
        my @label_lines;
411        # Fields which hold call number data FIXME: ( 060? 090? 092? 099? )
412
0
        my @callnumber_list = qw(itemcallnumber 050a 050b 082a 952o 995k);
413
0
0
0
0
        if ((grep {$field->{'code'} =~ m/$_/} @callnumber_list) and ($self->{'printing_type'} eq 'BIB') and ($self->{'callnum_split'})) { # If the field contains the call number, we do some sp
414
0
0
0
0
            if ($cn_source eq 'lcc' || $cn_source eq 'nlm') { # NLM and LCC should be split the same way
415
0
                @label_lines = _split_lccn($field_data);
416
0
0
                @label_lines = _split_ccn($field_data) if !@label_lines; # If it was not a true lccn, try it as a custom call number
417
0
0
                push (@label_lines, $field_data) if !@label_lines; # If it was not that, send it on unsplit
418            } elsif ($cn_source eq 'ddc') {
419
0
                @label_lines = _split_ddcn($field_data);
420
0
0
                @label_lines = _split_ccn($field_data) if !@label_lines;
421
0
0
                push (@label_lines, $field_data) if !@label_lines;
422            } else {
423
0
                warn sprintf('Call number splitting failed for: %s. Please add this call number to bug #2500 at bugs.koha-community.org', $field_data);
424
0
                push @label_lines, $field_data;
425            }
426        }
427        else {
428
0
0
            if ($field_data) {
429
0
                $field_data =~ s/\/$//g; # Here we will strip out all trailing '/' in fields other than the call number...
430
0
                $field_data =~ s/\(/\\\(/g; # Escape '(' and ')' for the pdf object stream...
431
0
                $field_data =~ s/\)/\\\)/g;
432            }
433
0
0
            eval{$Text::Wrap::columns = $self->{'text_wrap_cols'};};
434
0
            my @line = split(/\n/ ,wrap('', '', $field_data));
435            # If this is a title field, limit to two lines; all others limit to one... FIXME: this is rather arbitrary
436
0
0
0
            if ($field->{'code'} eq 'title' && scalar(@line) >= 2) {
437
0
                while (scalar(@line) > 2) {
438
0
                    pop @line;
439                }
440            } else {
441
0
                while (scalar(@line) > 1) {
442
0
                    pop @line;
443                }
444            }
445
0
            push(@label_lines, @line);
446        }
447        LABEL_LINES: # generate lines of label text for current field
448
0
        foreach my $line (@label_lines) {
449
0
0
            next LABEL_LINES if $line eq '';
450
0
            my $string_width = C4::Creators::PDF->StrWidth($line, $font, $self->{'font_size'});
451
0
0
0
            if ($self->{'justify'} eq 'R') {
452
0
                $text_llx = $params{'llx'} + $self->{'width'} - ($self->{'left_text_margin'} + $string_width);
453            }
454            elsif($self->{'justify'} eq 'C') {
455                 # some code to try and center each line on the label based on font size and string point width...
456
0
                 my $whitespace = ($self->{'width'} - ($string_width + (2 * $self->{'left_text_margin'})));
457
0
                 $text_llx = (($whitespace / 2) + $params{'llx'} + $self->{'left_text_margin'});
458            }
459            else {
460
0
                $text_llx = ($params{'llx'} + $self->{'left_text_margin'});
461            }
462
0
            push @label_text, {
463                                text_llx => $text_llx,
464                                text_lly => $text_lly,
465                                font => $font,
466                                font_size => $self->{'font_size'},
467                                line => $line,
468                                };
469
0
            $text_lly = $text_lly - $params{'line_spacer'};
470        }
471
0
        $font = $self->{'font'}; # reset font for next field
472    } #foreach field
473
0
    return \@label_text;
474}
475
476sub draw_guide_box {
477
0
0
    return $_[0]->{'guidebox'};
478}
479
480sub barcode {
481
0
0
    my $self = shift;
482
0
    my %params = @_;
483
0
0
    $params{'barcode_data'} = _get_label_item($self->{'item_number'}, 1) if !$params{'barcode_data'};
484
0
0
    $params{'barcode_type'} = $self->{'barcode_type'} if !$params{'barcode_type'};
485
0
    my $x_scale_factor = 1;
486
0
    my $num_of_bars = length($params{'barcode_data'});
487
0
    my $tot_bar_length = 0;
488
0
    my $bar_length = 0;
489
0
    my $guard_length = 10;
490
0
    my $hide_text = 'yes';
491
0
0
0
0
    if ($params{'barcode_type'} =~ m/CODE39/) {
492
0
        $bar_length = '17.5';
493
0
        $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
494
0
        $x_scale_factor = ($params{'width'} / $tot_bar_length);
495
0
0
0
        if ($params{'barcode_type'} eq 'CODE39MOD') {
496
0
            my $c39 = CheckDigits('code_39'); # get modulo43 checksum
497
0
            $params{'barcode_data'} = $c39->complete($params{'barcode_data'});
498        }
499        elsif ($params{'barcode_type'} eq 'CODE39MOD10') {
500
0
            my $c39_10 = CheckDigits('siret'); # get modulo43 checksum
501
0
            $params{'barcode_data'} = $c39_10->complete($params{'barcode_data'});
502
0
            $hide_text = '';
503        }
504
0
        eval {
505
0
            PDF::Reuse::Barcode::Code39(
506                x => $params{'llx'},
507                y => $params{'lly'},
508                value => "*$params{barcode_data}*",
509                xSize => $x_scale_factor,
510                ySize => $params{'y_scale_factor'},
511                hide_asterisk => 1,
512                text => $hide_text,
513                mode => 'graphic',
514            );
515        };
516
0
0
        if ($@) {
517
0
            warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
518        }
519    }
520    elsif ($params{'barcode_type'} eq 'COOP2OF5') {
521
0
        $bar_length = '9.43333333333333';
522
0
        $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
523
0
        $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
524
0
        eval {
525
0
            PDF::Reuse::Barcode::COOP2of5(
526                x => $params{'llx'},
527                y => $params{'lly'},
528                value => "*$params{barcode_data}*",
529                xSize => $x_scale_factor,
530                ySize => $params{'y_scale_factor'},
531                mode => 'graphic',
532            );
533        };
534
0
0
        if ($@) {
535
0
            warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
536        }
537    }
538    elsif ( $params{'barcode_type'} eq 'INDUSTRIAL2OF5' ) {
539
0
        $bar_length = '13.1333333333333';
540
0
        $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
541
0
        $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
542
0
        eval {
543
0
            PDF::Reuse::Barcode::Industrial2of5(
544                x => $params{'llx'},
545                y => $params{'lly'},
546                value => "*$params{barcode_data}*",
547                xSize => $x_scale_factor,
548                ySize => $params{'y_scale_factor'},
549                mode => 'graphic',
550            );
551        };
552
0
0
        if ($@) {
553
0
            warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
554        }
555    }
556}
557
558sub csv_data {
559
0
0
    my $self = shift;
560
0
    my $label_fields = _get_text_fields($self->{'format_string'});
561
0
    my $item = _get_label_item($self->{'item_number'});
562
0
    my $bib_record = GetMarcBiblio($item->{biblionumber});
563
0
0
    my @csv_data = (map { _get_barcode_data($_->{'code'},$item,$bib_record) } @$label_fields);
564
0
    return \@csv_data;
565}
566
5671;