Final patch for serials planning bugs

[koha_fer] / C4 / Labels.pm

diff --git a/C4/Labels.pm b/C4/Labels.pm
index 8f7197b..82d4c6b 100644 (file)
--- a/C4/Labels.pm
+++ b/C4/Labels.pm
@@ -21,7 +21,7 @@ use strict;
 use vars qw($VERSION @ISA @EXPORT);
 
 use PDF::Reuse;
-#use Text::Wrap;
+use Text::Wrap;
 use Algorithm::CheckDigits;
 use C4::Members;
 use C4::Branch;
@@ -296,25 +296,23 @@ sub get_text_fields {
  else, return the next available batch_id.
 =return
 =cut
-sub add_batch {
-    my ( $batch_type,$batch_list ) = @_;
-    my $new_batch;
+sub add_batch ($;$) {
+       my $table = (@_ and 'patroncards' eq shift) ? 'patroncards' : 'labels';
+    my $batch_list = (@_) ? shift : undef;
     my $dbh = C4::Context->dbh;
-    my $q ="SELECT MAX(DISTINCT batch_id) FROM $batch_type";
+    my $q ="SELECT MAX(DISTINCT batch_id) FROM $table";
     my $sth = $dbh->prepare($q);
     $sth->execute();
-    my ($batch_id) = $sth->fetchrow_array;
-    $sth->finish;
-       if($batch_id) {
-               $batch_id++;
-       } else {
-               $batch_id = 1;
-       }
-       # TODO: let this block use $batch_type
-       if(ref($batch_list) && ($batch_type eq 'labels') ) {
-               my $sth = $dbh->prepare("INSERT INTO labels (`batch_id`,`itemnumber`) VALUES (?,?)"); 
-               for my $item (@$batch_list) {
-                       $sth->execute($batch_id,$item);
+    my ($batch_id) = $sth->fetchrow_array || 0;
+       $batch_id++;
+       if ($batch_list) {
+               if ($table eq 'patroncards') {
+                       $sth = $dbh->prepare("INSERT INTO $table (`batch_id`,`borrowernumber`) VALUES (?,?)"); 
+               } else {
+                       $sth = $dbh->prepare("INSERT INTO $table (`batch_id`,`itemnumber`    ) VALUES (?,?)"); 
+               }
+               for (@$batch_list) {
+                       $sth->execute($batch_id,$_);
                }
        }
        return $batch_id;
@@ -323,31 +321,19 @@ sub add_batch {
 #FIXME: Needs to be ported to receive $batch_type
 # ... this looks eerily like add_batch() ...
 sub get_highest_batch {
-    my $new_batch;
-    my $dbh = C4::Context->dbh;
+       my $table = (@_ and 'patroncards' eq shift) ? 'patroncards' : 'labels';
     my $q =
-      "select distinct batch_id from labels order by batch_id desc limit 1";
-    my $sth = $dbh->prepare($q);
+      "select distinct batch_id from $table order by batch_id desc limit 1";
+    my $sth = C4::Context->dbh->prepare($q);
     $sth->execute();
-    my $data = $sth->fetchrow_hashref;
-    $sth->finish;
-
-    if ( !$data->{'batch_id'} ) {
-        $new_batch = 1;
-    }
-    else {
-        $new_batch =  $data->{'batch_id'};
-    }
-
-    return $new_batch;
+    my $data = $sth->fetchrow_hashref or return 1;
+       return ($data->{'batch_id'} || 1);
 }
 
 
-sub get_batches {
-       # my $q   = "SELECT batch_id, COUNT(*) AS num FROM " . shift . " GROUP BY batch_id";
-    # FIXEDME:  There is only ONE table with batch_id, so why try to select a different one?
-       # get_batches() was frequently being called w/ no args, crashing DBD
-    my $q   = "SELECT batch_id, COUNT(*) AS num FROM labels GROUP BY batch_id";
+sub get_batches (;$) {
+       my $table = (@_ and 'patroncards' eq shift) ? 'patroncards' : 'labels';
+    my $q   = "SELECT batch_id, COUNT(*) AS num FROM $table GROUP BY batch_id";
     my $sth = C4::Context->dbh->prepare($q);
     $sth->execute();
        my $batches = $sth->fetchall_arrayref({});
@@ -1013,14 +999,23 @@ sub DrawSpineText {
                     push @strings, $str;    # if $nowrap == 1 do not wrap or remove segmentation markers...
                 }
             } else {
-                $str =~ s/\/$//g;    # Here we will strip out all trailing '/' in fields other than the call number...
-                if ( length($str) > $text_wrap_cols ) {    # wrap lines greater than $text_wrap_cols width...
-                    my $wrap = substr($str, ($text_wrap_cols - length($str)), $text_wrap_cols, "");
-                    push @strings, $str;
-                    push @strings, $wrap;
+                $str =~ s/\/$//g;       # Here we will strip out all trailing '/' in fields other than the call number...
+                $str =~ s/\(/\\\(/g;    # Escape '(' and ')' for the postscript stream...
+                $str =~ s/\)/\\\)/g;
+                # Wrap text lines exceeding $text_wrap_cols length...
+                $Text::Wrap::columns = $text_wrap_cols;
+                my @line = split(/\n/ ,wrap('', '', $str));
+                # If this is a title field, limit to two lines; all others limit to one...
+                if ($field->{code} eq 'title' && scalar(@line) >= 2) {
+                    while (scalar(@line) > 2) {
+                        pop @line;
+                    }
                 } else {
-                    push @strings, $str;
+                    while (scalar(@line) > 1) {
+                        pop @line;
+                    }
                 }
+                push(@strings, @line);
             }
             # loop for each string line
             foreach my $str (@strings) {