Merge remote-tracking branch 'origin/new/bug_5533'
[koha.git] / C4 / Labels / Label.pm
index 9cf5026..0aec0a6 100644 (file)
@@ -6,6 +6,7 @@ use warnings;
 use Text::Wrap;
 use Algorithm::CheckDigits;
 use Text::CSV_XS;
+use Data::Dumper;
 
 use C4::Context;
 use C4::Debug;
@@ -89,7 +90,7 @@ sub _get_label_item {
     if ($sth1->err) {
         warn sprintf('Database returned the following error: %s', $sth1->errstr);
     }
-    my $data1 = $sth->fetchrow_hashref;
+    my $data1 = $sth1->fetchrow_hashref;
     $data->{'itemtype'} = $data1->{'description'};
     $data->{'itype'} = $data1->{'description'};
     $barcode_only ? return $data->{'barcode'} : return $data;
@@ -99,7 +100,9 @@ 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 @sorted_fields = map {{ 'code' => $_, desc => $_ }} 
+                        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;
@@ -107,7 +110,7 @@ sub _get_text_fields {
 
 
 sub _split_lccn {
-    my ($lccn) = @_;    
+    my ($lccn) = @_;
     $_ = $lccn;
     # lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996';
     my (@parts) = m/
@@ -133,9 +136,9 @@ sub _split_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-]+(?:$possible_decimal)?) # R220.3            # BIO   # first example will require extra splitting
+        ^([-a-zA-Z]*\s?(?:$possible_decimal)?) # R220.3  CD-ROM 787.87 # will require extra splitting
         \s+
-        (.+)                               # H2793Z H32 c.2   # R5c.1   # everything else (except bracketing spaces)
+        (.+)                               # H2793Z H32 c.2 EAS # everything else (except bracketing spaces)
         \s*
         /x;
     unless (scalar @parts)  {
@@ -143,41 +146,34 @@ sub _split_ddcn {
         push @parts, $_;     # if no match, just push the whole string.
     }
 
-    if ($parts[ 0] =~ /^([a-zA-Z]+)($possible_decimal)$/) {
+    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
-
-    if ($parts[-1] !~ /^.*\d-\d.*$/ && $parts[-1] =~ /^(.*\d+)(\D.*)$/) {
-         pop @parts;            # pull off the mathching last element, like example 2
-        push @parts, $1, $2;    # replace it with the two pieces
-    }
-
     $debug and print STDERR "split_ddcn array: ", join(" | ", @parts), "\n";
     return @parts;
 }
 
-sub _split_fcn {
+## 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 @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
-        }
+    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 @fcn_split) {
+    unless (scalar @parts) {
         warn sprintf('regexp failed to match string: %s', $_);
-        push (@fcn_split, $_);
+        push (@parts, $_);
     }
-    return @fcn_split;
+    $debug and print STDERR "split_ccn array: ", join(" | ", @parts), "\n";
+    return @parts;
 }
 
 sub _get_barcode_data {
@@ -193,7 +189,7 @@ sub _get_barcode_data {
         )
     );
     FIELD_LIST:
-    while ($f) {  
+    while ($f) {
         my $err = '';
         $f =~ s/^\s?//;
         if ( $f =~ /^'(.*)'.*/ ) {
@@ -277,34 +273,35 @@ sub _BIB {
 
 sub _BAR {
     my $self = shift;
-    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)
+    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)
     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)
     my $barcode_width = 0.8 * $self->{'width'};                         # this scales the barcode width to 80% of the label width
     my $barcode_y_scale_factor = 0.01 * $self->{'height'};              # this scales the barcode height to 10% of the label height
     return 0, 0, 0, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
-}   
-            
-sub _BIBBAR { 
+}
+
+sub _BIBBAR {
     my $self = shift;
-    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'})
+    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'})
     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)
     my $barcode_width = 0.8 * $self->{'width'};                         # this scales the barcode width to 80% of the label width
     my $barcode_y_scale_factor = 0.01 * $self->{'height'};              # this scales the barcode height to 10% of the label height
     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.).
     my $text_lly = ($self->{'lly'} + ($self->{'height'} - $self->{'top_text_margin'}));
+    $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";
     return $self->{'llx'}, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
 }
 
 sub _BARBIB {
     my $self = shift;
-    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'})
+    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'})
     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'})
     my $barcode_width = 0.8 * $self->{'width'};                                                 # this scales the barcode width to 80% of the label width
     my $barcode_y_scale_factor = 0.01 * $self->{'height'};                                      # this scales the barcode height to 10% of the label height
     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.).
     my $text_lly = (($self->{'lly'} + $self->{'height'}) - $self->{'top_text_margin'} - (($self->{'lly'} + $self->{'height'}) - $barcode_lly));
     return $self->{'llx'}, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
-}   
+}
 
 sub new {
     my ($invocant, %params) = @_;
@@ -410,18 +407,19 @@ sub draw_label_text {
             $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? )
+        # 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') {
+            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_fcn($field_data) if !@label_lines;    # If it was not a true lccn, try it as a fiction call number
+                @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_fcn($field_data) if !@label_lines;
+                @label_lines = _split_ccn($field_data) if !@label_lines;
                 push (@label_lines, $field_data) if !@label_lines;
             } else {
-                warn sprintf('Call number splitting failed for: %s. Please add this call number to bug #2500 at bugs.koha.org', $field_data);
+                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;
             }
         }
@@ -448,15 +446,15 @@ 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 '';
-            my $string_width = C4::Labels::PDF->StrWidth($line, $font, $self->{'font_size'});
-            if ($self->{'justify'} eq 'R') { 
+            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);
-            } 
+            }
             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'});
             }
@@ -474,6 +472,10 @@ sub draw_label_text {
     return \@label_text;
 }
 
+sub draw_guide_box {
+    return $_[0]->{'guidebox'};
+}
+
 sub barcode {
     my $self = shift;
     my %params = @_;
@@ -490,11 +492,11 @@ sub barcode {
         $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
+            my $c39 = CheckDigits('code_39');   # get modulo43 checksum
             $params{'barcode_data'} = $c39->complete($params{'barcode_data'});
         }
         elsif ($params{'barcode_type'} eq 'CODE39MOD10') {
-            my $c39_10 = CheckDigits('visa');   # get modulo43 checksum
+            my $c39_10 = CheckDigits('siret');   # get modulo43 checksum
             $params{'barcode_data'} = $c39_10->complete($params{'barcode_data'});
             $hide_text = '';
         }
@@ -783,12 +785,12 @@ Copyright 2009 Foundations Bible College.
 =head1 LICENSE
 
 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.
 
-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
+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.
 
 =head1 DISCLAIMER OF WARRANTY