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