Correcting text wrapping on labels
[koha-ffzg.git] / C4 / Labels.pm
index dfd0126..3387a11 100644 (file)
@@ -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;
@@ -82,13 +82,10 @@ Return a pointer on a hash list containing info from labels_conf table in Koha D
 
 #'
 sub get_label_options {
-    my $dbh    = C4::Context->dbh;
-    my $query2 = " SELECT * FROM labels_conf where active = 1";
-    my $sth    = $dbh->prepare($query2);
+    my $query2 = " SELECT * FROM labels_conf where active = 1";                # FIXME: exact same as get_active_layout
+    my $sth    = C4::Context->dbh->prepare($query2);
     $sth->execute();
-    my $conf_data = $sth->fetchrow_hashref;
-    $sth->finish;
-    return $conf_data;
+    return $sth->fetchrow_hashref;
 }
 
 sub get_layouts {
@@ -126,16 +123,10 @@ sub get_layout {
 }
 
 sub get_active_layout {
-    my ($layout_id) = @_;
-    my $dbh = C4::Context->dbh;
-
-    # get the actual items to be printed.
-    my $query = " Select * from labels_conf where active = 1";
-    my $sth   = $dbh->prepare($query);
+    my $query = " Select * from labels_conf where active = 1";         # FIXME: exact same as get_label_options
+    my $sth   = C4::Context->dbh->prepare($query);
     $sth->execute();
-    my $data = $sth->fetchrow_hashref;
-    $sth->finish;
-    return $data;
+    return $sth->fetchrow_hashref;
 }
 
 sub delete_layout {
@@ -305,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;
@@ -332,45 +321,23 @@ 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 ( $batch_type ) = @_;
-    my $dbh = C4::Context->dbh;
-    my $q   = "SELECT batch_id, COUNT(*) AS num FROM $batch_type GROUP BY batch_id";
-    my $sth = $dbh->prepare($q);
+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 @resultsloop;
-    while ( my $data = $sth->fetchrow_hashref ) {
-        push( @resultsloop, $data );
-    }
-    $sth->finish;
-
-# Not sure why we are doing this rather than simply telling the user that no batches are currently defined.
-# So I'm commenting this out and modifying label-manager.tmpl to properly inform the user as stated. -fbcit
-    # adding a dummy batch=1 value , if none exists in the db
-#    if ( !scalar(@resultsloop) ) {
-#        push( @resultsloop, { batch_id => '1' , num => '0' } );
-#    }
-    return @resultsloop;
+       my $batches = $sth->fetchall_arrayref({});
+       return @$batches;
 }
 
 sub delete_batch {
@@ -497,7 +464,7 @@ sub SaveTemplate {
         $leftmargin,  $cols,        $rows,         $colgap,
         $rowgap,      $font,        $fontsize,     $units
     ) = @_;
-    warn "Passed \$font:$font";
+    $debug and warn "Passed \$font:$font";
     my $dbh = C4::Context->dbh;
     my $query =
       " UPDATE labels_templates SET tmpl_code=?, tmpl_desc=?, page_width=?,
@@ -1000,11 +967,11 @@ sub DrawSpineText {
     my $old_fontname = $fontname; # We need to keep track of the original font passed in...
     
     for my $field (@str_fields) {
-               
+               $field->{'code'} or warn "get_text_fields($layout_id, 'codes') element missing 'code' field";
                if ($$conf_data->{'formatstring'}) {
                        $field->{'data'} =  GetBarcodeData($field->{'code'},$$item,$record) ;
                } else {
-                       $field->{data} =   $$item{$field->{'code'}}  ;
+                       $field->{data} =   $$item->{$field->{'code'}}  ;
                }
 
         # This allows us to print the title in italic (oblique) type... (Times Roman has a different nomenclature.)
@@ -1033,13 +1000,11 @@ sub DrawSpineText {
                 }
             } 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;
-                } else {
-                    push @strings, $str;
-                }
+                # Wrap text lines exceeding $text_wrap_cols length, truncating all text beyond the second line...
+                $Text::Wrap::columns = $text_wrap_cols;
+                my @title = split(/\n/ ,wrap('', '', $str));
+                pop @title if scalar(@title) > 2;
+                push(@strings, @title);
             }
             # loop for each string line
             foreach my $str (@strings) {
@@ -1080,7 +1045,7 @@ sub DrawPatronCardText {
     my $hPos;
 
     foreach my $line (keys %$text) {
-        warn "Current text is \"$line\" and font size for \"$line\" is $text->{$line} points";
+        $debug and warn "Current text is \"$line\" and font size for \"$line\" is $text->{$line} points";
         # some code to try and center each line on the label based on font size and string point width...
         my $stringwidth = prStrWidth($line, $fontname, $text->{$line});
         my $whitespace = ( $label_width - ( $stringwidth + (2 * $left_text_margin) ) );