From 1ebc471e15ddd3214d7c9e2a8b4e2d2cc2f6e61f Mon Sep 17 00:00:00 2001 From: Chris Nighswonger Date: Mon, 20 Jul 2009 13:22:21 -0400 Subject: [PATCH] [6/40] Adding C4::Labels::Label Module Creates and manipulates Label objects --- C4/Labels/Label.pm | 494 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 494 insertions(+) create mode 100644 C4/Labels/Label.pm diff --git a/C4/Labels/Label.pm b/C4/Labels/Label.pm new file mode 100644 index 0000000000..ff8dfbbc96 --- /dev/null +++ b/C4/Labels/Label.pm @@ -0,0 +1,494 @@ +package C4::Labels::Label; + +# Copyright 2006 Katipo Communications. +# Some parts Copyright 2009 Foundations Bible College. +# +# This file is part of Koha. +# +# 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 +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# 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 +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# 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, +# Suite 330, Boston, MA 02111-1307 USA + +use strict; +use warnings; + +use Sys::Syslog qw(syslog); +use Text::Wrap; +use Algorithm::CheckDigits; +use Text::CSV_XS; + +use C4::Context; +use C4::Debug; +use C4::Biblio; +use Data::Dumper; + +BEGIN { + use version; our $VERSION = qv('1.0.0_1'); +} + +sub _guide_box { + my ( $llx, $lly, $width, $height ) = @_; + my $obj_stream = "q\n"; # save the graphic state + $obj_stream .= "0.5 w\n"; # border line width + $obj_stream .= "1.0 0.0 0.0 RG\n"; # border color red + $obj_stream .= "1.0 1.0 1.0 rg\n"; # fill color white + $obj_stream .= "$llx $lly $width $height re\n"; # a rectangle + $obj_stream .= "B\n"; # fill (and a little more) + $obj_stream .= "Q\n"; # restore the graphic state + return $obj_stream; +} + +sub _get_label_item { + my $item_number = shift; + my $barcode_only = shift || 0; + my $dbh = C4::Context->dbh; + my $query = +# FIXME This makes for a very bulky data structure; data from tables w/duplicate col names also gets overwritten. +# Something like this, perhaps, but this also causes problems because we need more fields sometimes. +# SELECT i.barcode, i.itemcallnumber, i.itype, bi.isbn, bi.issn, b.title, b.author + "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"; + my $sth = $dbh->prepare($query); + $sth->execute($item_number); + if ($sth->err) { + syslog("LOG_ERR", "C4::Labels::Label::_get_label_item : Database returned the following error: %s", $sth->errstr); + } + my $data = $sth->fetchrow_hashref; + # Replaced item's itemtype with the more user-friendly description... + my $sth1 = $dbh->prepare("SELECT itemtype,description FROM itemtypes WHERE itemtype = ?"); + $sth1->execute($data->{itemtype}); + if ($sth1->err) { + syslog("LOG_ERR", "C4::Labels::Label::_get_label_item : Database returned the following error: %s", $sth1->errstr); + } + my $data1 = $sth->fetchrow_hashref; + $data->{'itemtype'} = $data1->{'description'}; + $data->{'itype'} = $data1->{'description'}; + $barcode_only ? return $data->{'barcode'} : return $data; +} + +sub _get_text_fields { + my $format_string = shift; + my $csv = Text::CSV_XS->new({allow_whitespace => 1}); + my $status = $csv->parse($format_string); + my @sorted_fields = map {{ 'code' => $_, desc => $_ }} $csv->fields(); + my $error = $csv->error_input(); + syslog("LOG_ERR", "C4::Labels::Label::_get_text_fields : Text field sort failed with this error: %s", $error) if $error; + return \@sorted_fields; +} + +sub _split_lccn { + my ($lccn) = @_; + my ($ll, $wnl, $dec, $cutter, $pubdate) = (0, 0, 0, 0, 0); + $_ = $lccn; + # lccn example 'HE8700.7 .P6T44 1983'; + my @splits = m/ + (^[a-zA-Z]+) # HE + ([0-9]+\.*[0-9]*) # 8700.7 + \s* + (\.*[a-zA-Z0-9]*) # P6T44 + \s* + ([0-9]*) # 1983 + /x; + + # strip something occuring spaces too + $splits[0] =~ s/\s+$//; + $splits[1] =~ s/\s+$//; + $splits[2] =~ s/\s+$//; + + return @splits; +} + +sub _split_ddcn { + my ($ddcn) = @_; + $ddcn =~ s/\///g; # in theory we should be able to simply remove all segmentation markers and arrive at the correct call number... + $_ = $ddcn; + # ddcn example R220.3 H2793Z H32 c.2 + my @splits = m/^([A-Z]{0,3}) # R (OS, REF, etc. up do three letters) + ([0-9]+\.[0-9]*) # 220.3 + \s? # space (not requiring anything beyond the call number) + ([a-zA-Z0-9]*\.?[a-zA-Z0-9])# cutter number... maybe, but if so it is in this position (Z indicates literary criticism) + \s? # space if it exists + ([a-zA-Z]*\.?[0-9]*) # other indicators such as cutter for author of literary criticism in this example if it exists + \s? # space if ie exists + ([a-zA-Z]*\.?[0-9]*) # other indicators such as volume number, copy number, edition date, etc. if it exists + /x; + return @splits; +} + +sub _split_fcn { + my ($fcn) = @_; + my @fcn_split = (); + # Split fiction call numbers based on spaces + SPLIT_FCN: + while ($fcn) { + if ($fcn =~ m/([A-Za-z0-9]+\.?[0-9]?)(\W?).*?/x) { + push (@fcn_split, $1); + $fcn = $'; + } + else { + last SPLIT_FCN; # No match, break out of the loop + } + } + return @fcn_split; +} + +sub _get_fields { + my ( $layout_id, $sorttype ) = @_; + my @sorted_fields; + my $sortorder = get_layout($layout_id); + if ( !$sorttype ) { + return $sortorder->{'formatstring'}; + } + else { + my $csv = Text::CSV_XS->new( { allow_whitespace => 1 } ); + my $line = $sortorder->{'formatstring'}; + my $status = $csv->parse($line); + @sorted_fields = + map { { 'code' => $_, desc => $_ } } $csv->fields(); + if (my $error = $csv->error_input()) { + syslog("LOG_ERR", "C4::Labels::Label::_get_fields : Text::CSV_XS returned the following error: %s", $error); + } + } +} + +sub _get_item_fields { + my @fields = qw ( + barcode title + isbn issn + author itemtype + itemcallnumber + ); + return @fields; +} + +sub _get_barcode_data { + my ( $f, $item, $record ) = @_; + my $kohatables = _desc_koha_tables(); + my $datastring = ''; + my $match_kohatable = join( + '|', + ( + @{ $kohatables->{biblio} }, + @{ $kohatables->{biblioitems} }, + @{ $kohatables->{items} } + ) + ); + FIELD_LIST: + while ($f) { + my $err = ''; + $f =~ s/^\s?//; + if ( $f =~ /^'(.*)'.*/ ) { + # single quotes indicate a static text string. + $datastring .= $1; + $f = $'; + next FIELD_LIST; + } + elsif ( $f =~ /^($match_kohatable).*/ ) { + if ($item->{$f}) { + $datastring .= $item->{$f}; + } + else { + syslog("LOG_ERR", "C4::Labels::Label::_get_barcode_data : The '%s' field contains no data.", $f); + } + $f = $'; + next FIELD_LIST; + } + elsif ( $f =~ /^([0-9a-z]{3})(\w)(\W?).*?/ ) { + my ($field,$subf,$ws) = ($1,$2,$3); + my $subf_data; + my ($itemtag, $itemsubfieldcode) = &GetMarcFromKohaField("items.itemnumber",''); + my @marcfield = $record->field($field); + if(@marcfield) { + if($field eq $itemtag) { # item-level data, we need to get the right item. + ITEM_FIELDS: + foreach my $itemfield (@marcfield) { + if ( $itemfield->subfield($itemsubfieldcode) eq $item->{'itemnumber'} ) { + if ($itemfield->subfield($subf)) { + $datastring .= $itemfield->subfield($subf) . $ws; + } + else { + syslog("LOG_ERR", "C4::Labels::Label::_get_barcode_data : The '%s' field contains no data.", $f); + } + last ITEM_FIELDS; + } + } + } else { # bib-level data, we'll take the first matching tag/subfield. + if ($marcfield[0]->subfield($subf)) { + $datastring .= $marcfield[0]->subfield($subf) . $ws; + } + else { + syslog("LOG_ERR", "C4::Labels::Label::_get_barcode_data : The '%s' field contains no data.", $f); + } + } + } + $f = $'; + next FIELD_LIST; + } + else { + syslog("LOG_ERR", "C4::Labels::Label::_get_barcode_data : Failed to parse label format string: %s", $f); + last FIELD_LIST; # Failed to match + } + } + return $datastring; +} + +sub _desc_koha_tables { + my $dbh = C4::Context->dbh(); + my $kohatables; + for my $table ( 'biblio','biblioitems','items' ) { + my $sth = $dbh->column_info(undef,undef,$table,'%'); + while (my $info = $sth->fetchrow_hashref()){ + push @{$kohatables->{$table}} , $info->{'COLUMN_NAME'} ; + } + $sth->finish; + } + return $kohatables; +} + +sub new { + my ($invocant, %params) = @_; + my $type = ref($invocant) || $invocant; + my $layout = C4::Labels::Layout->retrieve(layout_id => $params{'layout_id'}); + my $self = { + batch_id => $params{'batch_id'}, + layout_id => $params{'layout_id'}, + item_number => $params{'item_number'}, + height => $params{'height'}, + width => $params{'width'}, + top_text_margin => $params{'top_text_margin'}, + left_text_margin => $params{'left_text_margin'}, + font => $params{'font'}, + font_size => $params{'font_size'}, + justify => $params{'justify'}, + text_wrap_cols => $params{'text_wrap_cols'}, + layout => $layout, + guidebox => '', + barcode => 0, + }; + if ($layout->get_attr('guidebox')) { + $self->{'guidebox'} = _guide_box($self->{'llx'}, $self->{'lly'}, $self->{'width'}, $self->{'height'}); + } + bless ($self, $type); + return $self; +} + +sub get_label_type { + my $self = shift; + return $self->{'layout'}->get_attr('printing_type'); +} + +=head2 $label->draw_label_text() + + Invoking the I method generates the label text for the label object. + example: + $label->draw_label_text( + llx => $text_llx, + lly => $text_lly, + top_text_margin => $label_top_text_margin, + line_spacer => $text_leading, + font => $text_font, + font_size => $text_font_size, + justify => $text_justification, + ); +=cut + +sub draw_label_text { + my ($self, %params) = @_; + my @label_text = (); + my $text_llx = 0; + my $text_lly = $params{'lly'}; + my $font = $self->{'font'}; + my $item = _get_label_item($self->{item_number}); + my $label_fields = _get_text_fields($self->{layout}->get_attr('format_string')); + my $record = GetMarcBiblio($item->{biblionumber}); + # FIXME - returns all items, so you can't get data from an embedded holdings field. + # TODO - add a GetMarcBiblio1item(bibnum,itemnum) or a GetMarcItem(itemnum). + my $cn_source = ($item->{'cn_source'} ? $item->{'cn_source'} : C4::Context->preference('DefaultClassificationSource')); + LABEL_FIELDS: # process data for requested fields on current label + for my $field (@$label_fields) { + if ($field->{'code'} eq 'itemtype') { + $field->{'data'} = C4::Context->preference('item-level_itypes') ? $item->{'itype'} : $item->{'itemtype'}; + } + else { + $field->{'data'} = _get_barcode_data($field->{'code'},$item,$record); + } + ($field->{'code'} eq 'title') ? (($font =~ /T/) ? ($font = 'TI') : ($font = ($font . 'O'))) : ($font = $font); + my $field_data = $field->{'data'}; + $field_data =~ s/\n//g; + $field_data =~ s/\r//g; + my @label_lines; + my @callnumber_list = ('itemcallnumber', '050a', '050b', '082a', '952o'); # Fields which hold call number data FIXME: ( 060? 090? 092? 099? ) + if ((grep {$field->{'code'} =~ m/$_/} @callnumber_list) and ($self->{layout}->get_attr('printing_type') eq 'BIB') and ($self->{layout}->get_attr('callnum_split'))) { # If the field contains the call number, we do some sp + if ($cn_source eq 'lcc') { + @label_lines = _split_lccn($field_data); + @label_lines = _split_fcn($field_data) if !@label_lines; # If it was not a true lccn, try it as a fiction call number + push (@label_lines, $field_data) if !@label_lines; # If it was not that, send it on unsplit + } elsif ($cn_source eq 'ddc') { + @label_lines = _split_ddcn($field_data); + @label_lines = _split_fcn($field_data) if !@label_lines; + push (@label_lines, $field_data) if !@label_lines; + } else { + 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); + push @label_lines, $field_data; + } + } + else { + $field_data =~ s/\/$//g; # Here we will strip out all trailing '/' in fields other than the call number... + $field_data =~ s/\(/\\\(/g; # Escape '(' and ')' for the pdf object stream... + $field_data =~ s/\)/\\\)/g; + eval{local($Text::Wrap::columns) = $self->{'text_wrap_cols'};}; + my @line = split(/\n/ ,wrap('', '', $field_data)); + # If this is a title field, limit to two lines; all others limit to one... FIXME: this is rather arbitrary + if ($field->{'code'} eq 'title' && scalar(@line) >= 2) { + while (scalar(@line) > 2) { + pop @line; + } + } else { + while (scalar(@line) > 1) { + pop @line; + } + } + push(@label_lines, @line); + } + LABEL_LINES: # generate lines of label text for current field + foreach my $line (@label_lines) { + next LABEL_LINES if $line eq ''; + my $string_width = C4::Labels::PDF->StrWidth($line, $font, $self->{'font_size'}); + if ($self->{'justify'} eq 'R') { + $text_llx = $params{'llx'} + $self->{'width'} - ($self->{'left_text_margin'} + $string_width); + } elsif($self->{'justify'} eq 'C') { + # some code to try and center each line on the label based on font size and string point width... + my $whitespace = ($self->{'width'} - ($string_width + (2 * $self->{'left_text_margin'}))); + $text_llx = (($whitespace / 2) + $params{'llx'} + $self->{'left_text_margin'}); + } else { + $text_llx = ($params{'llx'} + $self->{'left_text_margin'}); + } + push @label_text, { + text_llx => $text_llx, + text_lly => $text_lly, + font => $font, + font_size => $self->{'font_size'}, + line => $line, + }; + $text_lly = $text_lly - $params{'line_spacer'}; + } + $font = $self->{'font'}; # reset font for next field + } #foreach field + return \@label_text; +} + +=head2 $label->barcode() + + Invoking the I method generates a barcode for the label object and inserts it into the current pdf stream. C is optional + and omitting it will cause the barcode from the current item to be used. C is also optional. Omission results in the barcode + type of the current template being used. + + example: + $label->barcode( + llx => $barcode_llx, + lly => $barcode_lly, + width => $barcode_width, + y_scale_factor => $barcode_y_scale_factor, + barcode_data => $barcode, + barcode_type => $barcodetype, + ); +=cut + +sub barcode { + my $self = shift; + my %params = @_; + $params{'barcode'} = _get_label_item($self->{'item_number'}, 1) if !$params{'barcode'}; + $params{'barcode_type'} = $self->{'layout'}->get_attr('barcode_type') if !$params{'barcode_type'}; + my $x_scale_factor = 1; + my $num_of_bars = length($params{'barcode'}); + my $tot_bar_length = 0; + my $bar_length = 0; + my $guard_length = 10; + my $hide_text = 'yes'; + if ($params{'barcode_type'} =~ m/CODE39/) { + $bar_length = '17.5'; + $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2); + $x_scale_factor = ($params{'width'} / $tot_bar_length); + if ($params{'barcode_type'} eq 'CODE39MOD') { + my $c39 = CheckDigits('visa'); # get modulo43 checksum + $params{'barcode'} = $c39->complete($params{'barcode'}); + } + elsif ($params{'barcode_type'} eq 'CODE39MOD10') { + my $c39_10 = CheckDigits('visa'); # get modulo43 checksum + $params{'barcode'} = $c39_10->complete($params{'barcode'}); + $hide_text = ''; + } + eval { + PDF::Reuse::Barcode::Code39( + x => $params{'llx'}, + y => $params{'lly'}, + value => "*$params{barcode}*", + xSize => $x_scale_factor, + ySize => $params{'y_scale_factor'}, + hide_asterisk => 1, + text => $hide_text, + mode => 'graphic', + ); + }; + if ($@) { + syslog("LOG_ERR", "Barcode generation failed for item %s with this error: %s", $self->{'item_number'}, $@); + } + } + elsif ($params{'barcode_type'} eq 'COOP2OF5') { + $bar_length = '9.43333333333333'; + $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2); + $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9; + eval { + PDF::Reuse::Barcode::COOP2of5( + x => $params{'llx'}, + y => $params{'lly'}, + value => "*$params{barcode}*", + xSize => $x_scale_factor, + ySize => $params{'y_scale_factor'}, + mode => 'graphic', + ); + }; + if ($@) { + syslog("LOG_ERR", "Barcode generation failed for item %s with this error: %s", $self->{'item_number'}, $@); + } + } + elsif ( $params{'barcode_type'} eq 'INDUSTRIAL2OF5' ) { + $bar_length = '13.1333333333333'; + $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2); + $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9; + eval { + PDF::Reuse::Barcode::Industrial2of5( + x => $params{'llx'}, + y => $params{'lly'}, + value => "*$params{barcode}*", + xSize => $x_scale_factor, + ySize => $params{'y_scale_factor'}, + mode => 'graphic', + ); + }; + if ($@) { + syslog("LOG_ERR", "Barcode generation failed for item %s with this error: %s", $self->{'item_number'}, $@); + } + } +} + +1; +__END__ + +=head1 AUTHOR + +Mason James +Chris Nighswonger + +=cut + -- 2.39.5