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('3.07.00.049');
  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.*,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     $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 => $_ }}
 104                         map { $_ eq 'callnumber' ? 'itemcallnumber' : $_ } # see bug 5653
 105                         $csv->fields();
 106     my $error = $csv->error_input();
 107     warn sprintf('Text field sort failed with this error: %s', $error) if $error;
 108     return \@sorted_fields;
 109 }
 110
 111
 112 sub _split_lccn {
 113     my ($lccn) = @_;
 114     $_ = $lccn;
 115     # lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996';
 116     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     unless (scalar @parts)  {
 126         warn sprintf('regexp failed to match string: %s', $_);
 127         push @parts, $_;     # if no match, just push the whole string.
 128     }
 129     push @parts, split /\s+/, pop @parts;   # split the last piece into an arbitrary number of pieces at spaces
 130     $debug and warn "split_lccn array: ", join(" | ", @parts), "\n";
 131     return @parts;
 132 }
 133
 134 sub _split_ddcn {
 135     my ($ddcn) = @_;
 136     $_ = $ddcn;
 137     s/\///g;   # in theory we should be able to simply remove all segmentation markers and arrive at the correct call number...
 138     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     unless (scalar @parts)  {
 145         warn sprintf('regexp failed to match string: %s', $_);
 146         push @parts, $_;     # if no match, just push the whole string.
 147     }
 148
 149     if ($parts[0] =~ /^([-a-zA-Z]+)\s?($possible_decimal)$/) {
 150           shift @parts;         # pull off the mathching first element, like example 1
 151         unshift @parts, $1, $2; # replace it with the two pieces
 152     }
 153
 154     push @parts, split /\s+/, pop @parts;   # split the last piece into an arbitrary number of pieces at spaces
 155     $debug and print STDERR "split_ddcn array: ", join(" | ", @parts), "\n";
 156     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
 162 sub _split_ccn {
 163     my ($fcn) = @_;
 164     my @parts = ();
 165     # Split call numbers based on spaces
 166     push @parts, split /\s+/, $fcn;   # split the call number into an arbitrary number of pieces at spaces
 167     if ($parts[-1] !~ /^.*\d-\d.*$/ && $parts[-1] =~ /^(.*\d+)(\D.*)$/) {
 168         pop @parts;            # pull off the matching last element
 169         push @parts, $1, $2;    # replace it with the two pieces
 170     }
 171     unless (scalar @parts) {
 172         warn sprintf('regexp failed to match string: %s', $_);
 173         push (@parts, $_);
 174     }
 175     $debug and print STDERR "split_ccn array: ", join(" | ", @parts), "\n";
 176     return @parts;
 177 }
 178
 179 sub _get_barcode_data {
 180     my ( $f, $item, $record ) = @_;
 181     my $kohatables = _desc_koha_tables();
 182     my $datastring = '';
 183     my $match_kohatable = join(
 184         '|',
 185         (
 186             @{ $kohatables->{'biblio'} },
 187             @{ $kohatables->{'biblioitems'} },
 188             @{ $kohatables->{'items'} },
 189             @{ $kohatables->{'branches'} }
 190         )
 191     );
 192     FIELD_LIST:
 193     while ($f) {
 194         my $err = '';
 195         $f =~ s/^\s?//;
 196         if ( $f =~ /^'(.*)'.*/ ) {
 197             # single quotes indicate a static text string.
 198             $datastring .= $1;
 199             $f = $';
 200             next FIELD_LIST;
 201         }
 202         elsif ( $f =~ /^($match_kohatable).*/ ) {
 203             if ($item->{$f}) {
 204                 $datastring .= $item->{$f};
 205             } else {
 206                 $debug and warn sprintf("The '%s' field contains no data.", $f);
 207             }
 208             $f = $';
 209             next FIELD_LIST;
 210         }
 211         elsif ( $f =~ /^([0-9a-z]{3})(\w)(\W?).*?/ ) {
 212             my ($field,$subf,$ws) = ($1,$2,$3);
 213             my $subf_data;
 214             my ($itemtag, $itemsubfieldcode) = &GetMarcFromKohaField("items.itemnumber",'');
 215             my @marcfield = $record->field($field);
 216             if(@marcfield) {
 217                 if($field eq $itemtag) {  # item-level data, we need to get the right item.
 218                     ITEM_FIELDS:
 219                     foreach my $itemfield (@marcfield) {
 220                         if ( $itemfield->subfield($itemsubfieldcode) eq $item->{'itemnumber'} ) {
 221                             if ($itemfield->subfield($subf)) {
 222                                 $datastring .= $itemfield->subfield($subf) . $ws;
 223                             }
 224                             else {
 225                                 warn sprintf("The '%s' field contains no data.", $f);
 226                             }
 227                             last ITEM_FIELDS;
 228                         }
 229                     }
 230                 } else {  # bib-level data, we'll take the first matching tag/subfield.
 231                     if ($marcfield[0]->subfield($subf)) {
 232                         $datastring .= $marcfield[0]->subfield($subf) . $ws;
 233                     }
 234                     else {
 235                         warn sprintf("The '%s' field contains no data.", $f);
 236                     }
 237                 }
 238             }
 239             $f = $';
 240             next FIELD_LIST;
 241         }
 242         else {
 243             warn sprintf('Failed to parse label format string: %s', $f);
 244             last FIELD_LIST;    # Failed to match
 245         }
 246     }
 247     return $datastring;
 248 }
 249
 250 sub _desc_koha_tables {
 251         my $dbh = C4::Context->dbh();
 252         my $kohatables;
 253         for my $table ( 'biblio','biblioitems','items','branches' ) {
 254                 my $sth = $dbh->column_info(undef,undef,$table,'%');
 255                 while (my $info = $sth->fetchrow_hashref()){
 256                         push @{$kohatables->{$table}} , $info->{'COLUMN_NAME'} ;
 257                 }
 258                 $sth->finish;
 259         }
 260         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
 268 sub _BIB {
 269     my $self = shift;
 270     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     my $text_lly = ($self->{'lly'} + ($self->{'height'} - $self->{'top_text_margin'}));
 272     return $self->{'llx'}, $text_lly, $line_spacer, 0, 0, 0, 0;
 273 }
 274
 275 sub _BAR {
 276     my $self = shift;
 277     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     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     my $barcode_width = 0.8 * $self->{'width'};                         # this scales the barcode width to 80% of the label width
 280     my $barcode_y_scale_factor = 0.01 * $self->{'height'};              # this scales the barcode height to 10% of the label height
 281     return 0, 0, 0, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
 282 }
 283
 284 sub _BIBBAR {
 285     my $self = shift;
 286     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     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     my $barcode_width = 0.8 * $self->{'width'};                         # this scales the barcode width to 80% of the label width
 289     my $barcode_y_scale_factor = 0.01 * $self->{'height'};              # this scales the barcode height to 10% of the label height
 290     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     my $text_lly = ($self->{'lly'} + ($self->{'height'} - $self->{'top_text_margin'}));
 292     $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     return $self->{'llx'}, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
 294 }
 295
 296 sub _BARBIB {
 297     my $self = shift;
 298     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     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     my $barcode_width = 0.8 * $self->{'width'};                                                 # this scales the barcode width to 80% of the label width
 301     my $barcode_y_scale_factor = 0.01 * $self->{'height'};                                      # this scales the barcode height to 10% of the label height
 302     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     my $text_lly = (($self->{'lly'} + $self->{'height'}) - $self->{'top_text_margin'} - (($self->{'lly'} + $self->{'height'}) - $barcode_lly));
 304     return $self->{'llx'}, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
 305 }
 306
 307 sub new {
 308     my ($invocant, %params) = @_;
 309     my $type = ref($invocant) || $invocant;
 310     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     if ($self->{'guidebox'}) {
 331         $self->{'guidebox'} = _guide_box($self->{'llx'}, $self->{'lly'}, $self->{'width'}, $self->{'height'});
 332     }
 333     bless ($self, $type);
 334     return $self;
 335 }
 336
 337 sub get_label_type {
 338     my $self = shift;
 339     return $self->{'printing_type'};
 340 }
 341
 342 sub get_attr {
 343     my $self = shift;
 344     if (_check_params(@_) eq 1) {
 345         return -1;
 346     }
 347     my ($attr) = @_;
 348     if (exists($self->{$attr})) {
 349         return $self->{$attr};
 350     }
 351     else {
 352         return -1;
 353     }
 354     return;
 355 }
 356
 357 sub create_label {
 358     my $self = shift;
 359     my $label_text = '';
 360     my ($text_llx, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor);
 361     {
 362         no strict 'refs';
 363         ($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     if ($self->{'printing_type'} =~ /BIB/) {
 366         $label_text = draw_label_text(  $self,
 367                                         llx             => $text_llx,
 368                                         lly             => $text_lly,
 369                                         line_spacer     => $line_spacer,
 370                                     );
 371     }
 372     if ($self->{'printing_type'} =~ /BAR/) {
 373         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     return $label_text if $label_text;
 381     return;
 382 }
 383
 384 sub draw_label_text {
 385     my ($self, %params) = @_;
 386     my @label_text = ();
 387     my $text_llx = 0;
 388     my $text_lly = $params{'lly'};
 389     my $font = $self->{'font'};
 390     my $item = _get_label_item($self->{'item_number'});
 391     my $label_fields = _get_text_fields($self->{'format_string'});
 392     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     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     for my $field (@$label_fields) {
 398         if ($field->{'code'} eq 'itemtype') {
 399             $field->{'data'} = C4::Context->preference('item-level_itypes') ? $item->{'itype'} : $item->{'itemtype'};
 400         }
 401         else {
 402             $field->{'data'} = _get_barcode_data($field->{'code'},$item,$record);
 403         }
 404         ($field->{'code'} eq 'title') ? (($font =~ /T/) ? ($font = 'TI') : ($font = ($font . 'O'))) : ($font = $font);
 405         my $field_data = $field->{'data'};
 406         if ($field_data) {
 407             $field_data =~ s/\n//g;
 408             $field_data =~ s/\r//g;
 409         }
 410         my @label_lines;
 411         # Fields which hold call number data  FIXME: ( 060? 090? 092? 099? )
 412         my @callnumber_list = qw(itemcallnumber 050a 050b 082a 952o 995k);
 413         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             if ($cn_source eq 'lcc' || $cn_source eq 'nlm') { # NLM and LCC should be split the same way
 415                 @label_lines = _split_lccn($field_data);
 416                 @label_lines = _split_ccn($field_data) if !@label_lines;    # If it was not a true lccn, try it as a custom call number
 417                 push (@label_lines, $field_data) if !@label_lines;         # If it was not that, send it on unsplit
 418             } elsif ($cn_source eq 'ddc') {
 419                 @label_lines = _split_ddcn($field_data);
 420                 @label_lines = _split_ccn($field_data) if !@label_lines;
 421                 push (@label_lines, $field_data) if !@label_lines;
 422             } else {
 423                 warn sprintf('Call number splitting failed for: %s. Please add this call number to bug #2500 at bugs.koha-community.org', $field_data);
 424                 push @label_lines, $field_data;
 425             }
 426         }
 427         else {
 428             if ($field_data) {
 429                 $field_data =~ s/\/$//g;       # Here we will strip out all trailing '/' in fields other than the call number...
 430                 $field_data =~ s/\(/\\\(/g;    # Escape '(' and ')' for the pdf object stream...
 431                 $field_data =~ s/\)/\\\)/g;
 432             }
 433             eval{$Text::Wrap::columns = $self->{'text_wrap_cols'};};
 434             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             if ($field->{'code'} eq 'title' && scalar(@line) >= 2) {
 437                 while (scalar(@line) > 2) {
 438                     pop @line;
 439                 }
 440             } else {
 441                 while (scalar(@line) > 1) {
 442                     pop @line;
 443                 }
 444             }
 445             push(@label_lines, @line);
 446         }
 447         LABEL_LINES:    # generate lines of label text for current field
 448         foreach my $line (@label_lines) {
 449             next LABEL_LINES if $line eq '';
 450             my $string_width = C4::Creators::PDF->StrWidth($line, $font, $self->{'font_size'});
 451             if ($self->{'justify'} eq 'R') {
 452                 $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                  my $whitespace = ($self->{'width'} - ($string_width + (2 * $self->{'left_text_margin'})));
 457                  $text_llx = (($whitespace  / 2) + $params{'llx'} + $self->{'left_text_margin'});
 458             }
 459             else {
 460                 $text_llx = ($params{'llx'} + $self->{'left_text_margin'});
 461             }
 462             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             $text_lly = $text_lly - $params{'line_spacer'};
 470         }
 471         $font = $self->{'font'};        # reset font for next field
 472     }   #foreach field
 473     return \@label_text;
 474 }
 475
 476 sub draw_guide_box {
 477     return $_[0]->{'guidebox'};
 478 }
 479
 480 sub barcode {
 481     my $self = shift;
 482     my %params = @_;
 483     $params{'barcode_data'} = _get_label_item($self->{'item_number'}, 1) if !$params{'barcode_data'};
 484     $params{'barcode_type'} = $self->{'barcode_type'} if !$params{'barcode_type'};
 485     my $x_scale_factor = 1;
 486     my $num_of_bars = length($params{'barcode_data'});
 487     my $tot_bar_length = 0;
 488     my $bar_length = 0;
 489     my $guard_length = 10;
 490     my $hide_text = 'yes';
 491     if ($params{'barcode_type'} =~ m/CODE39/) {
 492         $bar_length = '17.5';
 493         $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
 494         $x_scale_factor = ($params{'width'} / $tot_bar_length);
 495         if ($params{'barcode_type'} eq 'CODE39MOD') {
 496             my $c39 = CheckDigits('code_39');   # get modulo43 checksum
 497             $params{'barcode_data'} = $c39->complete($params{'barcode_data'});
 498         }
 499         elsif ($params{'barcode_type'} eq 'CODE39MOD10') {
 500             my $c39_10 = CheckDigits('siret');   # get modulo43 checksum
 501             $params{'barcode_data'} = $c39_10->complete($params{'barcode_data'});
 502             $hide_text = '';
 503         }
 504         eval {
 505             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         if ($@) {
 517             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         $bar_length = '9.43333333333333';
 522         $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
 523         $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
 524         eval {
 525             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         if ($@) {
 535             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         $bar_length = '13.1333333333333';
 540         $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
 541         $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
 542         eval {
 543             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         if ($@) {
 553             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
 554         }
 555     }
 556     elsif ($params{'barcode_type'} eq 'EAN13') {
 557         $bar_length = 4; # FIXME
 558     $num_of_bars = 13;
 559         $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
 560         $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
 561         eval {
 562             PDF::Reuse::Barcode::EAN13(
 563                 x                   => $params{'llx'},
 564                 y                   => $params{'lly'},
 565                 value               => sprintf('%013d',$params{barcode_data}),
 566 #                xSize               => $x_scale_factor,
 567 #                ySize               => $params{'y_scale_factor'},
 568                 mode                    => 'graphic',
 569             );
 570         };
 571         if ($@) {
 572             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
 573         }
 574     }
 575     else {
 576     warn "unknown barcode_type: $params{barcode_type}";
 577     }
 578 }
 579
 580 sub csv_data {
 581     my $self = shift;
 582     my $label_fields = _get_text_fields($self->{'format_string'});
 583     my $item = _get_label_item($self->{'item_number'});
 584     my $bib_record = GetMarcBiblio($item->{biblionumber});
 585     my @csv_data = (map { _get_barcode_data($_->{'code'},$item,$bib_record) } @$label_fields);
 586     return \@csv_data;
 587 }
 588
 589 1;
 590 __END__
 591
 592 =head1 NAME
 593
 594 C4::Labels::Label - A class for creating and manipulating label objects in Koha
 595
 596 =head1 ABSTRACT
 597
 598 This module provides methods for creating, and otherwise manipulating single label objects used by Koha to create and export labels.
 599
 600 =head1 METHODS
 601
 602 =head2 new()
 603
 604     Invoking the I<new> method constructs a new label object containing the supplied values. Depending on the final output format of the label data
 605     the minimal required parameters change. (See the implimentation of this object type in labels/label-create-pdf.pl and labels/label-create-csv.pl
 606     and labels/label-create-xml.pl for examples.) The following parameters are optionally accepted as key => value pairs:
 607
 608         C<batch_id>             Batch id with which this label is associated
 609         C<item_number>          Item number of item to be the data source for this label
 610         C<height>               Height of this label (All measures passed to this method B<must> be supplied in postscript points)
 611         C<width>                Width of this label
 612         C<top_text_margin>      Top margin of this label
 613         C<left_text_margin>     Left margin of this label
 614         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:
 615
 616 =over 9
 617
 618 =item .
 619             CODE39          = Code 3 of 9
 620
 621 =item .
 622             CODE39MOD       = Code 3 of 9 with modulo 43 checksum
 623
 624 =item .
 625             CODE39MOD10     = Code 3 of 9 with modulo 10 checksum
 626
 627 =item .
 628             COOP2OF5        = A varient of 2 of 5 barcode based on NEC's "Process 8000" code
 629
 630 =item .
 631             INDUSTRIAL2OF5  = The standard 2 of 5 barcode (a binary level bar code developed by Identicon Corp. and Computer Identics Corp. in 1970)
 632
 633 =item .
 634             EAN13           = The standard EAN-13 barcode
 635
 636 =back
 637
 638         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:
 639
 640 =over 9
 641
 642 =item .
 643 BIB     = Only the bibliographic data is printed
 644
 645 =item .
 646 BARBIB  = Barcode proceeds bibliographic data
 647
 648 =item .
 649 BIBBAR  = Bibliographic data proceeds barcode
 650
 651 =item .
 652 ALT     = Barcode and bibliographic data are printed on alternating labels
 653
 654 =item .
 655 BAR     = Only the barcode is printed
 656
 657 =back
 658
 659         C<guidebox>             Setting this to '1' will result in a guide box being drawn around the labels marking the edge of each label
 660         C<font>                 Defines the type of font to be used on labels. NOTE: The following fonts are available by default on most systems:
 661
 662 =over 9
 663
 664 =item .
 665 TR      = Times-Roman
 666
 667 =item .
 668 TB      = Times Bold
 669
 670 =item .
 671 TI      = Times Italic
 672
 673 =item .
 674 TBI     = Times Bold Italic
 675
 676 =item .
 677 C       = Courier
 678
 679 =item .
 680 CB      = Courier Bold
 681
 682 =item .
 683 CO      = Courier Oblique (Italic)
 684
 685 =item .
 686 CBO     = Courier Bold Oblique
 687
 688 =item .
 689 H       = Helvetica
 690
 691 =item .
 692 HB      = Helvetica Bold
 693
 694 =item .
 695 HBO     = Helvetical Bold Oblique
 696
 697 =back
 698
 699         C<font_size>            Defines the size of the font in postscript points to be used on labels
 700         C<callnum_split>        Setting this to '1' will enable call number splitting on labels
 701         C<text_justify>         Defines the text justification to be used on labels. NOTE: The following justification styles are currently supported by label creator code:
 702
 703 =over 9
 704
 705 =item .
 706 L       = Left
 707
 708 =item .
 709 C       = Center
 710
 711 =item .
 712 R       = Right
 713
 714 =back
 715
 716         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
 717                                 to your MARC frameworks. Specify MARC subfields as a 4-character tag-subfield string: ie. 254a Enclose a whitespace-separated list of fields
 718                                 to concatenate on one line in double quotes. ie. "099a 099b" or "itemcallnumber barcode" Static text strings may be entered in single-quotes:
 719                                 ie. 'Some static text here.'
 720         C<text_wrap_cols>       Defines the column after which the text will wrap to the next line.
 721
 722 =head2 get_label_type()
 723
 724    Invoking the I<get_label_type> method will return the printing type of the label object.
 725
 726    example:
 727         C<my $label_type = $label->get_label_type();>
 728
 729 =head2 get_attr($attribute)
 730
 731     Invoking the I<get_attr> method will return the value of the requested attribute or -1 on errors.
 732
 733     example:
 734         C<my $value = $label->get_attr($attribute);>
 735
 736 =head2 create_label()
 737
 738     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
 739     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
 740     code is responsible to properly format the text for insertion into the pdf stream as well as the actual insertion.
 741
 742     example:
 743         my $label_text = $label->create_label();
 744
 745 =head2 draw_label_text()
 746
 747     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
 748     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)
 749
 750         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)
 751         C<lly>                  The lower-left y coordinate for the text block
 752         C<top_text_margin>      The top margin for the text block.
 753         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)
 754         C<font>                 The font to use for this label. See documentation on the new() method for supported fonts.
 755         C<font_size>            The font size in points to use for this label.
 756         C<justify>              The style of justification to use for this label. See documentation on the new() method for supported justification styles.
 757
 758     example:
 759        C<my $label_text = $label->draw_label_text(
 760                                                 llx                 => $text_llx,
 761                                                 lly                 => $text_lly,
 762                                                 top_text_margin     => $label_top_text_margin,
 763                                                 line_spacer         => $text_leading,
 764                                                 font                => $text_font,
 765                                                 font_size           => $text_font_size,
 766                                                 justify             => $text_justification,
 767                         );>
 768
 769 =head2 barcode()
 770
 771     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
 772     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
 773     type of the current template being used.):
 774
 775         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)
 776         C<lly>                  The lower-left y coordinate for the barcode block
 777         C<width>                The width of the barcode block
 778         C<y_scale_factor>       The scale factor to be applied to the y axis of the barcode block
 779         C<barcode_data>         The data to be encoded in the barcode
 780         C<barcode_type>         The barcode type (See the C<new()> method for supported barcode types)
 781
 782     example:
 783        C<$label->barcode(
 784                     llx                 => $barcode_llx,
 785                     lly                 => $barcode_lly,
 786                     width               => $barcode_width,
 787                     y_scale_factor      => $barcode_y_scale_factor,
 788                     barcode_data        => $barcode,
 789                     barcode_type        => $barcodetype,
 790         );>
 791
 792 =head2 csv_data()
 793
 794     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.
 795
 796     example:
 797         C<my $csv_data = $label->csv_data();>
 798
 799 =head1 AUTHOR
 800
 801 Mason James <mason@katipo.co.nz>
 802
 803 Chris Nighswonger <cnighswonger AT foundations DOT edu>
 804
 805 =head1 COPYRIGHT
 806
 807 Copyright 2006 Katipo Communications.
 808
 809 Copyright 2009 Foundations Bible College.
 810
 811 =head1 LICENSE
 812
 813 This file is part of Koha.
 814
 815 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
 816 Foundation; either version 2 of the License, or (at your option) any later version.
 817
 818 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,
 819 Fifth Floor, Boston, MA 02110-1301 USA.
 820
 821 =head1 DISCLAIMER OF WARRANTY
 822
 823 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
 824 A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 825
 826 =cut