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