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
  18 my $possible_decimal = qr/\d{3,}(?:\.\d+)?/; # at least three digits for a DDCN
  19
  20 sub _check_params {
  21     my $given_params = {};
  22     my $exit_code = 0;
  23     my @valid_label_params = (
  24         'batch_id',
  25         'item_number',
  26         'llx',
  27         'lly',
  28         'height',
  29         'width',
  30         'top_text_margin',
  31         'left_text_margin',
  32         'barcode_type',
  33         'printing_type',
  34         'guidebox',
  35         'oblique_title',
  36         'font',
  37         'font_size',
  38         'callnum_split',
  39         'justify',
  40         'format_string',
  41         'text_wrap_cols',
  42         'barcode',
  43     );
  44     if (scalar(@_) >1) {
  45         $given_params = {@_};
  46         foreach my $key (keys %{$given_params}) {
  47             if (!(grep m/$key/, @valid_label_params)) {
  48                 warn sprintf('Unrecognized parameter type of "%s".', $key);
  49                 $exit_code = 1;
  50             }
  51         }
  52     }
  53     else {
  54         if (!(grep m/$_/, @valid_label_params)) {
  55             warn sprintf('Unrecognized parameter type of "%s".', $_);
  56             $exit_code = 1;
  57         }
  58     }
  59     return $exit_code;
  60 }
  61
  62 sub _guide_box {
  63     my ( $llx, $lly, $width, $height ) = @_;
  64     return unless ( defined $llx and defined $lly and
  65                     defined $width and defined $height );
  66     my $obj_stream = "q\n";                            # save the graphic state
  67     $obj_stream .= "0.5 w\n";                          # border line width
  68     $obj_stream .= "1.0 0.0 0.0  RG\n";                # border color red
  69     $obj_stream .= "1.0 1.0 1.0  rg\n";                # fill color white
  70     $obj_stream .= "$llx $lly $width $height re\n";    # a rectangle
  71     $obj_stream .= "B\n";                              # fill (and a little more)
  72     $obj_stream .= "Q\n";                              # restore the graphic state
  73     return $obj_stream;
  74 }
  75
  76 sub _get_label_item {
  77     my $item_number = shift;
  78     my $barcode_only = shift || 0;
  79     my $dbh = C4::Context->dbh;
  80 #        FIXME This makes for a very bulky data structure; data from tables w/duplicate col names also gets overwritten.
  81 #        Something like this, perhaps, but this also causes problems because we need more fields sometimes.
  82 #        SELECT i.barcode, i.itemcallnumber, i.itype, bi.isbn, bi.issn, b.title, b.author
  83     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;");
  84     $sth->execute($item_number);
  85     if ($sth->err) {
  86         warn sprintf('Database returned the following error: %s', $sth->errstr);
  87     }
  88     my $data = $sth->fetchrow_hashref;
  89     # Replaced item's itemtype with the more user-friendly description...
  90     my $sth1 = $dbh->prepare("SELECT itemtype,description FROM itemtypes WHERE itemtype = ?");
  91     $sth1->execute($data->{'itemtype'});
  92     if ($sth1->err) {
  93         warn sprintf('Database returned the following error: %s', $sth1->errstr);
  94     }
  95     my $data1 = $sth1->fetchrow_hashref;
  96     $data->{'itemtype'} = $data1->{'description'};
  97     $data->{'itype'} = $data1->{'description'};
  98     # add *_description fields
  99     if ($data->{'homebranch'} || $data->{'holdingbranch'}){
 100         require Koha::Libraries;
 101         # FIXME Is this used??
 102         $data->{'homebranch_description'} = Koha::Libraries->find($data->{'homebranch'})->branchname if $data->{'homebranch'};
 103         $data->{'holdingbranch_description'} = Koha::Libraries->find($data->{'holdingbranch'})->branchname if $data->{'holdingbranch'};
 104     }
 105     $data->{'ccode_description'} = C4::Biblio::GetAuthorisedValueDesc('','', $data->{'ccode'} ,'','','CCODE', 1) if $data->{'ccode'};
 106     $data->{'location_description'} = C4::Biblio::GetAuthorisedValueDesc('','', $data->{'location'} ,'','','LOC', 1) if $data->{'location'};
 107     $data->{'permanent_location_description'} = C4::Biblio::GetAuthorisedValueDesc('','', $data->{'permanent_location'} ,'','','LOC', 1) if $data->{'permanent_location'};
 108
 109     $barcode_only ? return $data->{'barcode'} : return $data;
 110 }
 111
 112 sub _get_text_fields {
 113     my $format_string = shift;
 114     my $csv = Text::CSV_XS->new({allow_whitespace => 1});
 115     my $status = $csv->parse($format_string);
 116     my @sorted_fields = map {{ 'code' => $_, desc => $_ }}
 117                         map { $_ && $_ eq 'callnumber' ? 'itemcallnumber' : $_ } # see bug 5653
 118                         $csv->fields();
 119     my $error = $csv->error_input();
 120     warn sprintf('Text field sort failed with this error: %s', $error) if $error;
 121     return \@sorted_fields;
 122 }
 123
 124
 125 sub _split_lccn {
 126     my ($lccn) = @_;
 127     $_ = $lccn;
 128     # lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996';
 129     my @parts = Library::CallNumber::LC->new($lccn)->components();
 130     unless (scalar @parts && defined $parts[0])  {
 131         $debug and warn sprintf('regexp failed to match string: %s', $_);
 132         @parts = $_;     # if no match, just use the whole string.
 133     }
 134     my $LastPiece = pop @parts;
 135     push @parts, split /\s+/, $LastPiece if $LastPiece;   # 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         oblique_title           => $params{'oblique_title'},
 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({ biblionumber => $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         # Find appropriate font it oblique title selected, except main font is oblique
 412         if ( ( $field->{'code'} eq 'title' ) and ( $self->{'oblique_title'} == 1 ) ) {
 413             if ( $font =~ /^TB$/ ) {
 414                 $font .= 'I';
 415             }
 416             elsif ( $font =~ /^TR$/ ) {
 417                 $font = 'TI';
 418             }
 419             elsif ( $font !~ /^T/ and $font !~ /O$/ ) {
 420                 $font .= 'O';
 421             }
 422         }
 423         my $field_data = $field->{'data'};
 424         if ($field_data) {
 425             $field_data =~ s/\n//g;
 426             $field_data =~ s/\r//g;
 427         }
 428         my @label_lines;
 429         # Fields which hold call number data  FIXME: ( 060? 090? 092? 099? )
 430         my @callnumber_list = qw(itemcallnumber 050a 050b 082a 952o 995k);
 431         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
 432             if ($cn_source eq 'lcc' || $cn_source eq 'nlm') { # NLM and LCC should be split the same way
 433                 @label_lines = _split_lccn($field_data);
 434                 @label_lines = _split_ccn($field_data) if !@label_lines;    # If it was not a true lccn, try it as a custom call number
 435                 push (@label_lines, $field_data) if !@label_lines;         # If it was not that, send it on unsplit
 436             } elsif ($cn_source eq 'ddc') {
 437                 @label_lines = _split_ddcn($field_data);
 438                 @label_lines = _split_ccn($field_data) if !@label_lines;
 439                 push (@label_lines, $field_data) if !@label_lines;
 440             } else {
 441                 warn sprintf('Call number splitting failed for: %s. Please add this call number to bug #2500 at bugs.koha-community.org', $field_data);
 442                 push @label_lines, $field_data;
 443             }
 444         }
 445         else {
 446             if ($field_data) {
 447                 $field_data =~ s/\/$//g;       # Here we will strip out all trailing '/' in fields other than the call number...
 448                 # Escaping the parens was causing odd output, see bug 13124
 449                 # $field_data =~ s/\(/\\\(/g;    # Escape '(' and ')' for the pdf object stream...
 450                 # $field_data =~ s/\)/\\\)/g;
 451             }
 452             eval{$Text::Wrap::columns = $self->{'text_wrap_cols'};};
 453             my @line = split(/\n/ ,wrap('', '', $field_data));
 454             # If this is a title field, limit to two lines; all others limit to one... FIXME: this is rather arbitrary
 455             if ($field->{'code'} eq 'title' && scalar(@line) >= 2) {
 456                 while (scalar(@line) > 2) {
 457                     pop @line;
 458                 }
 459             } else {
 460                 while (scalar(@line) > 1) {
 461                     pop @line;
 462                 }
 463             }
 464             push(@label_lines, @line);
 465         }
 466         LABEL_LINES:    # generate lines of label text for current field
 467         foreach my $line (@label_lines) {
 468             next LABEL_LINES if $line eq '';
 469             $line = log2vis( $line );
 470             my $string_width = C4::Creators::PDF->StrWidth($line, $font, $self->{'font_size'});
 471             if ($self->{'justify'} eq 'R') {
 472                 $text_llx = $params{'llx'} + $self->{'width'} - ($self->{'left_text_margin'} + $string_width);
 473             }
 474             elsif($self->{'justify'} eq 'C') {
 475                  # some code to try and center each line on the label based on font size and string point width...
 476                  my $whitespace = ($self->{'width'} - ($string_width + (2 * $self->{'left_text_margin'})));
 477                  $text_llx = (($whitespace  / 2) + $params{'llx'} + $self->{'left_text_margin'});
 478             }
 479             else {
 480                 $text_llx = ($params{'llx'} + $self->{'left_text_margin'});
 481             }
 482             push @label_text,   {
 483                                 text_llx        => $text_llx,
 484                                 text_lly        => $text_lly,
 485                                 font            => $font,
 486                                 font_size       => $self->{'font_size'},
 487                                 line            => $line,
 488                                 };
 489             $text_lly = $text_lly - $params{'line_spacer'};
 490         }
 491         $font = $self->{'font'};        # reset font for next field
 492     }   #foreach field
 493     return \@label_text;
 494 }
 495
 496 sub draw_guide_box {
 497     return $_[0]->{'guidebox'};
 498 }
 499
 500 sub barcode {
 501     my $self = shift;
 502     my %params = @_;
 503     $params{'barcode_data'} = _get_label_item($self->{'item_number'}, 1) if !$params{'barcode_data'};
 504     $params{'barcode_type'} = $self->{'barcode_type'} if !$params{'barcode_type'};
 505     my $x_scale_factor = 1;
 506     my $num_of_bars = length($params{'barcode_data'});
 507     my $tot_bar_length = 0;
 508     my $bar_length = 0;
 509     my $guard_length = 10;
 510     my $hide_text = 'yes';
 511     if ($params{'barcode_type'} =~ m/CODE39/) {
 512         $bar_length = '17.5';
 513         $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
 514         $x_scale_factor = ($params{'width'} / $tot_bar_length);
 515         if ($params{'barcode_type'} eq 'CODE39MOD') {
 516             my $c39 = CheckDigits('code_39');   # get modulo43 checksum
 517             $params{'barcode_data'} = $c39->complete($params{'barcode_data'});
 518         }
 519         elsif ($params{'barcode_type'} eq 'CODE39MOD10') {
 520             my $c39_10 = CheckDigits('siret');   # get modulo43 checksum
 521             $params{'barcode_data'} = $c39_10->complete($params{'barcode_data'});
 522             $hide_text = '';
 523         }
 524         eval {
 525             PDF::Reuse::Barcode::Code39(
 526                 x                   => $params{'llx'},
 527                 y                   => $params{'lly'},
 528                 value               => "*$params{barcode_data}*",
 529                 xSize               => $x_scale_factor,
 530                 ySize               => $params{'y_scale_factor'},
 531                 hide_asterisk       => 1,
 532                 text                => $hide_text,
 533                 mode                => 'graphic',
 534             );
 535         };
 536         if ($@) {
 537             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
 538         }
 539     }
 540     elsif ($params{'barcode_type'} eq 'COOP2OF5') {
 541         $bar_length = '9.43333333333333';
 542         $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
 543         $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
 544         eval {
 545             PDF::Reuse::Barcode::COOP2of5(
 546                 x                   => $params{'llx'},
 547                 y                   => $params{'lly'},
 548                 value               => $params{barcode_data},
 549                 xSize               => $x_scale_factor,
 550                 ySize               => $params{'y_scale_factor'},
 551                 mode                    => 'graphic',
 552             );
 553         };
 554         if ($@) {
 555             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
 556         }
 557     }
 558     elsif ( $params{'barcode_type'} eq 'INDUSTRIAL2OF5' ) {
 559         $bar_length = '13.1333333333333';
 560         $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
 561         $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
 562         eval {
 563             PDF::Reuse::Barcode::Industrial2of5(
 564                 x                   => $params{'llx'},
 565                 y                   => $params{'lly'},
 566                 value               => $params{barcode_data},
 567                 xSize               => $x_scale_factor,
 568                 ySize               => $params{'y_scale_factor'},
 569                 mode                    => 'graphic',
 570             );
 571         };
 572         if ($@) {
 573             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
 574         }
 575     }
 576     elsif ($params{'barcode_type'} eq 'EAN13') {
 577         $bar_length = 4; # FIXME
 578     $num_of_bars = 13;
 579         $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
 580         $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
 581         eval {
 582             PDF::Reuse::Barcode::EAN13(
 583                 x                   => $params{'llx'},
 584                 y                   => $params{'lly'},
 585                 value               => sprintf('%013d',$params{barcode_data}),
 586 #                xSize               => $x_scale_factor,
 587 #                ySize               => $params{'y_scale_factor'},
 588                 mode                    => 'graphic',
 589             );
 590         };
 591         if ($@) {
 592             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
 593         }
 594     }
 595     else {
 596     warn "unknown barcode_type: $params{barcode_type}";
 597     }
 598 }
 599
 600 sub csv_data {
 601     my $self = shift;
 602     my $label_fields = _get_text_fields($self->{'format_string'});
 603     my $item = _get_label_item($self->{'item_number'});
 604     my $bib_record = GetMarcBiblio({ biblionumber => $item->{biblionumber} });
 605     my @csv_data = (map { _get_barcode_data($_->{'code'},$item,$bib_record) } @$label_fields);
 606     return \@csv_data;
 607 }
 608
 609 1;
 610 __END__
 611
 612 =head1 NAME
 613
 614 C4::Labels::Label - A class for creating and manipulating label objects in Koha
 615
 616 =head1 ABSTRACT
 617
 618 This module provides methods for creating, and otherwise manipulating single label objects used by Koha to create and export labels.
 619
 620 =head1 METHODS
 621
 622 =head2 new()
 623
 624     Invoking the I<new> method constructs a new label object containing the supplied values. Depending on the final output format of the label data
 625     the minimal required parameters change. (See the implimentation of this object type in labels/label-create-pdf.pl and labels/label-create-csv.pl
 626     and labels/label-create-xml.pl for examples.) The following parameters are optionally accepted as key => value pairs:
 627
 628         C<batch_id>             Batch id with which this label is associated
 629         C<item_number>          Item number of item to be the data source for this label
 630         C<height>               Height of this label (All measures passed to this method B<must> be supplied in postscript points)
 631         C<width>                Width of this label
 632         C<top_text_margin>      Top margin of this label
 633         C<left_text_margin>     Left margin of this label
 634         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:
 635
 636 =over 9
 637
 638 =item .
 639             CODE39          = Code 3 of 9
 640
 641 =item .
 642             CODE39MOD       = Code 3 of 9 with modulo 43 checksum
 643
 644 =item .
 645             CODE39MOD10     = Code 3 of 9 with modulo 10 checksum
 646
 647 =item .
 648             COOP2OF5        = A variant of 2 of 5 barcode based on NEC's "Process 8000" code
 649
 650 =item .
 651             INDUSTRIAL2OF5  = The standard 2 of 5 barcode (a binary level bar code developed by Identicon Corp. and Computer Identics Corp. in 1970)
 652
 653 =item .
 654             EAN13           = The standard EAN-13 barcode
 655
 656 =back
 657
 658         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:
 659
 660 =over 9
 661
 662 =item .
 663 BIB     = Only the bibliographic data is printed
 664
 665 =item .
 666 BARBIB  = Barcode proceeds bibliographic data
 667
 668 =item .
 669 BIBBAR  = Bibliographic data proceeds barcode
 670
 671 =item .
 672 ALT     = Barcode and bibliographic data are printed on alternating labels
 673
 674 =item .
 675 BAR     = Only the barcode is printed
 676
 677 =back
 678
 679         C<guidebox>             Setting this to '1' will result in a guide box being drawn around the labels marking the edge of each label
 680         C<font>                 Defines the type of font to be used on labels. NOTE: The following fonts are available by default on most systems:
 681
 682 =over 9
 683
 684 =item .
 685 TR      = Times-Roman
 686
 687 =item .
 688 TB      = Times Bold
 689
 690 =item .
 691 TI      = Times Italic
 692
 693 =item .
 694 TBI     = Times Bold Italic
 695
 696 =item .
 697 C       = Courier
 698
 699 =item .
 700 CB      = Courier Bold
 701
 702 =item .
 703 CO      = Courier Oblique (Italic)
 704
 705 =item .
 706 CBO     = Courier Bold Oblique
 707
 708 =item .
 709 H       = Helvetica
 710
 711 =item .
 712 HB      = Helvetica Bold
 713
 714 =item .
 715 HBO     = Helvetical Bold Oblique
 716
 717 =back
 718
 719         C<font_size>            Defines the size of the font in postscript points to be used on labels
 720         C<callnum_split>        Setting this to '1' will enable call number splitting on labels
 721         C<text_justify>         Defines the text justification to be used on labels. NOTE: The following justification styles are currently supported by label creator code:
 722
 723 =over 9
 724
 725 =item .
 726 L       = Left
 727
 728 =item .
 729 C       = Center
 730
 731 =item .
 732 R       = Right
 733
 734 =back
 735
 736         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
 737                                 to your MARC frameworks. Specify MARC subfields as a 4-character tag-subfield string: ie. 254a Enclose a whitespace-separated list of fields
 738                                 to concatenate on one line in double quotes. ie. "099a 099b" or "itemcallnumber barcode" Static text strings may be entered in single-quotes:
 739                                 ie. 'Some static text here.'
 740         C<text_wrap_cols>       Defines the column after which the text will wrap to the next line.
 741
 742 =head2 get_label_type()
 743
 744    Invoking the I<get_label_type> method will return the printing type of the label object.
 745
 746    example:
 747         C<my $label_type = $label->get_label_type();>
 748
 749 =head2 get_attr($attribute)
 750
 751     Invoking the I<get_attr> method will return the value of the requested attribute or -1 on errors.
 752
 753     example:
 754         C<my $value = $label->get_attr($attribute);>
 755
 756 =head2 create_label()
 757
 758     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
 759     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
 760     code is responsible to properly format the text for insertion into the pdf stream as well as the actual insertion.
 761
 762     example:
 763         my $label_text = $label->create_label();
 764
 765 =head2 draw_label_text()
 766
 767     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
 768     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)
 769
 770         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)
 771         C<lly>                  The lower-left y coordinate for the text block
 772         C<top_text_margin>      The top margin for the text block.
 773         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)
 774         C<font>                 The font to use for this label. See documentation on the new() method for supported fonts.
 775         C<font_size>            The font size in points to use for this label.
 776         C<justify>              The style of justification to use for this label. See documentation on the new() method for supported justification styles.
 777
 778     example:
 779        C<my $label_text = $label->draw_label_text(
 780                                                 llx                 => $text_llx,
 781                                                 lly                 => $text_lly,
 782                                                 top_text_margin     => $label_top_text_margin,
 783                                                 line_spacer         => $text_leading,
 784                                                 font                => $text_font,
 785                                                 font_size           => $text_font_size,
 786                                                 justify             => $text_justification,
 787                         );>
 788
 789 =head2 barcode()
 790
 791     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
 792     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
 793     type of the current template being used.):
 794
 795         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)
 796         C<lly>                  The lower-left y coordinate for the barcode block
 797         C<width>                The width of the barcode block
 798         C<y_scale_factor>       The scale factor to be applied to the y axis of the barcode block
 799         C<barcode_data>         The data to be encoded in the barcode
 800         C<barcode_type>         The barcode type (See the C<new()> method for supported barcode types)
 801
 802     example:
 803        C<$label->barcode(
 804                     llx                 => $barcode_llx,
 805                     lly                 => $barcode_lly,
 806                     width               => $barcode_width,
 807                     y_scale_factor      => $barcode_y_scale_factor,
 808                     barcode_data        => $barcode,
 809                     barcode_type        => $barcodetype,
 810         );>
 811
 812 =head2 csv_data()
 813
 814     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.
 815
 816     example:
 817         C<my $csv_data = $label->csv_data();>
 818
 819 =head1 AUTHOR
 820
 821 Mason James <mason@katipo.co.nz>
 822
 823 Chris Nighswonger <cnighswonger AT foundations DOT edu>
 824
 825 =head1 COPYRIGHT
 826
 827 Copyright 2006 Katipo Communications.
 828
 829 Copyright 2009 Foundations Bible College.
 830
 831 =head1 LICENSE
 832
 833 This file is part of Koha.
 834
 835 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
 836 Foundation; either version 2 of the License, or (at your option) any later version.
 837
 838 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,
 839 Fifth Floor, Boston, MA 02110-1301 USA.
 840
 841 =head1 DISCLAIMER OF WARRANTY
 842
 843 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
 844 A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 845
 846 =cut