fixing various links to point to *.koha-community.org
[wip/koha-chris_n.git] / C4 / Labels / Label.pm
1 package C4::Labels::Label;
2
3 use strict;
4 use warnings;
5
6 use Text::Wrap;
7 use Algorithm::CheckDigits;
8 use Text::CSV_XS;
9 use Data::Dumper;
10
11 use C4::Context;
12 use C4::Debug;
13 use C4::Biblio;
14
15 BEGIN {
16     use version; our $VERSION = qv('1.0.0_1');
17 }
18
19 my $possible_decimal = qr/\d{3,}(?:\.\d+)?/; # at least three digits for a DDCN
20
21 sub _check_params {
22     my $given_params = {};
23     my $exit_code = 0;
24     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     if (scalar(@_) >1) {
45         $given_params = {@_};
46         foreach my $key (keys %{$given_params}) {
47             if (!(grep m/$key/, @valid_label_params)) {
48                 warn sprintf('Unrecognized parameter type of "%s".', $key);
49                 $exit_code = 1;
50             }
51         }
52     }
53     else {
54         if (!(grep m/$_/, @valid_label_params)) {
55             warn sprintf('Unrecognized parameter type of "%s".', $_);
56             $exit_code = 1;
57         }
58     }
59     return $exit_code;
60 }
61
62 sub _guide_box {
63     my ( $llx, $lly, $width, $height ) = @_;
64     my $obj_stream = "q\n";                            # save the graphic state
65     $obj_stream .= "0.5 w\n";                          # border line width
66     $obj_stream .= "1.0 0.0 0.0  RG\n";                # border color red
67     $obj_stream .= "1.0 1.0 1.0  rg\n";                # fill color white
68     $obj_stream .= "$llx $lly $width $height re\n";    # a rectangle
69     $obj_stream .= "B\n";                              # fill (and a little more)
70     $obj_stream .= "Q\n";                              # restore the graphic state
71     return $obj_stream;
72 }
73
74 sub _get_label_item {
75     my $item_number = shift;
76     my $barcode_only = shift || 0;
77     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     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     $sth->execute($item_number);
83     if ($sth->err) {
84         warn sprintf('Database returned the following error: %s', $sth->errstr);
85     }
86     my $data = $sth->fetchrow_hashref;
87     # Replaced item's itemtype with the more user-friendly description...
88     my $sth1 = $dbh->prepare("SELECT itemtype,description FROM itemtypes WHERE itemtype = ?");
89     $sth1->execute($data->{'itemtype'});
90     if ($sth1->err) {
91         warn sprintf('Database returned the following error: %s', $sth1->errstr);
92     }
93     my $data1 = $sth1->fetchrow_hashref;
94     $data->{'itemtype'} = $data1->{'description'};
95     $data->{'itype'} = $data1->{'description'};
96     $barcode_only ? return $data->{'barcode'} : return $data;
97 }
98
99 sub _get_text_fields {
100     my $format_string = shift;
101     my $csv = Text::CSV_XS->new({allow_whitespace => 1});
102     my $status = $csv->parse($format_string);
103     my @sorted_fields = map {{ 'code' => $_, desc => $_ }} $csv->fields();
104     my $error = $csv->error_input();
105     warn sprintf('Text field sort failed with this error: %s', $error) if $error;
106     return \@sorted_fields;
107 }
108
109
110 sub _split_lccn {
111     my ($lccn) = @_;
112     $_ = $lccn;
113     # lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996';
114     my (@parts) = m/
115         ^([a-zA-Z]+)      # HE          # BS
116         (\d+(?:\.\d)*)    # 8700.7      # 2545
117         \s*
118         (\.*\D+\d*)       # .P6         # .E8
119         \s*
120         (.*)              # T44 1983    # H39 1996   # everything else (except any bracketing spaces)
121         \s*
122         /x;
123     unless (scalar @parts)  {
124         warn sprintf('regexp failed to match string: %s', $_);
125         push @parts, $_;     # if no match, just push the whole string.
126     }
127     push @parts, split /\s+/, pop @parts;   # split the last piece into an arbitrary number of pieces at spaces
128     $debug and warn "split_lccn array: ", join(" | ", @parts), "\n";
129     return @parts;
130 }
131
132 sub _split_ddcn {
133     my ($ddcn) = @_;
134     $_ = $ddcn;
135     s/\///g;   # in theory we should be able to simply remove all segmentation markers and arrive at the correct call number...
136     my (@parts) = m/
137         ^([-a-zA-Z]*\s?(?:$possible_decimal)?) # R220.3  CD-ROM 787.87 # will require extra splitting
138         \s+
139         (.+)                               # H2793Z H32 c.2 EAS # everything else (except bracketing spaces)
140         \s*
141         /x;
142     unless (scalar @parts)  {
143         warn sprintf('regexp failed to match string: %s', $_);
144         push @parts, $_;     # if no match, just push the whole string.
145     }
146
147     if ($parts[0] =~ /^([-a-zA-Z]+)\s?($possible_decimal)$/) {
148           shift @parts;         # pull off the mathching first element, like example 1
149         unshift @parts, $1, $2; # replace it with the two pieces
150     }
151
152     push @parts, split /\s+/, pop @parts;   # split the last piece into an arbitrary number of pieces at spaces
153     $debug and print STDERR "split_ddcn array: ", join(" | ", @parts), "\n";
154     return @parts;
155 }
156
157 ## NOTE: Custom call number types go here. It may be necessary to create additional splitting algorithms if some custom call numbers
158 ##      cannot be made to work here. Presently this splits standard non-ddcn, non-lccn fiction and biography call numbers.
159
160 sub _split_ccn {
161     my ($fcn) = @_;
162     my @parts = ();
163     # Split call numbers based on spaces
164     push @parts, split /\s+/, $fcn;   # split the call number into an arbitrary number of pieces at spaces
165     if ($parts[-1] !~ /^.*\d-\d.*$/ && $parts[-1] =~ /^(.*\d+)(\D.*)$/) {
166         pop @parts;            # pull off the matching last element
167         push @parts, $1, $2;    # replace it with the two pieces
168     }
169     unless (scalar @parts) {
170         warn sprintf('regexp failed to match string: %s', $_);
171         push (@parts, $_);
172     }
173     $debug and print STDERR "split_ccn array: ", join(" | ", @parts), "\n";
174     return @parts;
175 }
176
177 sub _get_barcode_data {
178     my ( $f, $item, $record ) = @_;
179     my $kohatables = _desc_koha_tables();
180     my $datastring = '';
181     my $match_kohatable = join(
182         '|',
183         (
184             @{ $kohatables->{'biblio'} },
185             @{ $kohatables->{'biblioitems'} },
186             @{ $kohatables->{'items'} }
187         )
188     );
189     FIELD_LIST:
190     while ($f) {
191         my $err = '';
192         $f =~ s/^\s?//;
193         if ( $f =~ /^'(.*)'.*/ ) {
194             # single quotes indicate a static text string.
195             $datastring .= $1;
196             $f = $';
197             next FIELD_LIST;
198         }
199         elsif ( $f =~ /^($match_kohatable).*/ ) {
200             if ($item->{$f}) {
201                 $datastring .= $item->{$f};
202             } else {
203                 $debug and warn sprintf("The '%s' field contains no data.", $f);
204             }
205             $f = $';
206             next FIELD_LIST;
207         }
208         elsif ( $f =~ /^([0-9a-z]{3})(\w)(\W?).*?/ ) {
209             my ($field,$subf,$ws) = ($1,$2,$3);
210             my $subf_data;
211             my ($itemtag, $itemsubfieldcode) = &GetMarcFromKohaField("items.itemnumber",'');
212             my @marcfield = $record->field($field);
213             if(@marcfield) {
214                 if($field eq $itemtag) {  # item-level data, we need to get the right item.
215                     ITEM_FIELDS:
216                     foreach my $itemfield (@marcfield) {
217                         if ( $itemfield->subfield($itemsubfieldcode) eq $item->{'itemnumber'} ) {
218                             if ($itemfield->subfield($subf)) {
219                                 $datastring .= $itemfield->subfield($subf) . $ws;
220                             }
221                             else {
222                                 warn sprintf("The '%s' field contains no data.", $f);
223                             }
224                             last ITEM_FIELDS;
225                         }
226                     }
227                 } else {  # bib-level data, we'll take the first matching tag/subfield.
228                     if ($marcfield[0]->subfield($subf)) {
229                         $datastring .= $marcfield[0]->subfield($subf) . $ws;
230                     }
231                     else {
232                         warn sprintf("The '%s' field contains no data.", $f);
233                     }
234                 }
235             }
236             $f = $';
237             next FIELD_LIST;
238         }
239         else {
240             warn sprintf('Failed to parse label format string: %s', $f);
241             last FIELD_LIST;    # Failed to match
242         }
243     }
244     return $datastring;
245 }
246
247 sub _desc_koha_tables {
248         my $dbh = C4::Context->dbh();
249         my $kohatables;
250         for my $table ( 'biblio','biblioitems','items' ) {
251                 my $sth = $dbh->column_info(undef,undef,$table,'%');
252                 while (my $info = $sth->fetchrow_hashref()){
253                         push @{$kohatables->{$table}} , $info->{'COLUMN_NAME'} ;
254                 }
255                 $sth->finish;
256         }
257         return $kohatables;
258 }
259
260 ### This series of functions calculates the position of text and barcode on individual labels
261 ### 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
262 ### in labels/label-create-pdf.pl as an example.
263 ### NOTE: Each function must be passed seven parameters and return seven even if some are 0 or undef
264
265 sub _BIB {
266     my $self = shift;
267     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.).
268     my $text_lly = ($self->{'lly'} + ($self->{'height'} - $self->{'top_text_margin'}));
269     return $self->{'llx'}, $text_lly, $line_spacer, 0, 0, 0, 0;
270 }
271
272 sub _BAR {
273     my $self = shift;
274     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 the left edge of the label ($llx)
275     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)
276     my $barcode_width = 0.8 * $self->{'width'};                         # this scales the barcode width to 80% of the label width
277     my $barcode_y_scale_factor = 0.01 * $self->{'height'};              # this scales the barcode height to 10% of the label height
278     return 0, 0, 0, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
279 }
280
281 sub _BIBBAR {
282     my $self = shift;
283     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 the left edge of the label ($self->{'llx'})
284     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)
285     my $barcode_width = 0.8 * $self->{'width'};                         # this scales the barcode width to 80% of the label width
286     my $barcode_y_scale_factor = 0.01 * $self->{'height'};              # this scales the barcode height to 10% of the label height
287     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.).
288     my $text_lly = ($self->{'lly'} + ($self->{'height'} - $self->{'top_text_margin'}));
289     $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";
290     return $self->{'llx'}, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
291 }
292
293 sub _BARBIB {
294     my $self = shift;
295     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 the left edge of the label ($self->{'llx'})
296     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'})
297     my $barcode_width = 0.8 * $self->{'width'};                                                 # this scales the barcode width to 80% of the label width
298     my $barcode_y_scale_factor = 0.01 * $self->{'height'};                                      # this scales the barcode height to 10% of the label height
299     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.).
300     my $text_lly = (($self->{'lly'} + $self->{'height'}) - $self->{'top_text_margin'} - (($self->{'lly'} + $self->{'height'}) - $barcode_lly));
301     return $self->{'llx'}, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
302 }
303
304 sub new {
305     my ($invocant, %params) = @_;
306     my $type = ref($invocant) || $invocant;
307     my $self = {
308         batch_id                => $params{'batch_id'},
309         item_number             => $params{'item_number'},
310         llx                     => $params{'llx'},
311         lly                     => $params{'lly'},
312         height                  => $params{'height'},
313         width                   => $params{'width'},
314         top_text_margin         => $params{'top_text_margin'},
315         left_text_margin        => $params{'left_text_margin'},
316         barcode_type            => $params{'barcode_type'},
317         printing_type           => $params{'printing_type'},
318         guidebox                => $params{'guidebox'},
319         font                    => $params{'font'},
320         font_size               => $params{'font_size'},
321         callnum_split           => $params{'callnum_split'},
322         justify                 => $params{'justify'},
323         format_string           => $params{'format_string'},
324         text_wrap_cols          => $params{'text_wrap_cols'},
325         barcode                 => 0,
326     };
327     if ($self->{'guidebox'}) {
328         $self->{'guidebox'} = _guide_box($self->{'llx'}, $self->{'lly'}, $self->{'width'}, $self->{'height'});
329     }
330     bless ($self, $type);
331     return $self;
332 }
333
334 sub get_label_type {
335     my $self = shift;
336     return $self->{'printing_type'};
337 }
338
339 sub get_attr {
340     my $self = shift;
341     if (_check_params(@_) eq 1) {
342         return -1;
343     }
344     my ($attr) = @_;
345     if (exists($self->{$attr})) {
346         return $self->{$attr};
347     }
348     else {
349         return -1;
350     }
351     return;
352 }
353
354 sub create_label {
355     my $self = shift;
356     my $label_text = '';
357     my ($text_llx, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor);
358     {
359         no strict 'refs';
360         ($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
361     }
362     if ($self->{'printing_type'} =~ /BIB/) {
363         $label_text = draw_label_text(  $self,
364                                         llx             => $text_llx,
365                                         lly             => $text_lly,
366                                         line_spacer     => $line_spacer,
367                                     );
368     }
369     if ($self->{'printing_type'} =~ /BAR/) {
370         barcode(    $self,
371                     llx                 => $barcode_llx,
372                     lly                 => $barcode_lly,
373                     width               => $barcode_width,
374                     y_scale_factor      => $barcode_y_scale_factor,
375         );
376     }
377     return $label_text if $label_text;
378     return;
379 }
380
381 sub draw_label_text {
382     my ($self, %params) = @_;
383     my @label_text = ();
384     my $text_llx = 0;
385     my $text_lly = $params{'lly'};
386     my $font = $self->{'font'};
387     my $item = _get_label_item($self->{'item_number'});
388     my $label_fields = _get_text_fields($self->{'format_string'});
389     my $record = GetMarcBiblio($item->{'biblionumber'});
390     # FIXME - returns all items, so you can't get data from an embedded holdings field.
391     # TODO - add a GetMarcBiblio1item(bibnum,itemnum) or a GetMarcItem(itemnum).
392     my $cn_source = ($item->{'cn_source'} ? $item->{'cn_source'} : C4::Context->preference('DefaultClassificationSource'));
393     LABEL_FIELDS:       # process data for requested fields on current label
394     for my $field (@$label_fields) {
395         if ($field->{'code'} eq 'itemtype') {
396             $field->{'data'} = C4::Context->preference('item-level_itypes') ? $item->{'itype'} : $item->{'itemtype'};
397         }
398         else {
399             $field->{'data'} = _get_barcode_data($field->{'code'},$item,$record);
400         }
401         ($field->{'code'} eq 'title') ? (($font =~ /T/) ? ($font = 'TI') : ($font = ($font . 'O'))) : ($font = $font);
402         my $field_data = $field->{'data'};
403         if ($field_data) {
404             $field_data =~ s/\n//g;
405             $field_data =~ s/\r//g;
406         }
407         my @label_lines;
408         # Fields which hold call number data  FIXME: ( 060? 090? 092? 099? )
409         my @callnumber_list = qw(itemcallnumber 050a 050b 082a 952o 995k);
410         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
411             if ($cn_source eq 'lcc') {
412                 @label_lines = _split_lccn($field_data);
413                 @label_lines = _split_ccn($field_data) if !@label_lines;    # If it was not a true lccn, try it as a custom call number
414                 push (@label_lines, $field_data) if !@label_lines;         # If it was not that, send it on unsplit
415             } elsif ($cn_source eq 'ddc') {
416                 @label_lines = _split_ddcn($field_data);
417                 @label_lines = _split_ccn($field_data) if !@label_lines;
418                 push (@label_lines, $field_data) if !@label_lines;
419             } else {
420                 warn sprintf('Call number splitting failed for: %s. Please add this call number to bug #2500 at bugs.koha-community.org', $field_data);
421                 push @label_lines, $field_data;
422             }
423         }
424         else {
425             if ($field_data) {
426                 $field_data =~ s/\/$//g;       # Here we will strip out all trailing '/' in fields other than the call number...
427                 $field_data =~ s/\(/\\\(/g;    # Escape '(' and ')' for the pdf object stream...
428                 $field_data =~ s/\)/\\\)/g;
429             }
430             eval{$Text::Wrap::columns = $self->{'text_wrap_cols'};};
431             my @line = split(/\n/ ,wrap('', '', $field_data));
432             # If this is a title field, limit to two lines; all others limit to one... FIXME: this is rather arbitrary
433             if ($field->{'code'} eq 'title' && scalar(@line) >= 2) {
434                 while (scalar(@line) > 2) {
435                     pop @line;
436                 }
437             } else {
438                 while (scalar(@line) > 1) {
439                     pop @line;
440                 }
441             }
442             push(@label_lines, @line);
443         }
444         LABEL_LINES:    # generate lines of label text for current field
445         foreach my $line (@label_lines) {
446             next LABEL_LINES if $line eq '';
447             my $string_width = C4::Creators::PDF->StrWidth($line, $font, $self->{'font_size'});
448             if ($self->{'justify'} eq 'R') {
449                 $text_llx = $params{'llx'} + $self->{'width'} - ($self->{'left_text_margin'} + $string_width);
450             }
451             elsif($self->{'justify'} eq 'C') {
452                  # some code to try and center each line on the label based on font size and string point width...
453                  my $whitespace = ($self->{'width'} - ($string_width + (2 * $self->{'left_text_margin'})));
454                  $text_llx = (($whitespace  / 2) + $params{'llx'} + $self->{'left_text_margin'});
455             }
456             else {
457                 $text_llx = ($params{'llx'} + $self->{'left_text_margin'});
458             }
459             push @label_text,   {
460                                 text_llx        => $text_llx,
461                                 text_lly        => $text_lly,
462                                 font            => $font,
463                                 font_size       => $self->{'font_size'},
464                                 line            => $line,
465                                 };
466             $text_lly = $text_lly - $params{'line_spacer'};
467         }
468         $font = $self->{'font'};        # reset font for next field
469     }   #foreach field
470     return \@label_text;
471 }
472
473 sub draw_guide_box {
474     return $_[0]->{'guidebox'};
475 }
476
477 sub barcode {
478     my $self = shift;
479     my %params = @_;
480     $params{'barcode_data'} = _get_label_item($self->{'item_number'}, 1) if !$params{'barcode_data'};
481     $params{'barcode_type'} = $self->{'barcode_type'} if !$params{'barcode_type'};
482     my $x_scale_factor = 1;
483     my $num_of_bars = length($params{'barcode_data'});
484     my $tot_bar_length = 0;
485     my $bar_length = 0;
486     my $guard_length = 10;
487     my $hide_text = 'yes';
488     if ($params{'barcode_type'} =~ m/CODE39/) {
489         $bar_length = '17.5';
490         $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
491         $x_scale_factor = ($params{'width'} / $tot_bar_length);
492         if ($params{'barcode_type'} eq 'CODE39MOD') {
493             my $c39 = CheckDigits('code_39');   # get modulo43 checksum
494             $params{'barcode_data'} = $c39->complete($params{'barcode_data'});
495         }
496         elsif ($params{'barcode_type'} eq 'CODE39MOD10') {
497             my $c39_10 = CheckDigits('siret');   # get modulo43 checksum
498             $params{'barcode_data'} = $c39_10->complete($params{'barcode_data'});
499             $hide_text = '';
500         }
501         eval {
502             PDF::Reuse::Barcode::Code39(
503                 x                   => $params{'llx'},
504                 y                   => $params{'lly'},
505                 value               => "*$params{barcode_data}*",
506                 xSize               => $x_scale_factor,
507                 ySize               => $params{'y_scale_factor'},
508                 hide_asterisk       => 1,
509                 text                => $hide_text,
510                 mode                => 'graphic',
511             );
512         };
513         if ($@) {
514             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
515         }
516     }
517     elsif ($params{'barcode_type'} eq 'COOP2OF5') {
518         $bar_length = '9.43333333333333';
519         $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
520         $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
521         eval {
522             PDF::Reuse::Barcode::COOP2of5(
523                 x                   => $params{'llx'},
524                 y                   => $params{'lly'},
525                 value               => "*$params{barcode_data}*",
526                 xSize               => $x_scale_factor,
527                 ySize               => $params{'y_scale_factor'},
528                 mode                    => 'graphic',
529             );
530         };
531         if ($@) {
532             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
533         }
534     }
535     elsif ( $params{'barcode_type'} eq 'INDUSTRIAL2OF5' ) {
536         $bar_length = '13.1333333333333';
537         $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
538         $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
539         eval {
540             PDF::Reuse::Barcode::Industrial2of5(
541                 x                   => $params{'llx'},
542                 y                   => $params{'lly'},
543                 value               => "*$params{barcode_data}*",
544                 xSize               => $x_scale_factor,
545                 ySize               => $params{'y_scale_factor'},
546                 mode                    => 'graphic',
547             );
548         };
549         if ($@) {
550             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
551         }
552     }
553 }
554
555 sub csv_data {
556     my $self = shift;
557     my $label_fields = _get_text_fields($self->{'format_string'});
558     my $item = _get_label_item($self->{'item_number'});
559     my $bib_record = GetMarcBiblio($item->{biblionumber});
560     my @csv_data = (map { _get_barcode_data($_->{'code'},$item,$bib_record) } @$label_fields);
561     return \@csv_data;
562 }
563
564 1;
565 __END__
566
567 =head1 NAME
568
569 C4::Labels::Label - A class for creating and manipulating label objects in Koha
570
571 =head1 ABSTRACT
572
573 This module provides methods for creating, and otherwise manipulating single label objects used by Koha to create and export labels.
574
575 =head1 METHODS
576
577 =head2 new()
578
579     Invoking the I<new> method constructs a new label object containing the supplied values. Depending on the final output format of the label data
580     the minimal required parameters change. (See the implimentation of this object type in labels/label-create-pdf.pl and labels/label-create-csv.pl
581     and labels/label-create-xml.pl for examples.) The following parameters are optionally accepted as key => value pairs:
582
583         C<batch_id>             Batch id with which this label is associated
584         C<item_number>          Item number of item to be the data source for this label
585         C<height>               Height of this label (All measures passed to this method B<must> be supplied in postscript points)
586         C<width>                Width of this label
587         C<top_text_margin>      Top margin of this label
588         C<left_text_margin>     Left margin of this label
589         C<barcode_type>         Defines the barcode type to be used on labels. NOTE: At present only the following barcode types are supported in the label creator code:
590
591 =over 9
592
593 =item .
594             CODE39          = Code 3 of 9
595
596 =item .
597             CODE39MOD       = Code 3 of 9 with modulo 43 checksum
598
599 =item .
600             CODE39MOD10     = Code 3 of 9 with modulo 10 checksum
601
602 =item .
603             COOP2OF5        = A varient of 2 of 5 barcode based on NEC's "Process 8000" code
604
605 =item .
606             INDUSTRIAL2OF5  = The standard 2 of 5 barcode (a binary level bar code developed by Identicon Corp. and Computer Identics Corp. in 1970)
607
608 =back
609
610         C<printing_type>        Defines the general layout to be used on labels. NOTE: At present there are only five printing types supported in the label creator code:
611
612 =over 9
613
614 =item .
615 BIB     = Only the bibliographic data is printed
616
617 =item .
618 BARBIB  = Barcode proceeds bibliographic data
619
620 =item .
621 BIBBAR  = Bibliographic data proceeds barcode
622
623 =item .
624 ALT     = Barcode and bibliographic data are printed on alternating labels
625
626 =item .
627 BAR     = Only the barcode is printed
628
629 =back
630
631         C<guidebox>             Setting this to '1' will result in a guide box being drawn around the labels marking the edge of each label
632         C<font>                 Defines the type of font to be used on labels. NOTE: The following fonts are available by default on most systems:
633
634 =over 9
635
636 =item .
637 TR      = Times-Roman
638
639 =item .
640 TB      = Times Bold
641
642 =item .
643 TI      = Times Italic
644
645 =item .
646 TBI     = Times Bold Italic
647
648 =item .
649 C       = Courier
650
651 =item .
652 CB      = Courier Bold
653
654 =item .
655 CO      = Courier Oblique (Italic)
656
657 =item .
658 CBO     = Courier Bold Oblique
659
660 =item .
661 H       = Helvetica
662
663 =item .
664 HB      = Helvetica Bold
665
666 =item .
667 HBO     = Helvetical Bold Oblique
668
669 =back
670
671         C<font_size>            Defines the size of the font in postscript points to be used on labels
672         C<callnum_split>        Setting this to '1' will enable call number splitting on labels
673         C<text_justify>         Defines the text justification to be used on labels. NOTE: The following justification styles are currently supported by label creator code:
674
675 =over 9
676
677 =item .
678 L       = Left
679
680 =item .
681 C       = Center
682
683 =item .
684 R       = Right
685
686 =back
687
688         C<format_string>        Defines what fields will be printed and in what order they will be printed on labels. These include any of the data fields that may be mapped
689                                 to your MARC frameworks. Specify MARC subfields as a 4-character tag-subfield string: ie. 254a Enclose a whitespace-separated list of fields
690                                 to concatenate on one line in double quotes. ie. "099a 099b" or "itemcallnumber barcode" Static text strings may be entered in single-quotes:
691                                 ie. 'Some static text here.'
692         C<text_wrap_cols>       Defines the column after which the text will wrap to the next line.
693
694 =head2 get_label_type()
695
696    Invoking the I<get_label_type> method will return the printing type of the label object.
697
698    example:
699         C<my $label_type = $label->get_label_type();>
700
701 =head2 get_attr($attribute)
702
703     Invoking the I<get_attr> method will return the value of the requested attribute or -1 on errors.
704
705     example:
706         C<my $value = $label->get_attr($attribute);>
707
708 =head2 create_label()
709
710     Invoking the I<create_label> method generates the text for that label and returns it as an arrayref of an array contianing the formatted text as well as creating the barcode
711     and writing it directly to the pdf stream. The handling of the barcode is not quite good OO form due to the linear format of PDF::Reuse::Barcode. Be aware that the instantiating
712     code is responsible to properly format the text for insertion into the pdf stream as well as the actual insertion.
713
714     example:
715         my $label_text = $label->create_label();
716
717 =head2 draw_label_text()
718
719     Invoking the I<draw_label_text> method generates the label text for the label object and returns it as an arrayref of an array containing the formatted text. The same caveats
720     apply to this method as to C<create_label()>. This method accepts the following parameters as key => value pairs: (NOTE: The unit is the postscript point - 72 per inch)
721
722         C<llx>                  The lower-left x coordinate for the text block (The point of origin for all PDF's is the lower left of the page per ISO 32000-1)
723         C<lly>                  The lower-left y coordinate for the text block
724         C<top_text_margin>      The top margin for the text block.
725         C<line_spacer>          The number of pixels between text rows (This is actually leading: baseline to baseline minus font size. Recommended starting point is 20% of font size)
726         C<font>                 The font to use for this label. See documentation on the new() method for supported fonts.
727         C<font_size>            The font size in points to use for this label.
728         C<justify>              The style of justification to use for this label. See documentation on the new() method for supported justification styles.
729
730     example:
731        C<my $label_text = $label->draw_label_text(
732                                                 llx                 => $text_llx,
733                                                 lly                 => $text_lly,
734                                                 top_text_margin     => $label_top_text_margin,
735                                                 line_spacer         => $text_leading,
736                                                 font                => $text_font,
737                                                 font_size           => $text_font_size,
738                                                 justify             => $text_justification,
739                         );>
740
741 =head2 barcode()
742
743     Invoking the I<barcode> method generates a barcode for the label object and inserts it into the current pdf stream. This method accepts the following parameters as key => value
744     pairs (C<barcode_data> is optional and omitting it will cause the barcode from the current item to be used. C<barcode_type> is also optional. Omission results in the barcode
745     type of the current template being used.):
746
747         C<llx>                  The lower-left x coordinate for the barcode block (The point of origin for all PDF's is the lower left of the page per ISO 32000-1)
748         C<lly>                  The lower-left y coordinate for the barcode block
749         C<width>                The width of the barcode block
750         C<y_scale_factor>       The scale factor to be applied to the y axis of the barcode block
751         C<barcode_data>         The data to be encoded in the barcode
752         C<barcode_type>         The barcode type (See the C<new()> method for supported barcode types)
753
754     example:
755        C<$label->barcode(
756                     llx                 => $barcode_llx,
757                     lly                 => $barcode_lly,
758                     width               => $barcode_width,
759                     y_scale_factor      => $barcode_y_scale_factor,
760                     barcode_data        => $barcode,
761                     barcode_type        => $barcodetype,
762         );>
763
764 =head2 csv_data()
765
766     Invoking the I<csv_data> method returns an arrayref of an array containing the label data suitable for passing to Text::CSV_XS->combine() to produce csv output.
767
768     example:
769         C<my $csv_data = $label->csv_data();>
770
771 =head1 AUTHOR
772
773 Mason James <mason@katipo.co.nz>
774
775 Chris Nighswonger <cnighswonger AT foundations DOT edu>
776
777 =head1 COPYRIGHT
778
779 Copyright 2006 Katipo Communications.
780
781 Copyright 2009 Foundations Bible College.
782
783 =head1 LICENSE
784
785 This file is part of Koha.
786
787 Koha is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software
788 Foundation; either version 2 of the License, or (at your option) any later version.
789
790 You should have received a copy of the GNU General Public License along with Koha; if not, write to the Free Software Foundation, Inc., 51 Franklin Street,
791 Fifth Floor, Boston, MA 02110-1301 USA.
792
793 =head1 DISCLAIMER OF WARRANTY
794
795 Koha is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
796 A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
797
798 =cut