File Coverage

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

linestmtbrancondsubtimecode
1package C4::Labels::Label;
2
3
10
10
10
10
191232
85
345
use strict;
4
10
10
10
10
124
97
353
use warnings;
5
6
10
10
10
10
111894
23011
708
use Text::Wrap;
7
10
10
10
10
35448
15602
636
use Algorithm::CheckDigits;
8
10
10
10
10
1996
33000
874
use Text::CSV_XS;
9
10
10
10
10
645
624
728
use Data::Dumper;
10
11
10
10
10
10
1842
65
124
use C4::Context;
12
10
10
10
10
99
88
1208
use C4::Debug;
13
10
10
10
10
1549
117
6234
use C4::Biblio;
14
15BEGIN {
16
10
10
10
10
10
10
1986
27235
196
993
    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
2
2
2277
    my $given_params = {};
23
2
4
    my $exit_code = 0;
24
2
22
    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
2
50
12
    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
2
50
213
        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
2
21
    return $exit_code;
60}
61
62sub _guide_box {
63
2
2
12
    my ( $llx, $lly, $width, $height ) = @_;
64
2
9
    my $obj_stream = "q\n"; # save the graphic state
65
2
10
    $obj_stream .= "0.5 w\n"; # border line width
66
2
10
    $obj_stream .= "1.0 0.0 0.0 RG\n"; # border color red
67
2
10
    $obj_stream .= "1.0 1.0 1.0 rg\n"; # fill color white
68
2
497
    $obj_stream .= "$llx $lly $width $height re\n"; # a rectangle
69
2
7
    $obj_stream .= "B\n"; # fill (and a little more)
70
2
4
    $obj_stream .= "Q\n"; # restore the graphic state
71
2
22
    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.* FROM items AS i, biblioitems AS bi ,biblio AS b WHERE itemnumber=? AND i.biblioitemnumber=bi.biblioitemnumber AND bi.biblionumber=b.biblionumber;");
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
4
4
1017187
    my $format_string = shift;
101
4
71
    my $csv = Text::CSV_XS->new({allow_whitespace => 1});
102
4
496
    my $status = $csv->parse($format_string);
103
6
6
100
293
262
    my @sorted_fields = map {{ 'code' => $_, desc => $_ }}
104
4
292
                        map { $_ eq 'callnumber' ? 'itemcallnumber' : $_ } # see bug 5653
105                        $csv->fields();
106
4
96
    my $error = $csv->error_input();
107
4
50
161
    warn sprintf('Text field sort failed with this error: %s', $error) if $error;
108
4
41088
    return \@sorted_fields;
109}
110
111
112sub _split_lccn {
113
8
8
964974
    my ($lccn) = @_;
114
8
26
    $_ = $lccn;
115    # lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996';
116
8
195
    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
8
100
42
    unless (scalar @parts) {
126
2
221
        warn sprintf('regexp failed to match string: %s', $_);
127
2
7
        push @parts, $_; # if no match, just push the whole string.
128    }
129
8
144
    push @parts, split /\s+/, pop @parts; # split the last piece into an arbitrary number of pieces at spaces
130
8
50
37
    $debug and warn "split_lccn array: ", join(" | ", @parts), "\n";
131
8
511
    return @parts;
132}
133
134sub _split_ddcn {
135
6
6
963904
    my ($ddcn) = @_;
136
6
34
    $_ = $ddcn;
137
6
35
    s/\///g; # in theory we should be able to simply remove all segmentation markers and arrive at the correct call number...
138
6
164
    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
6
50
40
    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
6
100
90
    if ($parts[0] =~ /^([-a-zA-Z]+)\s?($possible_decimal)$/) {
150
4
6
          shift @parts; # pull off the mathching first element, like example 1
151
4
18
        unshift @parts, $1, $2; # replace it with the two pieces
152    }
153
154
6
38
    push @parts, split /\s+/, pop @parts; # split the last piece into an arbitrary number of pieces at spaces
155
6
50
30
    $debug and print STDERR "split_ddcn array: ", join(" | ", @parts), "\n";
156
6
97
    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
8
8
946089
    my ($fcn) = @_;
164
8
30
    my @parts = ();
165    # Split call numbers based on spaces
166
8
44
    push @parts, split /\s+/, $fcn; # split the call number into an arbitrary number of pieces at spaces
167
8
100
67
105
    if ($parts[-1] !~ /^.*\d-\d.*$/ && $parts[-1] =~ /^(.*\d+)(\D.*)$/) {
168
6
22
        pop @parts; # pull off the matching last element
169
6
56
        push @parts, $1, $2; # replace it with the two pieces
170    }
171
8
50
41
    unless (scalar @parts) {
172
0
0
        warn sprintf('regexp failed to match string: %s', $_);
173
0
0
        push (@parts, $_);
174    }
175
8
50
39
    $debug and print STDERR "split_ccn array: ", join(" | ", @parts), "\n";
176
8
126
    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        )
190    );
191    FIELD_LIST:
192
0
    while ($f) {
193
0
        my $err = '';
194
0
        $f =~ s/^\s?//;
195
0
0
0
0
        if ( $f =~ /^'(.*)'.*/ ) {
196            # single quotes indicate a static text string.
197
0
            $datastring .= $1;
198
0
            $f = $';
199
0
            next FIELD_LIST;
200        }
201        elsif ( $f =~ /^($match_kohatable).*/ ) {
202
0
0
            if ($item->{$f}) {
203
0
                $datastring .= $item->{$f};
204            } else {
205
0
0
                $debug and warn sprintf("The '%s' field contains no data.", $f);
206            }
207
0
            $f = $';
208
0
            next FIELD_LIST;
209        }
210        elsif ( $f =~ /^([0-9a-z]{3})(\w)(\W?).*?/ ) {
211
0
            my ($field,$subf,$ws) = ($1,$2,$3);
212
0
            my $subf_data;
213
0
            my ($itemtag, $itemsubfieldcode) = &GetMarcFromKohaField("items.itemnumber",'');
214
0
            my @marcfield = $record->field($field);
215
0
0
            if(@marcfield) {
216
0
0
                if($field eq $itemtag) { # item-level data, we need to get the right item.
217                    ITEM_FIELDS:
218
0
                    foreach my $itemfield (@marcfield) {
219
0
0
                        if ( $itemfield->subfield($itemsubfieldcode) eq $item->{'itemnumber'} ) {
220
0
0
                            if ($itemfield->subfield($subf)) {
221
0
                                $datastring .= $itemfield->subfield($subf) . $ws;
222                            }
223                            else {
224
0
                                warn sprintf("The '%s' field contains no data.", $f);
225                            }
226
0
                            last ITEM_FIELDS;
227                        }
228                    }
229                } else { # bib-level data, we'll take the first matching tag/subfield.
230
0
0
                    if ($marcfield[0]->subfield($subf)) {
231
0
                        $datastring .= $marcfield[0]->subfield($subf) . $ws;
232                    }
233                    else {
234
0
                        warn sprintf("The '%s' field contains no data.", $f);
235                    }
236                }
237            }
238
0
            $f = $';
239
0
            next FIELD_LIST;
240        }
241        else {
242
0
            warn sprintf('Failed to parse label format string: %s', $f);
243
0
            last FIELD_LIST; # Failed to match
244        }
245    }
246
0
    return $datastring;
247}
248
249sub _desc_koha_tables {
250
0
0
        my $dbh = C4::Context->dbh();
251
0
        my $kohatables;
252
0
        for my $table ( 'biblio','biblioitems','items' ) {
253
0
                my $sth = $dbh->column_info(undef,undef,$table,'%');
254
0
                while (my $info = $sth->fetchrow_hashref()){
255
0
0
                        push @{$kohatables->{$table}} , $info->{'COLUMN_NAME'} ;
256                }
257
0
                $sth->finish;
258        }
259
0
        return $kohatables;
260}
261
262### This series of functions calculates the position of text and barcode on individual labels
263### 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
264### in labels/label-create-pdf.pl as an example.
265### NOTE: Each function must be passed seven parameters and return seven even if some are 0 or undef
266
267sub _BIB {
268
0
0
    my $self = shift;
269
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.).
270
0
    my $text_lly = ($self->{'lly'} + ($self->{'height'} - $self->{'top_text_margin'}));
271
0
    return $self->{'llx'}, $text_lly, $line_spacer, 0, 0, 0, 0;
272}
273
274sub _BAR {
275
0
0
    my $self = shift;
276
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)
277
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)
278
0
    my $barcode_width = 0.8 * $self->{'width'}; # this scales the barcode width to 80% of the label width
279
0
    my $barcode_y_scale_factor = 0.01 * $self->{'height'}; # this scales the barcode height to 10% of the label height
280
0
    return 0, 0, 0, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
281}
282
283sub _BIBBAR {
284
0
0
    my $self = shift;
285
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'})
286
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)
287
0
    my $barcode_width = 0.8 * $self->{'width'}; # this scales the barcode width to 80% of the label width
288
0
    my $barcode_y_scale_factor = 0.01 * $self->{'height'}; # this scales the barcode height to 10% of the label height
289
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.).
290
0
    my $text_lly = ($self->{'lly'} + ($self->{'height'} - $self->{'top_text_margin'}));
291
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";
292
0
    return $self->{'llx'}, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
293}
294
295sub _BARBIB {
296
0
0
    my $self = shift;
297
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'})
298
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'})
299
0
    my $barcode_width = 0.8 * $self->{'width'}; # this scales the barcode width to 80% of the label width
300
0
    my $barcode_y_scale_factor = 0.01 * $self->{'height'}; # this scales the barcode height to 10% of the label height
301
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.).
302
0
    my $text_lly = (($self->{'lly'} + $self->{'height'}) - $self->{'top_text_margin'} - (($self->{'lly'} + $self->{'height'}) - $barcode_lly));
303
0
    return $self->{'llx'}, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
304}
305
306sub new {
307
0
0
    my ($invocant, %params) = @_;
308
0
0
    my $type = ref($invocant) || $invocant;
309
0
    my $self = {
310        batch_id => $params{'batch_id'},
311        item_number => $params{'item_number'},
312        llx => $params{'llx'},
313        lly => $params{'lly'},
314        height => $params{'height'},
315        width => $params{'width'},
316        top_text_margin => $params{'top_text_margin'},
317        left_text_margin => $params{'left_text_margin'},
318        barcode_type => $params{'barcode_type'},
319        printing_type => $params{'printing_type'},
320        guidebox => $params{'guidebox'},
321        font => $params{'font'},
322        font_size => $params{'font_size'},
323        callnum_split => $params{'callnum_split'},
324        justify => $params{'justify'},
325        format_string => $params{'format_string'},
326        text_wrap_cols => $params{'text_wrap_cols'},
327        barcode => 0,
328    };
329
0
0
    if ($self->{'guidebox'}) {
330
0
        $self->{'guidebox'} = _guide_box($self->{'llx'}, $self->{'lly'}, $self->{'width'}, $self->{'height'});
331    }
332
0
    bless ($self, $type);
333
0
    return $self;
334}
335
336sub get_label_type {
337
0
0
    my $self = shift;
338
0
    return $self->{'printing_type'};
339}
340
341sub get_attr {
342
0
0
    my $self = shift;
343
0
0
    if (_check_params(@_) eq 1) {
344
0
        return -1;
345    }
346
0
    my ($attr) = @_;
347
0
0
    if (exists($self->{$attr})) {
348
0
        return $self->{$attr};
349    }
350    else {
351
0
        return -1;
352    }
353
0
    return;
354}
355
356sub create_label {
357
0
0
    my $self = shift;
358
0
    my $label_text = '';
359
0
    my ($text_llx, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor);
360    {
361
10
10
10
0
10
28223
106
21353
        no strict 'refs';
362
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
363    }
364
0
0
    if ($self->{'printing_type'} =~ /BIB/) {
365
0
        $label_text = draw_label_text( $self,
366                                        llx => $text_llx,
367                                        lly => $text_lly,
368                                        line_spacer => $line_spacer,
369                                    );
370    }
371
0
0
    if ($self->{'printing_type'} =~ /BAR/) {
372
0
        barcode( $self,
373                    llx => $barcode_llx,
374                    lly => $barcode_lly,
375                    width => $barcode_width,
376                    y_scale_factor => $barcode_y_scale_factor,
377        );
378    }
379
0
0
    return $label_text if $label_text;
380
0
    return;
381}
382
383sub draw_label_text {
384
0
0
    my ($self, %params) = @_;
385
0
    my @label_text = ();
386
0
    my $text_llx = 0;
387
0
    my $text_lly = $params{'lly'};
388
0
    my $font = $self->{'font'};
389
0
    my $item = _get_label_item($self->{'item_number'});
390
0
    my $label_fields = _get_text_fields($self->{'format_string'});
391
0
    my $record = GetMarcBiblio($item->{'biblionumber'});
392    # FIXME - returns all items, so you can't get data from an embedded holdings field.
393    # TODO - add a GetMarcBiblio1item(bibnum,itemnum) or a GetMarcItem(itemnum).
394
0
0
    my $cn_source = ($item->{'cn_source'} ? $item->{'cn_source'} : C4::Context->preference('DefaultClassificationSource'));
395    LABEL_FIELDS: # process data for requested fields on current label
396
0
    for my $field (@$label_fields) {
397
0
0
        if ($field->{'code'} eq 'itemtype') {
398
0
0
            $field->{'data'} = C4::Context->preference('item-level_itypes') ? $item->{'itype'} : $item->{'itemtype'};
399        }
400        else {
401
0
            $field->{'data'} = _get_barcode_data($field->{'code'},$item,$record);
402        }
403
0
0
0
        ($field->{'code'} eq 'title') ? (($font =~ /T/) ? ($font = 'TI') : ($font = ($font . 'O'))) : ($font = $font);
404
0
        my $field_data = $field->{'data'};
405
0
0
        if ($field_data) {
406
0
            $field_data =~ s/\n//g;
407
0
            $field_data =~ s/\r//g;
408        }
409
0
        my @label_lines;
410        # Fields which hold call number data FIXME: ( 060? 090? 092? 099? )
411
0
        my @callnumber_list = qw(itemcallnumber 050a 050b 082a 952o 995k);
412
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
413
0
0
0
0
            if ($cn_source eq 'lcc' || $cn_source eq 'nlm') { # NLM and LCC should be split the same way
414
0
                @label_lines = _split_lccn($field_data);
415
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
416
0
0
                push (@label_lines, $field_data) if !@label_lines; # If it was not that, send it on unsplit
417            } elsif ($cn_source eq 'ddc') {
418
0
                @label_lines = _split_ddcn($field_data);
419
0
0
                @label_lines = _split_ccn($field_data) if !@label_lines;
420
0
0
                push (@label_lines, $field_data) if !@label_lines;
421            } else {
422
0
                warn sprintf('Call number splitting failed for: %s. Please add this call number to bug #2500 at bugs.koha-community.org', $field_data);
423
0
                push @label_lines, $field_data;
424            }
425        }
426        else {
427
0
0
            if ($field_data) {
428
0
                $field_data =~ s/\/$//g; # Here we will strip out all trailing '/' in fields other than the call number...
429
0
                $field_data =~ s/\(/\\\(/g; # Escape '(' and ')' for the pdf object stream...
430
0
                $field_data =~ s/\)/\\\)/g;
431            }
432
0
0
            eval{$Text::Wrap::columns = $self->{'text_wrap_cols'};};
433
0
            my @line = split(/\n/ ,wrap('', '', $field_data));
434            # If this is a title field, limit to two lines; all others limit to one... FIXME: this is rather arbitrary
435
0
0
0
            if ($field->{'code'} eq 'title' && scalar(@line) >= 2) {
436
0
                while (scalar(@line) > 2) {
437
0
                    pop @line;
438                }
439            } else {
440
0
                while (scalar(@line) > 1) {
441
0
                    pop @line;
442                }
443            }
444
0
            push(@label_lines, @line);
445        }
446        LABEL_LINES: # generate lines of label text for current field
447
0
        foreach my $line (@label_lines) {
448
0
0
            next LABEL_LINES if $line eq '';
449
0
            my $string_width = C4::Creators::PDF->StrWidth($line, $font, $self->{'font_size'});
450
0
0
0
            if ($self->{'justify'} eq 'R') {
451
0
                $text_llx = $params{'llx'} + $self->{'width'} - ($self->{'left_text_margin'} + $string_width);
452            }
453            elsif($self->{'justify'} eq 'C') {
454                 # some code to try and center each line on the label based on font size and string point width...
455
0
                 my $whitespace = ($self->{'width'} - ($string_width + (2 * $self->{'left_text_margin'})));
456
0
                 $text_llx = (($whitespace / 2) + $params{'llx'} + $self->{'left_text_margin'});
457            }
458            else {
459
0
                $text_llx = ($params{'llx'} + $self->{'left_text_margin'});
460            }
461
0
            push @label_text, {
462                                text_llx => $text_llx,
463                                text_lly => $text_lly,
464                                font => $font,
465                                font_size => $self->{'font_size'},
466                                line => $line,
467                                };
468
0
            $text_lly = $text_lly - $params{'line_spacer'};
469        }
470
0
        $font = $self->{'font'}; # reset font for next field
471    } #foreach field
472
0
    return \@label_text;
473}
474
475sub draw_guide_box {
476
0
0
    return $_[0]->{'guidebox'};
477}
478
479sub barcode {
480
0
0
    my $self = shift;
481
0
    my %params = @_;
482
0
0
    $params{'barcode_data'} = _get_label_item($self->{'item_number'}, 1) if !$params{'barcode_data'};
483
0
0
    $params{'barcode_type'} = $self->{'barcode_type'} if !$params{'barcode_type'};
484
0
    my $x_scale_factor = 1;
485
0
    my $num_of_bars = length($params{'barcode_data'});
486
0
    my $tot_bar_length = 0;
487
0
    my $bar_length = 0;
488
0
    my $guard_length = 10;
489
0
    my $hide_text = 'yes';
490
0
0
0
0
    if ($params{'barcode_type'} =~ m/CODE39/) {
491
0
        $bar_length = '17.5';
492
0
        $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
493
0
        $x_scale_factor = ($params{'width'} / $tot_bar_length);
494
0
0
0
        if ($params{'barcode_type'} eq 'CODE39MOD') {
495
0
            my $c39 = CheckDigits('code_39'); # get modulo43 checksum
496
0
            $params{'barcode_data'} = $c39->complete($params{'barcode_data'});
497        }
498        elsif ($params{'barcode_type'} eq 'CODE39MOD10') {
499
0
            my $c39_10 = CheckDigits('siret'); # get modulo43 checksum
500
0
            $params{'barcode_data'} = $c39_10->complete($params{'barcode_data'});
501
0
            $hide_text = '';
502        }
503
0
        eval {
504
0
            PDF::Reuse::Barcode::Code39(
505                x => $params{'llx'},
506                y => $params{'lly'},
507                value => "*$params{barcode_data}*",
508                xSize => $x_scale_factor,
509                ySize => $params{'y_scale_factor'},
510                hide_asterisk => 1,
511                text => $hide_text,
512                mode => 'graphic',
513            );
514        };
515
0
0
        if ($@) {
516
0
            warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
517        }
518    }
519    elsif ($params{'barcode_type'} eq 'COOP2OF5') {
520
0
        $bar_length = '9.43333333333333';
521
0
        $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
522
0
        $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
523
0
        eval {
524
0
            PDF::Reuse::Barcode::COOP2of5(
525                x => $params{'llx'},
526                y => $params{'lly'},
527                value => "*$params{barcode_data}*",
528                xSize => $x_scale_factor,
529                ySize => $params{'y_scale_factor'},
530                mode => 'graphic',
531            );
532        };
533
0
0
        if ($@) {
534
0
            warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
535        }
536    }
537    elsif ( $params{'barcode_type'} eq 'INDUSTRIAL2OF5' ) {
538
0
        $bar_length = '13.1333333333333';
539
0
        $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
540
0
        $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
541
0
        eval {
542
0
            PDF::Reuse::Barcode::Industrial2of5(
543                x => $params{'llx'},
544                y => $params{'lly'},
545                value => "*$params{barcode_data}*",
546                xSize => $x_scale_factor,
547                ySize => $params{'y_scale_factor'},
548                mode => 'graphic',
549            );
550        };
551
0
0
        if ($@) {
552
0
            warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
553        }
554    }
555}
556
557sub csv_data {
558
0
0
    my $self = shift;
559
0
    my $label_fields = _get_text_fields($self->{'format_string'});
560
0
    my $item = _get_label_item($self->{'item_number'});
561
0
    my $bib_record = GetMarcBiblio($item->{biblionumber});
562
0
0
    my @csv_data = (map { _get_barcode_data($_->{'code'},$item,$bib_record) } @$label_fields);
563
0
    return \@csv_data;
564}
565
5661;