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