C4/Labels/Label.pm

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