C4/Labels/Label.pm

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