C4/Labels/Label.pm

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