Correcting text wrapping on labels
[koha-ffzg.git] / C4 / Labels.pm
index 1a1e805..3387a11 100644 (file)
@@ -23,7 +23,12 @@ use vars qw($VERSION @ISA @EXPORT);
 use PDF::Reuse;
 use Text::Wrap;
 use Algorithm::CheckDigits;
-# use Data::Dumper;
+use C4::Members;
+use C4::Branch;
+use C4::Debug;
+use C4::Biblio;
+use Text::CSV_XS;
+use Data::Dumper;
 # use Smart::Comments;
 
 BEGIN {
@@ -31,15 +36,15 @@ BEGIN {
        require Exporter;
        @ISA    = qw(Exporter);
        @EXPORT = qw(
-               &get_label_options &get_label_items
+               &get_label_options &GetLabelItems
                &build_circ_barcode &draw_boundaries
                &drawbox &GetActiveLabelTemplate
                &GetAllLabelTemplates &DeleteTemplate
                &GetSingleLabelTemplate &SaveTemplate
                &CreateTemplate &SetActiveTemplate
                &SaveConf &DrawSpineText &GetTextWrapCols
-               &GetUnitsValue &DrawBarcode
-               &get_printingtypes
+               &GetUnitsValue &DrawBarcode &DrawPatronCardText
+               &get_printingtypes &GetPatronCardItems
                &get_layouts
                &get_barcode_types
                &get_batches &delete_batch
@@ -47,7 +52,7 @@ BEGIN {
                &GetItemFields
                &get_text_fields
                get_layout &save_layout &add_layout
-               &set_active_layout &by_order
+               &set_active_layout
                &build_text_dropbox
                &delete_layout &get_active_layout
                &get_highest_batch
@@ -58,7 +63,6 @@ BEGIN {
        );
 }
 
-my $DEBUG = 0;
 
 =head1 NAME
 
@@ -78,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 {
@@ -122,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 {
@@ -148,12 +143,14 @@ sub delete_layout {
 sub get_printingtypes {
     my ($layout_id) = @_;
     my @printtypes;
-
-    push( @printtypes, { code => 'BAR',    desc => "barcode" } );
-    push( @printtypes, { code => 'BIB',    desc => "biblio" } );
+# FIXME: hard coded print types
+    push( @printtypes, { code => 'BAR',    desc => "barcode only" } );
+    push( @printtypes, { code => 'BIB',    desc => "biblio only" } );
     push( @printtypes, { code => 'BARBIB', desc => "barcode / biblio" } );
     push( @printtypes, { code => 'BIBBAR', desc => "biblio / barcode" } );
     push( @printtypes, { code => 'ALT',    desc => "alternating labels" } );
+    push( @printtypes, { code => 'CSV',    desc => "csv output" } );
+    push( @printtypes, { code => 'PATCRD', desc => "patron cards" } );
 
     my $conf             = get_layout($layout_id);
     my $active_printtype = $conf->{'printingtype'};
@@ -162,12 +159,15 @@ sub get_printingtypes {
 
     foreach my $printtype (@printtypes) {
         if ( $printtype->{'code'} eq $active_printtype ) {
-            $printtype->{'active'} = 'MOO';
+            $printtype->{'active'} = 1;
         }
     }
     return @printtypes;
 }
 
+# this sub (build_text_dropbox) is deprecated and should be deleted. 
+# rch 2008.04.15
+#
 sub build_text_dropbox {
     my ($order) = @_;
 
@@ -192,135 +192,159 @@ sub build_text_dropbox {
 
 sub get_text_fields {
     my ($layout_id, $sorttype) = @_;
-
-    my ( $a, $b, $c, $d, $e, $f, $g, $h, $i ,$j, $k );
-
+       my @sorted_fields;
+       my $error;
     my $sortorder = get_layout($layout_id);
-
-    # $sortorder
-
-    $a = {
+       if(  $sortorder->{formatstring}) {
+               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()  ;
+                       $error = $csv->error_input();
+                       warn $error if $error ;  # TODO - do more with this.
+               }
+       } else {
+    # These fields are hardcoded based on the template for label-edit-layout.pl
+               my @text_fields = (
+       {
         code  => 'itemtype',
         desc  => "Item Type",
         order => $sortorder->{'itemtype'}
-    };
-    $b = {
+        },
+       {
         code  => 'dewey',
         desc  => "Dewey",
         order => $sortorder->{'dewey'}
-    };
-    $c = { code => 'issn', desc => "ISSN", 
-        order => $sortorder->{'issn'} };
-    $d = { code => 'isbn', desc => "ISBN", 
-            order => $sortorder->{'isbn'} };
-    $e = {
+        },
+       {
+        code => 'issn',
+        desc => "ISSN", 
+        order => $sortorder->{'issn'}
+        },
+       {
+        code => 'isbn',
+        desc => "ISBN", 
+        order => $sortorder->{'isbn'}
+        },
+       {
         code  => 'class',
         desc  => "Classification",
         order => $sortorder->{'class'}
-    };
-    $f = {
+        },
+       {
         code  => 'subclass',
         desc  => "Sub-Class",
         order => $sortorder->{'subclass'}
-    };
-    $g = {
+        },
+       {
         code  => 'barcode',
         desc  => "Barcode",
         order => $sortorder->{'barcode'}
-    };
-    $h =
-      { code => 'author', desc => "Author", order => $sortorder->{'author'} };
-    $i = { code => 'title', desc => "Title", order => $sortorder->{'title'} };
-    $j = { code => 'itemcallnumber', desc => "Call Number", order => $sortorder->{'itemcallnumber'} };
-       $k = { code => 'subtitle', desc => "Subtitle", order => $sortorder->{'subtitle'} }; 
+        },
+       {
+        code => 'author',
+        desc => "Author",
+        order => $sortorder->{'author'}
+        },
+       {
+        code => 'title',
+        desc => "Title",
+        order => $sortorder->{'title'}
+        },
+       {
+        code => 'itemcallnumber',
+        desc => "Call Number",
+        order => $sortorder->{'itemcallnumber'}
+        },
+       {
+        code => 'subtitle',
+        desc => "Subtitle",
+        order => $sortorder->{'subtitle'}
+        }
+               );
     
-       my @text_fields = ( $a, $b, $c, $d, $e, $f, $g, $h, $i ,$j, $k );
 
-    my @new_fields;
-    foreach my $field (@text_fields) {
-        push( @new_fields, $field ) if $field->{'order'} > 0;
+       my @new_fields;
+       foreach my $field (@text_fields) {
+           push( @new_fields, $field ) if $field->{'order'} > 0;
+       }
+       
+     @sorted_fields = sort {  $$a{order} <=> $$b{order} } @new_fields;
     }
-
-    my @sorted_fields = sort by_order @new_fields;
+       # if we have a 'formatstring', then we ignore these hardcoded fields.
     my $active_fields;
-    foreach my $field (@sorted_fields) {
-     $sorttype eq 'codes' ?   $active_fields .= "$field->{'code'} " :
-          $active_fields .= "$field->{'desc'} ";
-    }
-    return $active_fields;
 
-}
+    if ($sorttype eq 'codes') { # FIXME: This sub should really always return the array of hashrefs and let the caller take what he wants from that -fbcit
+        return @sorted_fields;
+    } else {
+        foreach my $field (@sorted_fields) {
+            $active_fields .= "$field->{'desc'} ";
+        }
+        return $active_fields;
+    }
 
-sub by_order {
-    $$a{order} <=> $$b{order};
 }
 
-sub add_batch {
-    my $new_batch;
+=head2 sub add_batch
+=over 4
+ add_batch($batch_type,\@batch_list);
+ if $batch_list is supplied,
+   create a new batch with those items.
+ else, return the next available batch_id.
+=return
+=cut
+sub add_batch ($;$) {
+       my $table = (@_ and 'patroncards' eq shift) ? 'patroncards' : 'labels';
+    my $batch_list = (@_) ? shift : undef;
     my $dbh = C4::Context->dbh;
-    my $q =
-      "select distinct batch_id from labels order by batch_id desc limit 1";
+    my $q ="SELECT MAX(DISTINCT batch_id) FROM $table";
     my $sth = $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'} + 1 );
-    }
-
-    return $new_batch;
+    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;
 }
 
-
+#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 $dbh = C4::Context->dbh;
-    my $q   = "select batch_id, count(*) as num from labels 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 {
-    my ($batch_id) = @_;
+    my ($batch_id, $batch_type) = @_;
+    warn "Deleteing batch of type $batch_type";
     my $dbh        = C4::Context->dbh;
-    my $q          = "DELETE FROM labels where batch_id  = ?";
+    my $q          = "DELETE FROM $batch_type WHERE batch_id  = ?";
     my $sth        = $dbh->prepare($q);
     $sth->execute($batch_id);
     $sth->finish;
@@ -362,13 +386,14 @@ sub GetTextWrapCols {
     my $string = '0';
     my $strwidth;
     my $count = 0;
-    my $textlimit = $label_width - ( 2* $left_text_margin);
+#    my $textlimit = $label_width - ($left_text_margin);
+    my $textlimit = $label_width - ( 3 * $left_text_margin);
 
     while ( $strwidth < $textlimit ) {
-        $count++;
         $strwidth = prStrWidth( $string, $font, $fontsize );
         $string = $string . '0';
         #warn "strwidth:$strwidth, textlimit:$textlimit, count:$count string:$string";
+        $count++;
     }
     return $count;
 }
@@ -439,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=?,
@@ -513,7 +538,7 @@ sub add_layout {
         $barcodetype,  $title,                 $subtitle,      $isbn,       $issn,
         $itemtype,     $bcn,            $dcn,        $classif,
         $subclass,     $itemcallnumber, $author,     $tmpl_id,
-        $printingtype, $guidebox,       $startlabel, $layoutname
+        $printingtype, $guidebox,       $startlabel, $layoutname, $formatstring
     ) = @_;
 
     my $dbh    = C4::Context->dbh;
@@ -522,16 +547,16 @@ sub add_layout {
     $sth2->execute();
     $query2 = "INSERT INTO labels_conf
             ( barcodetype, title, subtitle, isbn,issn, itemtype, barcode,
-              dewey, class, subclass, itemcallnumber, author, printingtype,
-                guidebox, startlabel, layoutname, active )
-               values ( ?, ?, ?, ?, ?, ?, ?,  ?,?, ?, ?, ?, ?, ?,?,?, 1 )";
+              dewey, classification, subclass, itemcallnumber, author, printingtype,
+                guidebox, startlabel, layoutname, formatstring, active )
+               values ( ?, ?,?, ?, ?, ?, ?, ?,  ?,?, ?, ?, ?, ?, ?,?,?, 1 )";
     $sth2 = $dbh->prepare($query2);
     $sth2->execute(
         $barcodetype, $title, $subtitle, $isbn, $issn,
 
         $itemtype, $bcn,            $dcn,    $classif,
         $subclass, $itemcallnumber, $author, $printingtype,
-        $guidebox, $startlabel,     $layoutname
+        $guidebox, $startlabel,     $layoutname, $formatstring
     );
     $sth2->finish;
 
@@ -545,7 +570,7 @@ sub save_layout {
         $barcodetype,  $title,          $subtitle,     $isbn,       $issn,
         $itemtype,     $bcn,            $dcn,        $classif,
         $subclass,     $itemcallnumber, $author,     $tmpl_id,
-        $printingtype, $guidebox,       $startlabel, $layoutname,
+        $printingtype, $guidebox,       $startlabel, $layoutname, $formatstring,
         $layout_id
     ) = @_;
 ### $layoutname
@@ -554,15 +579,15 @@ sub save_layout {
     my $dbh    = C4::Context->dbh;
     my $query2 = "update labels_conf set 
              barcodetype=?, title=?, subtitle=?, isbn=?,issn=?, 
-            itemtype=?, barcode=?,    dewey=?, class=?,
+            itemtype=?, barcode=?,    dewey=?, classification=?,
              subclass=?, itemcallnumber=?, author=?,  printingtype=?,  
-               guidebox=?, startlabel=?, layoutname=? where id = ?";
+               guidebox=?, startlabel=?, layoutname=?, formatstring=? where id = ?";
     my $sth2 = $dbh->prepare($query2);
     $sth2->execute(
         $barcodetype, $title,          $subtitle,      $isbn,       $issn,
         $itemtype,    $bcn,            $dcn,        $classif,
         $subclass,    $itemcallnumber, $author,     $printingtype,
-        $guidebox,    $startlabel,     $layoutname, $layout_id
+        $guidebox,    $startlabel,     $layoutname, $formatstring,  $layout_id
     );
     $sth2->finish;
 
@@ -727,16 +752,16 @@ sub SetAssociatedProfile {
     $sth->finish;
 }
 
-=item get_label_items;
+=item GetLabelItems;
 
-        $options = get_label_items()
+        $options = GetLabelItems()
 
 Returns an array of references-to-hash, whos keys are the field from the biblio, biblioitems, items and labels tables in the Koha database.
 
 =cut
 
 #'
-sub get_label_items {
+sub GetLabelItems {
     my ($batch_id) = @_;
     my $dbh = C4::Context->dbh;
 
@@ -797,120 +822,207 @@ sub GetItemFields {
     return @fields;
 }
 
+=head GetBarcodeData
+
+=over 4
+Parse labels_conf.formatstring value
+(one value of the csv, which has already been split)
+and return string from koha tables or MARC record.
+=back
+=cut
+#'
+sub GetBarcodeData {
+       my ($f,$item,$record) = @_;
+       my $kohatables= &_descKohaTables();
+       my $datastring;
+       my $last_f = $f;
+       my $match_kohatable = join('|', (@{$kohatables->{biblio}},@{$kohatables->{biblioitems}},@{$kohatables->{items}}) );
+       while( $f ) {
+               if( $f =~ /^'(.*)'.*/ ) {
+                       # single quotes indicate a static text string.
+                       $datastring .= $1 ;
+                       $f = $';
+               } elsif ( $f =~ /^($match_kohatable).*/ ) { 
+                       # grep /$f/, (@$kohatables->{biblio},@$kohatables->{biblioitems},@$kohatables->{items}) ) {
+                       $datastring .= $item->{$f};
+                       $f = $';
+               } elsif ( $f =~ /^([0-9a-z]{3})(\w)(\W*).*/ ) {
+                       $datastring .= $record->subfield($1,$2) . $3 if($record->subfield($1,$2)) ;
+                       $f = $';
+               } 
+               last if ( $f eq $last_f ); # failed to match
+       }
+       return $datastring;
+}
+
+=head descKohaTables
+Return a hashref of an array of hashes,
+with name,type keys.
+=cut
+
+sub _descKohaTables {
+       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 GetPatronCardItems {
+
+    my ( $batch_id ) = @_;
+    my @resultsloop;
+    
+    my $dbh = C4::Context->dbh;
+#    my $query = "SELECT * FROM patroncards WHERE batch_id = ? ORDER BY borrowernumber";
+    my $query = "SELECT * FROM patroncards WHERE batch_id = ? ORDER BY cardid";
+    my $sth = $dbh->prepare($query);
+    $sth->execute($batch_id);
+    my $cardno = 1;
+    while ( my $data = $sth->fetchrow_hashref ) {
+        my $patron_data = GetMember( $data->{'borrowernumber'} );
+        $patron_data->{'branchname'} = GetBranchName( $patron_data->{'branchcode'} );
+        $patron_data->{'cardno'} = $cardno;
+        $patron_data->{'cardid'} = $data->{'cardid'};
+        $patron_data->{'batch_id'} = $batch_id;
+        push( @resultsloop, $patron_data );
+        $cardno++;
+    }
+    $sth->finish;
+    return @resultsloop;
+
+}
+
 sub deduplicate_batch {
-       my $batch_id = shift or return undef;
+       my ( $batch_id, $batch_type ) = @_;
        my $query = "
        SELECT DISTINCT
-                       batch_id,itemnumber,
-                       count(labelid) as count 
-       FROM     labels 
-       WHERE    batch_id = ?
-       GROUP BY itemnumber,batch_id
-       HAVING   count > 1
+                       batch_id," . (($batch_type eq 'labels') ? 'itemnumber' : 'borrowernumber') . ",
+                       count(". (($batch_type eq 'labels') ? 'labelid' : 'cardid') . ") as count 
+       FROM $batch_type 
+       WHERE batch_id = ?
+       GROUP BY " . (($batch_type eq 'labels') ? 'itemnumber' : 'borrowernumber') . ",batch_id
+       HAVING count > 1
        ORDER BY batch_id,
-                        count DESC  ";
+       count DESC  ";
        my $sth = C4::Context->dbh->prepare($query);
        $sth->execute($batch_id);
-       $sth->rows or return undef;
+        warn $sth->errstr if $sth->errstr;
+       $sth->rows or return undef, $sth->errstr;
 
-       my $del_query = qq(
+       my $del_query = "
        DELETE 
-       FROM     labels 
+       FROM     $batch_type
        WHERE    batch_id = ?
-       AND      itemnumber = ?
+       AND      " . (($batch_type eq 'labels') ? 'itemnumber' : 'borrowernumber') . " = ?
        ORDER BY timestamp ASC
-       );
+       ";
        my $killed = 0;
        while (my $data = $sth->fetchrow_hashref()) {
-               my $itemnumber = $data->{itemnumber} or next;
+               my $itemnumber = $data->{(($batch_type eq 'labels') ? 'itemnumber' : 'borrowernumber')} or next;
                my $limit      = $data->{count} - 1  or next;
                my $sth2 = C4::Context->dbh->prepare("$del_query  LIMIT $limit");
                # die sprintf "$del_query LIMIT %s\n (%s, %s)", $limit, $batch_id, $itemnumber;
                # $sth2->execute($batch_id, C4::Context->dbh->quote($data->{itemnumber}), $data->{count} - 1)
                $sth2->execute($batch_id, $itemnumber) and
                        $killed += ($data->{count} - 1);
+                warn $sth2->errstr if $sth2->errstr;
        }
-       return $killed;
+       return $killed, undef;
 }
 
 sub DrawSpineText {
 
-    my ( $y_pos, $label_height, $label_width, $font, $fontsize, $x_pos, $left_text_margin,
-        $text_wrap_cols, $item, $conf_data, $printingtype )
-      = @_;
-# hack to fix column name mismatch betwen labels_conf.class, and bibitems.classification
-       $$item->{'class'} = $$item->{'classification'};
-    $Text::Wrap::columns   = $text_wrap_cols;
-    $Text::Wrap::separator = "\n";
+    my ( $x_pos, $y_pos, $label_height, $label_width, $fontname, $fontsize, $left_text_margin,
+        $text_wrap_cols, $item, $conf_data, $printingtype, $nowrap ) = @_;
+
+    # Replaced item's itemtype with the more user-friendly description...
+    my $dbh = C4::Context->dbh;
+    my %itemtypes;
+    my $sth = $dbh->prepare("SELECT itemtype,description FROM itemtypes");
+    $sth->execute();
+    while ( my $data = $sth->fetchrow_hashref ) {
+        $$item->{'itemtype'} = $data->{'description'} if ($$item->{'itemtype'} eq $data->{'itemtype'});
+    }
 
     my $str;
-    ##      $item
 
     my $top_text_margin = ( $fontsize + 3 );    #FIXME: This should be a template parameter and passed in...
-    my $line_spacer = ( $fontsize * 0.20 );    # number of pixels between text rows (This is actually leading: baseline to baseline minus font size. Recommended starting point is 20% of font size.).
-
-    # add your printable fields manually in here
+    my $line_spacer = ( $fontsize * 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 $layout_id = $$conf_data->{'id'};
 
-#    my @fields = GetItemFields();
-
-    my $str_fields = get_text_fields($layout_id, 'codes' );
-    my @fields = split(/ /, $str_fields);
-    #warn Dumper(@fields);
-    ### @fields
-
-    my $vPos   = ( $y_pos + ( $label_height - $top_text_margin ) );
-
-    # warn Dumper $conf_data;
-    #warn Dumper $item;
+    my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) );
 
-    foreach my $field (@fields) {
-
-        # testing hack
-#     $$item->{"$field"} = $field . ": " . $$item->{"$field"};
+    my @str_fields = get_text_fields($layout_id, 'codes' );
+       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 $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'}}  ;
+               }
+
+        # This allows us to print the title in italic (oblique) type... (Times Roman has a different nomenclature.)
+        # It seems there should be a better way to handle fonts in the label/patron card tool altogether -fbcit
+        ($field->{code} eq 'title') ? (($old_fontname =~ /T/) ? ($fontname = 'TI') : ($fontname = ($old_fontname . 'O'))) : ($fontname = $old_fontname);
+        my $font = prFont($fontname);
         # if the display option for this field is selected in the DB,
         # and the item record has some values for this field, display it.
-        if ( $$conf_data->{"$field"} && $$item->{"$field"} ) {
-
-            #            warn "CONF_TYPE = $field";
-
+        if ( ($$conf_data->{'formatstring'}) || ( $$conf_data->{$field->{code}} && $$item->{$field->{code}} ) ) {
             # get the string
-            $str = $$item->{"$field"};
+            my $str = $field->{data} ;
             # strip out naughty existing nl/cr's
             $str =~ s/\n//g;
             $str =~ s/\r//g;
-            # strip out division slashes
-            $str =~ s/\///g;
-            # chop the string up into _upto_ 12 chunks
-            # and seperate the chunks with newlines
-
-            $str = wrap( "", "", "$str" );
-            $str = wrap( "", "", "$str" );
-
-            # split the chunks between newline's, into an array
-            my @strings = split /\n/, $str;
-
-            # then loop for each string line
+            my @strings;
+            if ($field->{code} eq 'itemcallnumber') { # If the field contains the call number, we do some special processing on it here...
+                if (($nowrap == 0) || (!$nowrap)) { # wrap lines based on segmentation markers: '/' (other types of segmentation markers can be added as needed here or this could be added as a syspref.)
+                    while ( $str =~ /\// ) {
+                        $str =~ /^(.*)\/(.*)$/;
+                        unshift @strings, $2;
+                        $str = $1;
+                    }   
+                    unshift @strings, $str;
+                } else {
+                    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...
+                # 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) {
                 my $hPos;
                 if ( $printingtype eq 'BIB' ) { #FIXME: This is a hack and needs to be implimented as a text justification option in the template...
-                    # some code to try and center each line on the label based on font size and string point length...
-                    my $stringwidth = prStrWidth($str, $font, $fontsize);
+                    # some code to try and center each line on the label based on font size and string point width...
+                    my $stringwidth = prStrWidth($str, $fontname, $fontsize);
                     my $whitespace = ( $label_width - ( $stringwidth + (2 * $left_text_margin) ) );
                     $hPos = ( ( $whitespace  / 2 ) + $x_pos + $left_text_margin );
-                    warn "\$label_width=$label_width \$stringwidth=$stringwidth \$whitespace=$whitespace \$left_text_margin=$left_text_margin for $str";
+                    #warn "\$label_width=$label_width \$stringwidth=$stringwidth \$whitespace=$whitespace \$left_text_margin=$left_text_margin for $str\n";
                 } else {
                     $hPos = ( $x_pos + $left_text_margin );
                 }
                 PrintText( $hPos, $vPos, $font, $fontsize, $str );
                 $vPos = $vPos - $line_spacer;
-                
             }
-        }    # if field is     
-    }    #foreach feild
+       } 
+       }       #foreach field
 }
 
 sub PrintText {
@@ -919,7 +1031,33 @@ sub PrintText {
     prAdd($str);
 }
 
-# Is this used anywhere?
+sub DrawPatronCardText {
+
+    my ( $x_pos, $y_pos, $label_height, $label_width, $fontname, $fontsize, $left_text_margin,
+        $text_wrap_cols, $text, $printingtype )
+      = @_;
+
+    my $top_text_margin = 25;    #FIXME: This should be a template parameter and passed in...
+
+    my $vPos   = ( $y_pos + ( $label_height - $top_text_margin ) );
+    my $font = prFont($fontname);
+
+    my $hPos;
+
+    foreach my $line (keys %$text) {
+        $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) ) );
+        $hPos = ( ( $whitespace  / 2 ) + $x_pos + $left_text_margin );
+
+        PrintText( $hPos, $vPos, $font, $text->{$line}, $line );
+        my $line_spacer = ( $text->{$line} * 1 );    # number of pixels between text rows (This is actually leading: baseline to baseline minus font size. Recommended starting point is 20% (0.20) of font size.).
+        $vPos = $vPos - ($line_spacer + $text->{$line});   # Linefeed equiv: leading + font size
+    }
+}
+
+# Not used anywhere.
 
 #sub SetFontSize {
 #
@@ -1053,8 +1191,8 @@ sub DrawBarcode {
 
     my $moo2 = $tot_bar_length * $xsize_ratio;
 
-    warn "$x_pos, $y_pos, $barcode, $barcodetype" if $DEBUG;
-    warn "BAR_WDTH = $bar_width, TOT.BAR.LGHT=$tot_bar_length  R*TOT.BAR =$moo2" if $DEBUG;
+    warn "$x_pos, $y_pos, $barcode, $barcodetype" if $debug;
+    warn "BAR_WDTH = $bar_width, TOT.BAR.LGHT=$tot_bar_length  R*TOT.BAR =$moo2" if $debug;
 }
 
 =item build_circ_barcode;
@@ -1062,7 +1200,7 @@ sub DrawBarcode {
   build_circ_barcode( $x_pos, $y_pos, $barcode,
                $barcodetype, \$item);
 
-$item is the result of a previous call to get_label_items();
+$item is the result of a previous call to GetLabelItems();
 
 =cut