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 }
  19
  20 my $possible_decimal = qr/\d{3,}(?:\.\d+)?/; # at least three digits for a DDCN
  21
  22 sub _check_params {
  23     my $given_params = {};
  24     my $exit_code = 0;
  25     my @valid_label_params = (
  26         'batch_id',
  27         'item_number',
  28         'llx',
  29         'lly',
  30         'height',
  31         'width',
  32         'top_text_margin',
  33         'left_text_margin',
  34         'barcode_type',
  35         'printing_type',
  36         'guidebox',
  37         'oblique_title',
  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         oblique_title           => $params{'oblique_title'},
 330         font                    => $params{'font'},
 331         font_size               => $params{'font_size'},
 332         callnum_split           => $params{'callnum_split'},
 333         justify                 => $params{'justify'},
 334         format_string           => $params{'format_string'},
 335         text_wrap_cols          => $params{'text_wrap_cols'},
 336         barcode                 => 0,
 337     };
 338     if ($self->{'guidebox'}) {
 339         $self->{'guidebox'} = _guide_box($self->{'llx'}, $self->{'lly'}, $self->{'width'}, $self->{'height'});
 340     }
 341     bless ($self, $type);
 342     return $self;
 343 }
 344
 345 sub get_label_type {
 346     my $self = shift;
 347     return $self->{'printing_type'};
 348 }
 349
 350 sub get_attr {
 351     my $self = shift;
 352     if (_check_params(@_) eq 1) {
 353         return -1;
 354     }
 355     my ($attr) = @_;
 356     if (exists($self->{$attr})) {
 357         return $self->{$attr};
 358     }
 359     else {
 360         return -1;
 361     }
 362     return;
 363 }
 364
 365 sub create_label {
 366     my $self = shift;
 367     my $label_text = '';
 368     my ($text_llx, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor);
 369     {
 370         no strict 'refs';
 371         ($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
 372     }
 373     if ($self->{'printing_type'} =~ /BIB/) {
 374         $label_text = draw_label_text(  $self,
 375                                         llx             => $text_llx,
 376                                         lly             => $text_lly,
 377                                         line_spacer     => $line_spacer,
 378                                     );
 379     }
 380     if ($self->{'printing_type'} =~ /BAR/) {
 381         barcode(    $self,
 382                     llx                 => $barcode_llx,
 383                     lly                 => $barcode_lly,
 384                     width               => $barcode_width,
 385                     y_scale_factor      => $barcode_y_scale_factor,
 386         );
 387     }
 388     return $label_text if $label_text;
 389     return;
 390 }
 391
 392 sub draw_label_text {
 393     my ($self, %params) = @_;
 394     my @label_text = ();
 395     my $text_llx = 0;
 396     my $text_lly = $params{'lly'};
 397     my $font = $self->{'font'};
 398     my $item = _get_label_item($self->{'item_number'});
 399     my $label_fields = _get_text_fields($self->{'format_string'});
 400     my $record = GetMarcBiblio($item->{'biblionumber'});
 401     # FIXME - returns all items, so you can't get data from an embedded holdings field.
 402     # TODO - add a GetMarcBiblio1item(bibnum,itemnum) or a GetMarcItem(itemnum).
 403     my $cn_source = ($item->{'cn_source'} ? $item->{'cn_source'} : C4::Context->preference('DefaultClassificationSource'));
 404     LABEL_FIELDS:       # process data for requested fields on current label
 405     for my $field (@$label_fields) {
 406         if ($field->{'code'} eq 'itemtype') {
 407             $field->{'data'} = C4::Context->preference('item-level_itypes') ? $item->{'itype'} : $item->{'itemtype'};
 408         }
 409         else {
 410             $field->{'data'} = _get_barcode_data($field->{'code'},$item,$record);
 411         }
 412         # Find apropriate font it oblique title selected, except main font is oblique
 413         if ( ( $field->{'code'} eq 'title' ) and ( $self->{'oblique_title'} == 1 ) ) {
 414             if ( $font =~ /^TB$/ ) {
 415                 $font .= 'I';
 416             }
 417             elsif ( $font =~ /^TR$/ ) {
 418                 $font = 'TI';
 419             }
 420             elsif ( $font !~ /^T/ and $font !~ /O$/ ) {
 421                 $font .= 'O';
 422             }
 423         }
 424         my $field_data = $field->{'data'};
 425         if ($field_data) {
 426             $field_data =~ s/\n//g;
 427             $field_data =~ s/\r//g;
 428         }
 429         my @label_lines;
 430         # Fields which hold call number data  FIXME: ( 060? 090? 092? 099? )
 431         my @callnumber_list = qw(itemcallnumber 050a 050b 082a 952o 995k);
 432         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
 433             if ($cn_source eq 'lcc' || $cn_source eq 'nlm') { # NLM and LCC should be split the same way
 434                 @label_lines = _split_lccn($field_data);
 435                 @label_lines = _split_ccn($field_data) if !@label_lines;    # If it was not a true lccn, try it as a custom call number
 436                 push (@label_lines, $field_data) if !@label_lines;         # If it was not that, send it on unsplit
 437             } elsif ($cn_source eq 'ddc') {
 438                 @label_lines = _split_ddcn($field_data);
 439                 @label_lines = _split_ccn($field_data) if !@label_lines;
 440                 push (@label_lines, $field_data) if !@label_lines;
 441             } else {
 442                 warn sprintf('Call number splitting failed for: %s. Please add this call number to bug #2500 at bugs.koha-community.org', $field_data);
 443                 push @label_lines, $field_data;
 444             }
 445         }
 446         else {
 447             if ($field_data) {
 448                 $field_data =~ s/\/$//g;       # Here we will strip out all trailing '/' in fields other than the call number...
 449                 # Escaping the parens was causing odd output, see bug 13124
 450                 # $field_data =~ s/\(/\\\(/g;    # Escape '(' and ')' for the pdf object stream...
 451                 # $field_data =~ s/\)/\\\)/g;
 452             }
 453             eval{$Text::Wrap::columns = $self->{'text_wrap_cols'};};
 454             my @line = split(/\n/ ,wrap('', '', $field_data));
 455             # If this is a title field, limit to two lines; all others limit to one... FIXME: this is rather arbitrary
 456             if ($field->{'code'} eq 'title' && scalar(@line) >= 2) {
 457                 while (scalar(@line) > 2) {
 458                     pop @line;
 459                 }
 460             } else {
 461                 while (scalar(@line) > 1) {
 462                     pop @line;
 463                 }
 464             }
 465             push(@label_lines, @line);
 466         }
 467         LABEL_LINES:    # generate lines of label text for current field
 468         foreach my $line (@label_lines) {
 469             next LABEL_LINES if $line eq '';
 470             $line = log2vis( $line );
 471             my $string_width = C4::Creators::PDF->StrWidth($line, $font, $self->{'font_size'});
 472             if ($self->{'justify'} eq 'R') {
 473                 $text_llx = $params{'llx'} + $self->{'width'} - ($self->{'left_text_margin'} + $string_width);
 474             }
 475             elsif($self->{'justify'} eq 'C') {
 476                  # some code to try and center each line on the label based on font size and string point width...
 477                  my $whitespace = ($self->{'width'} - ($string_width + (2 * $self->{'left_text_margin'})));
 478                  $text_llx = (($whitespace  / 2) + $params{'llx'} + $self->{'left_text_margin'});
 479             }
 480             else {
 481                 $text_llx = ($params{'llx'} + $self->{'left_text_margin'});
 482             }
 483             push @label_text,   {
 484                                 text_llx        => $text_llx,
 485                                 text_lly        => $text_lly,
 486                                 font            => $font,
 487                                 font_size       => $self->{'font_size'},
 488                                 line            => $line,
 489                                 };
 490             $text_lly = $text_lly - $params{'line_spacer'};
 491         }
 492         $font = $self->{'font'};        # reset font for next field
 493     }   #foreach field
 494     return \@label_text;
 495 }
 496
 497 sub draw_guide_box {
 498     return $_[0]->{'guidebox'};
 499 }
 500
 501 sub barcode {
 502     my $self = shift;
 503     my %params = @_;
 504     $params{'barcode_data'} = _get_label_item($self->{'item_number'}, 1) if !$params{'barcode_data'};
 505     $params{'barcode_type'} = $self->{'barcode_type'} if !$params{'barcode_type'};
 506     my $x_scale_factor = 1;
 507     my $num_of_bars = length($params{'barcode_data'});
 508     my $tot_bar_length = 0;
 509     my $bar_length = 0;
 510     my $guard_length = 10;
 511     my $hide_text = 'yes';
 512     if ($params{'barcode_type'} =~ m/CODE39/) {
 513         $bar_length = '17.5';
 514         $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
 515         $x_scale_factor = ($params{'width'} / $tot_bar_length);
 516         if ($params{'barcode_type'} eq 'CODE39MOD') {
 517             my $c39 = CheckDigits('code_39');   # get modulo43 checksum
 518             $params{'barcode_data'} = $c39->complete($params{'barcode_data'});
 519         }
 520         elsif ($params{'barcode_type'} eq 'CODE39MOD10') {
 521             my $c39_10 = CheckDigits('siret');   # get modulo43 checksum
 522             $params{'barcode_data'} = $c39_10->complete($params{'barcode_data'});
 523             $hide_text = '';
 524         }
 525         eval {
 526             PDF::Reuse::Barcode::Code39(
 527                 x                   => $params{'llx'},
 528                 y                   => $params{'lly'},
 529                 value               => "*$params{barcode_data}*",
 530                 xSize               => $x_scale_factor,
 531                 ySize               => $params{'y_scale_factor'},
 532                 hide_asterisk       => 1,
 533                 text                => $hide_text,
 534                 mode                => 'graphic',
 535             );
 536         };
 537         if ($@) {
 538             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
 539         }
 540     }
 541     elsif ($params{'barcode_type'} eq 'COOP2OF5') {
 542         $bar_length = '9.43333333333333';
 543         $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
 544         $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
 545         eval {
 546             PDF::Reuse::Barcode::COOP2of5(
 547                 x                   => $params{'llx'},
 548                 y                   => $params{'lly'},
 549                 value               => $params{barcode_data},
 550                 xSize               => $x_scale_factor,
 551                 ySize               => $params{'y_scale_factor'},
 552                 mode                    => 'graphic',
 553             );
 554         };
 555         if ($@) {
 556             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
 557         }
 558     }
 559     elsif ( $params{'barcode_type'} eq 'INDUSTRIAL2OF5' ) {
 560         $bar_length = '13.1333333333333';
 561         $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
 562         $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
 563         eval {
 564             PDF::Reuse::Barcode::Industrial2of5(
 565                 x                   => $params{'llx'},
 566                 y                   => $params{'lly'},
 567                 value               => $params{barcode_data},
 568                 xSize               => $x_scale_factor,
 569                 ySize               => $params{'y_scale_factor'},
 570                 mode                    => 'graphic',
 571             );
 572         };
 573         if ($@) {
 574             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
 575         }
 576     }
 577     elsif ($params{'barcode_type'} eq 'EAN13') {
 578         $bar_length = 4; # FIXME
 579     $num_of_bars = 13;
 580         $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
 581         $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
 582         eval {
 583             PDF::Reuse::Barcode::EAN13(
 584                 x                   => $params{'llx'},
 585                 y                   => $params{'lly'},
 586                 value               => sprintf('%013d',$params{barcode_data}),
 587 #                xSize               => $x_scale_factor,
 588 #                ySize               => $params{'y_scale_factor'},
 589                 mode                    => 'graphic',
 590             );
 591         };
 592         if ($@) {
 593             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
 594         }
 595     }
 596     else {
 597     warn "unknown barcode_type: $params{barcode_type}";
 598     }
 599 }
 600
 601 sub csv_data {
 602     my $self = shift;
 603     my $label_fields = _get_text_fields($self->{'format_string'});
 604     my $item = _get_label_item($self->{'item_number'});
 605     my $bib_record = GetMarcBiblio($item->{biblionumber});
 606     my @csv_data = (map { _get_barcode_data($_->{'code'},$item,$bib_record) } @$label_fields);
 607     return \@csv_data;
 608 }
 609
 610 1;
 611 __END__
 612
 613 =head1 NAME
 614
 615 C4::Labels::Label - A class for creating and manipulating label objects in Koha
 616
 617 =head1 ABSTRACT
 618
 619 This module provides methods for creating, and otherwise manipulating single label objects used by Koha to create and export labels.
 620
 621 =head1 METHODS
 622
 623 =head2 new()
 624
 625     Invoking the I<new> method constructs a new label object containing the supplied values. Depending on the final output format of the label data
 626     the minimal required parameters change. (See the implimentation of this object type in labels/label-create-pdf.pl and labels/label-create-csv.pl
 627     and labels/label-create-xml.pl for examples.) The following parameters are optionally accepted as key => value pairs:
 628
 629         C<batch_id>             Batch id with which this label is associated
 630         C<item_number>          Item number of item to be the data source for this label
 631         C<height>               Height of this label (All measures passed to this method B<must> be supplied in postscript points)
 632         C<width>                Width of this label
 633         C<top_text_margin>      Top margin of this label
 634         C<left_text_margin>     Left margin of this label
 635         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:
 636
 637 =over 9
 638
 639 =item .
 640             CODE39          = Code 3 of 9
 641
 642 =item .
 643             CODE39MOD       = Code 3 of 9 with modulo 43 checksum
 644
 645 =item .
 646             CODE39MOD10     = Code 3 of 9 with modulo 10 checksum
 647
 648 =item .
 649             COOP2OF5        = A variant of 2 of 5 barcode based on NEC's "Process 8000" code
 650
 651 =item .
 652             INDUSTRIAL2OF5  = The standard 2 of 5 barcode (a binary level bar code developed by Identicon Corp. and Computer Identics Corp. in 1970)
 653
 654 =item .
 655             EAN13           = The standard EAN-13 barcode
 656
 657 =back
 658
 659         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:
 660
 661 =over 9
 662
 663 =item .
 664 BIB     = Only the bibliographic data is printed
 665
 666 =item .
 667 BARBIB  = Barcode proceeds bibliographic data
 668
 669 =item .
 670 BIBBAR  = Bibliographic data proceeds barcode
 671
 672 =item .
 673 ALT     = Barcode and bibliographic data are printed on alternating labels
 674
 675 =item .
 676 BAR     = Only the barcode is printed
 677
 678 =back
 679
 680         C<guidebox>             Setting this to '1' will result in a guide box being drawn around the labels marking the edge of each label
 681         C<font>                 Defines the type of font to be used on labels. NOTE: The following fonts are available by default on most systems:
 682
 683 =over 9
 684
 685 =item .
 686 TR      = Times-Roman
 687
 688 =item .
 689 TB      = Times Bold
 690
 691 =item .
 692 TI      = Times Italic
 693
 694 =item .
 695 TBI     = Times Bold Italic
 696
 697 =item .
 698 C       = Courier
 699
 700 =item .
 701 CB      = Courier Bold
 702
 703 =item .
 704 CO      = Courier Oblique (Italic)
 705
 706 =item .
 707 CBO     = Courier Bold Oblique
 708
 709 =item .
 710 H       = Helvetica
 711
 712 =item .
 713 HB      = Helvetica Bold
 714
 715 =item .
 716 HBO     = Helvetical Bold Oblique
 717
 718 =back
 719
 720         C<font_size>            Defines the size of the font in postscript points to be used on labels
 721         C<callnum_split>        Setting this to '1' will enable call number splitting on labels
 722         C<text_justify>         Defines the text justification to be used on labels. NOTE: The following justification styles are currently supported by label creator code:
 723
 724 =over 9
 725
 726 =item .
 727 L       = Left
 728
 729 =item .
 730 C       = Center
 731
 732 =item .
 733 R       = Right
 734
 735 =back
 736
 737         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
 738                                 to your MARC frameworks. Specify MARC subfields as a 4-character tag-subfield string: ie. 254a Enclose a whitespace-separated list of fields
 739                                 to concatenate on one line in double quotes. ie. "099a 099b" or "itemcallnumber barcode" Static text strings may be entered in single-quotes:
 740                                 ie. 'Some static text here.'
 741         C<text_wrap_cols>       Defines the column after which the text will wrap to the next line.
 742
 743 =head2 get_label_type()
 744
 745    Invoking the I<get_label_type> method will return the printing type of the label object.
 746
 747    example:
 748         C<my $label_type = $label->get_label_type();>
 749
 750 =head2 get_attr($attribute)
 751
 752     Invoking the I<get_attr> method will return the value of the requested attribute or -1 on errors.
 753
 754     example:
 755         C<my $value = $label->get_attr($attribute);>
 756
 757 =head2 create_label()
 758
 759     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
 760     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
 761     code is responsible to properly format the text for insertion into the pdf stream as well as the actual insertion.
 762
 763     example:
 764         my $label_text = $label->create_label();
 765
 766 =head2 draw_label_text()
 767
 768     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
 769     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)
 770
 771         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)
 772         C<lly>                  The lower-left y coordinate for the text block
 773         C<top_text_margin>      The top margin for the text block.
 774         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)
 775         C<font>                 The font to use for this label. See documentation on the new() method for supported fonts.
 776         C<font_size>            The font size in points to use for this label.
 777         C<justify>              The style of justification to use for this label. See documentation on the new() method for supported justification styles.
 778
 779     example:
 780        C<my $label_text = $label->draw_label_text(
 781                                                 llx                 => $text_llx,
 782                                                 lly                 => $text_lly,
 783                                                 top_text_margin     => $label_top_text_margin,
 784                                                 line_spacer         => $text_leading,
 785                                                 font                => $text_font,
 786                                                 font_size           => $text_font_size,
 787                                                 justify             => $text_justification,
 788                         );>
 789
 790 =head2 barcode()
 791
 792     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
 793     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
 794     type of the current template being used.):
 795
 796         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)
 797         C<lly>                  The lower-left y coordinate for the barcode block
 798         C<width>                The width of the barcode block
 799         C<y_scale_factor>       The scale factor to be applied to the y axis of the barcode block
 800         C<barcode_data>         The data to be encoded in the barcode
 801         C<barcode_type>         The barcode type (See the C<new()> method for supported barcode types)
 802
 803     example:
 804        C<$label->barcode(
 805                     llx                 => $barcode_llx,
 806                     lly                 => $barcode_lly,
 807                     width               => $barcode_width,
 808                     y_scale_factor      => $barcode_y_scale_factor,
 809                     barcode_data        => $barcode,
 810                     barcode_type        => $barcodetype,
 811         );>
 812
 813 =head2 csv_data()
 814
 815     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.
 816
 817     example:
 818         C<my $csv_data = $label->csv_data();>
 819
 820 =head1 AUTHOR
 821
 822 Mason James <mason@katipo.co.nz>
 823
 824 Chris Nighswonger <cnighswonger AT foundations DOT edu>
 825
 826 =head1 COPYRIGHT
 827
 828 Copyright 2006 Katipo Communications.
 829
 830 Copyright 2009 Foundations Bible College.
 831
 832 =head1 LICENSE
 833
 834 This file is part of Koha.
 835
 836 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
 837 Foundation; either version 2 of the License, or (at your option) any later version.
 838
 839 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,
 840 Fifth Floor, Boston, MA 02110-1301 USA.
 841
 842 =head1 DISCLAIMER OF WARRANTY
 843
 844 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
 845 A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 846
 847 =cut