C4/Labels/Label.pm

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