C4/Labels/Label.pm

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