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