X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FLabels%2FLabel.pm;h=0a1d0a0e5336686451446891c7d447ac652bc3cf;hb=7d8b96803f664d86762a6afb966051f7d565c40e;hp=7b1fafd6f43bf569b6022f76fa48af96277b2b75;hpb=068e5be6395088793aeab66d67c36c2b9da2c5d9;p=srvgit diff --git a/C4/Labels/Label.pm b/C4/Labels/Label.pm index 7b1fafd6f4..0a1d0a0e53 100644 --- a/C4/Labels/Label.pm +++ b/C4/Labels/Label.pm @@ -7,16 +7,18 @@ use Text::Wrap; use Algorithm::CheckDigits; use Text::CSV_XS; use Data::Dumper; +use Text::Bidi qw( log2vis ); use C4::Context; use C4::Debug; use C4::Biblio; - -BEGIN { - use version; our $VERSION = qv('3.07.00.049'); -} - -my $possible_decimal = qr/\d{3,}(?:\.\d+)?/; # at least three digits for a DDCN +use Koha::ClassSources; +use Koha::ClassSortRules; +use Koha::ClassSplitRules; +use C4::ClassSplitRoutine::Dewey; +use C4::ClassSplitRoutine::LCC; +use C4::ClassSplitRoutine::Generic; +use C4::ClassSplitRoutine::RegEx; sub _check_params { my $given_params = {}; @@ -33,6 +35,7 @@ sub _check_params { 'barcode_type', 'printing_type', 'guidebox', + 'oblique_title', 'font', 'font_size', 'callnum_split', @@ -61,6 +64,8 @@ sub _check_params { sub _guide_box { my ( $llx, $lly, $width, $height ) = @_; + return unless ( defined $llx and defined $lly and + defined $width and defined $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 @@ -93,6 +98,17 @@ sub _get_label_item { my $data1 = $sth1->fetchrow_hashref; $data->{'itemtype'} = $data1->{'description'}; $data->{'itype'} = $data1->{'description'}; + # add *_description fields + if ($data->{'homebranch'} || $data->{'holdingbranch'}){ + require Koha::Libraries; + # FIXME Is this used?? + $data->{'homebranch_description'} = Koha::Libraries->find($data->{'homebranch'})->branchname if $data->{'homebranch'}; + $data->{'holdingbranch_description'} = Koha::Libraries->find($data->{'holdingbranch'})->branchname if $data->{'holdingbranch'}; + } + $data->{'ccode_description'} = C4::Biblio::GetAuthorisedValueDesc('','', $data->{'ccode'} ,'','','CCODE', 1) if $data->{'ccode'}; + $data->{'location_description'} = C4::Biblio::GetAuthorisedValueDesc('','', $data->{'location'} ,'','','LOC', 1) if $data->{'location'}; + $data->{'permanent_location_description'} = C4::Biblio::GetAuthorisedValueDesc('','', $data->{'permanent_location'} ,'','','LOC', 1) if $data->{'permanent_location'}; + $barcode_only ? return $data->{'barcode'} : return $data; } @@ -101,81 +117,13 @@ sub _get_text_fields { my $csv = Text::CSV_XS->new({allow_whitespace => 1}); my $status = $csv->parse($format_string); my @sorted_fields = map {{ 'code' => $_, desc => $_ }} - map { $_ eq 'callnumber' ? 'itemcallnumber' : $_ } # see bug 5653 + map { $_ && $_ eq 'callnumber' ? 'itemcallnumber' : $_ } # see bug 5653 $csv->fields(); my $error = $csv->error_input(); warn sprintf('Text field sort failed with this error: %s', $error) if $error; return \@sorted_fields; } - -sub _split_lccn { - my ($lccn) = @_; - $_ = $lccn; - # lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996'; - my (@parts) = m/ - ^([a-zA-Z]+) # HE # BS - (\d+(?:\.\d)*) # 8700.7 # 2545 - \s* - (\.*\D+\d*) # .P6 # .E8 - \s* - (.*) # T44 1983 # H39 1996 # everything else (except any bracketing spaces) - \s* - /x; - unless (scalar @parts) { - warn sprintf('regexp failed to match string: %s', $_); - push @parts, $_; # if no match, just push the whole string. - } - push @parts, split /\s+/, pop @parts; # split the last piece into an arbitrary number of pieces at spaces - $debug and warn "split_lccn array: ", join(" | ", @parts), "\n"; - return @parts; -} - -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... - my (@parts) = m/ - ^([-a-zA-Z]*\s?(?:$possible_decimal)?) # R220.3 CD-ROM 787.87 # will require extra splitting - \s+ - (.+) # H2793Z H32 c.2 EAS # everything else (except bracketing spaces) - \s* - /x; - unless (scalar @parts) { - warn sprintf('regexp failed to match string: %s', $_); - push @parts, $_; # if no match, just push the whole string. - } - - if ($parts[0] =~ /^([-a-zA-Z]+)\s?($possible_decimal)$/) { - shift @parts; # pull off the mathching first element, like example 1 - unshift @parts, $1, $2; # replace it with the two pieces - } - - push @parts, split /\s+/, pop @parts; # split the last piece into an arbitrary number of pieces at spaces - $debug and print STDERR "split_ddcn array: ", join(" | ", @parts), "\n"; - return @parts; -} - -## NOTE: Custom call number types go here. It may be necessary to create additional splitting algorithms if some custom call numbers -## cannot be made to work here. Presently this splits standard non-ddcn, non-lccn fiction and biography call numbers. - -sub _split_ccn { - my ($fcn) = @_; - my @parts = (); - # Split call numbers based on spaces - push @parts, split /\s+/, $fcn; # split the call number into an arbitrary number of pieces at spaces - if ($parts[-1] !~ /^.*\d-\d.*$/ && $parts[-1] =~ /^(.*\d+)(\D.*)$/) { - pop @parts; # pull off the matching last element - push @parts, $1, $2; # replace it with the two pieces - } - unless (scalar @parts) { - warn sprintf('regexp failed to match string: %s', $_); - push (@parts, $_); - } - $debug and print STDERR "split_ccn array: ", join(" | ", @parts), "\n"; - return @parts; -} - sub _get_barcode_data { my ( $f, $item, $record ) = @_; my $kohatables = _desc_koha_tables(); @@ -211,7 +159,7 @@ sub _get_barcode_data { 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 ($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. @@ -319,13 +267,14 @@ sub new { barcode_type => $params{'barcode_type'}, printing_type => $params{'printing_type'}, guidebox => $params{'guidebox'}, + oblique_title => $params{'oblique_title'}, font => $params{'font'}, font_size => $params{'font_size'}, callnum_split => $params{'callnum_split'}, justify => $params{'justify'}, format_string => $params{'format_string'}, text_wrap_cols => $params{'text_wrap_cols'}, - barcode => 0, + barcode => $params{'barcode'}, }; if ($self->{'guidebox'}) { $self->{'guidebox'} = _guide_box($self->{'llx'}, $self->{'lly'}, $self->{'width'}, $self->{'height'}); @@ -389,10 +338,18 @@ sub draw_label_text { my $font = $self->{'font'}; my $item = _get_label_item($self->{'item_number'}); my $label_fields = _get_text_fields($self->{'format_string'}); - my $record = GetMarcBiblio($item->{'biblionumber'}); + my $record = GetMarcBiblio({ biblionumber => $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')); + my $class_source = Koha::ClassSources->find( $cn_source ); + my ( $split_routine, $regexs ); + if ($class_source) { + my $class_split_rule = Koha::ClassSplitRules->find( $class_source->class_split_rule ); + $split_routine = $class_split_rule->split_routine; + $regexs = $class_split_rule->regexs; + } + else { $split_routine = $cn_source } LABEL_FIELDS: # process data for requested fields on current label for my $field (@$label_fields) { if ($field->{'code'} eq 'itemtype') { @@ -401,7 +358,18 @@ sub draw_label_text { else { $field->{'data'} = _get_barcode_data($field->{'code'},$item,$record); } - ($field->{'code'} eq 'title') ? (($font =~ /T/) ? ($font = 'TI') : ($font = ($font . 'O'))) : ($font = $font); + # Find appropriate font it oblique title selected, except main font is oblique + if ( ( $field->{'code'} eq 'title' ) and ( $self->{'oblique_title'} == 1 ) ) { + if ( $font =~ /^TB$/ ) { + $font .= 'I'; + } + elsif ( $font =~ /^TR$/ ) { + $font = 'TI'; + } + elsif ( $font !~ /^T/ and $font !~ /O$/ ) { + $font .= 'O'; + } + } my $field_data = $field->{'data'}; if ($field_data) { $field_data =~ s/\n//g; @@ -411,14 +379,18 @@ sub draw_label_text { # Fields which hold call number data FIXME: ( 060? 090? 092? 099? ) my @callnumber_list = qw(itemcallnumber 050a 050b 082a 952o 995k); 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 - if ($cn_source eq 'lcc' || $cn_source eq 'nlm') { # NLM and LCC should be split the same way - @label_lines = _split_lccn($field_data); - @label_lines = _split_ccn($field_data) if !@label_lines; # If it was not a true lccn, try it as a custom 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_ccn($field_data) if !@label_lines; - push (@label_lines, $field_data) if !@label_lines; + if ($split_routine eq 'LCC' || $split_routine eq 'nlm') { # NLM and LCC should be split the same way + @label_lines = C4::ClassSplitRoutine::LCC::split_callnumber($field_data); + @label_lines = C4::ClassSplitRoutine::Generic::split_callnumber($field_data) unless @label_lines; # If it was not a true lccn, try it as a custom call number + push (@label_lines, $field_data) unless @label_lines; # If it was not that, send it on unsplit + } elsif ($split_routine eq 'Dewey') { + @label_lines = C4::ClassSplitRoutine::Dewey::split_callnumber($field_data); + @label_lines = C4::ClassSplitRoutine::Generic::split_callnumber($field_data) unless @label_lines; + push (@label_lines, $field_data) unless @label_lines; + } elsif ($split_routine eq 'RegEx' ) { + @label_lines = C4::ClassSplitRoutine::RegEx::split_callnumber($field_data, $regexs); + @label_lines = C4::ClassSplitRoutine::Generic::split_callnumber($field_data) unless @label_lines; + push (@label_lines, $field_data) unless @label_lines; } else { warn sprintf('Call number splitting failed for: %s. Please add this call number to bug #2500 at bugs.koha-community.org', $field_data); push @label_lines, $field_data; @@ -427,8 +399,9 @@ sub draw_label_text { else { if ($field_data) { $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; + # Escaping the parens was causing odd output, see bug 13124 + # $field_data =~ s/\(/\\\(/g; # Escape '(' and ')' for the pdf object stream... + # $field_data =~ s/\)/\\\)/g; } eval{$Text::Wrap::columns = $self->{'text_wrap_cols'};}; my @line = split(/\n/ ,wrap('', '', $field_data)); @@ -447,6 +420,7 @@ sub draw_label_text { LABEL_LINES: # generate lines of label text for current field foreach my $line (@label_lines) { next LABEL_LINES if $line eq ''; + $line = log2vis( $line ); my $string_width = C4::Creators::PDF->StrWidth($line, $font, $self->{'font_size'}); if ($self->{'justify'} eq 'R') { $text_llx = $params{'llx'} + $self->{'width'} - ($self->{'left_text_margin'} + $string_width); @@ -480,7 +454,7 @@ sub draw_guide_box { sub barcode { my $self = shift; my %params = @_; - $params{'barcode_data'} = _get_label_item($self->{'item_number'}, 1) if !$params{'barcode_data'}; + $params{'barcode_data'} = ($self->{'barcode'} || _get_label_item($self->{'item_number'}, 1)) if !$params{'barcode_data'}; $params{'barcode_type'} = $self->{'barcode_type'} if !$params{'barcode_type'}; my $x_scale_factor = 1; my $num_of_bars = length($params{'barcode_data'}); @@ -525,7 +499,7 @@ sub barcode { PDF::Reuse::Barcode::COOP2of5( x => $params{'llx'}, y => $params{'lly'}, - value => "*$params{barcode_data}*", + value => $params{barcode_data}, xSize => $x_scale_factor, ySize => $params{'y_scale_factor'}, mode => 'graphic', @@ -543,7 +517,7 @@ sub barcode { PDF::Reuse::Barcode::Industrial2of5( x => $params{'llx'}, y => $params{'lly'}, - value => "*$params{barcode_data}*", + value => $params{barcode_data}, xSize => $x_scale_factor, ySize => $params{'y_scale_factor'}, mode => 'graphic', @@ -553,13 +527,35 @@ sub barcode { warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@); } } + elsif ($params{'barcode_type'} eq 'EAN13') { + $bar_length = 4; # FIXME + $num_of_bars = 13; + $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::EAN13( + x => $params{'llx'}, + y => $params{'lly'}, + value => sprintf('%013d',$params{barcode_data}), +# xSize => $x_scale_factor, +# ySize => $params{'y_scale_factor'}, + mode => 'graphic', + ); + }; + if ($@) { + warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@); + } + } + else { + warn "unknown barcode_type: $params{barcode_type}"; + } } sub csv_data { my $self = shift; my $label_fields = _get_text_fields($self->{'format_string'}); my $item = _get_label_item($self->{'item_number'}); - my $bib_record = GetMarcBiblio($item->{biblionumber}); + my $bib_record = GetMarcBiblio({ biblionumber => $item->{biblionumber} }); my @csv_data = (map { _get_barcode_data($_->{'code'},$item,$bib_record) } @$label_fields); return \@csv_data; } @@ -603,11 +599,14 @@ This module provides methods for creating, and otherwise manipulating single lab CODE39MOD10 = Code 3 of 9 with modulo 10 checksum =item . - COOP2OF5 = A varient of 2 of 5 barcode based on NEC's "Process 8000" code + COOP2OF5 = A variant of 2 of 5 barcode based on NEC's "Process 8000" code =item . INDUSTRIAL2OF5 = The standard 2 of 5 barcode (a binary level bar code developed by Identicon Corp. and Computer Identics Corp. in 1970) +=item . + EAN13 = The standard EAN-13 barcode + =back C Defines the general layout to be used on labels. NOTE: At present there are only five printing types supported in the label creator code: @@ -787,11 +786,18 @@ 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 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 3 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., 51 Franklin Street, -Fifth Floor, Boston, MA 02110-1301 USA. +You should have received a copy of the GNU General Public License +along with Koha; if not, see . =head1 DISCLAIMER OF WARRANTY