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