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