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