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