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