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