koha-dev.rot13.org Git - srvgit/blob - C4/Labels/Label.pm

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