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