[Koha-cvs] koha/C4 Labels.pm [dev_week]
Mason James
szrj1m at yahoo.com
Mon Aug 27 12:45:07 CEST 2007
CVSROOT: /sources/koha
Module name: koha
Branch: dev_week
Changes by: Mason James <sushi> 07/08/27 10:45:07
Modified files:
C4 : Labels.pm
Log message:
right justify text
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Labels.pm?cvsroot=koha&only_with_tag=dev_week&r1=1.3.4.42&r2=1.3.4.43
Patches:
Index: Labels.pm
===================================================================
RCS file: /sources/koha/koha/C4/Labels.pm,v
retrieving revision 1.3.4.42
retrieving revision 1.3.4.43
diff -u -b -r1.3.4.42 -r1.3.4.43
--- Labels.pm 27 Aug 2007 05:53:58 -0000 1.3.4.42
+++ Labels.pm 27 Aug 2007 10:45:06 -0000 1.3.4.43
@@ -25,8 +25,9 @@
use PDF::Reuse;
use Text::Wrap;
use Algorithm::CheckDigits;
+
# use Data::Dumper;
- use Smart::Comments '####';
+use Smart::Comments '####';
$VERSION = 0.01;
@@ -54,8 +55,9 @@
&CreateTemplate &SetActiveTemplate
&SaveConf &DrawSpineText
&DrawSpineTextManual draw_text_block_manual
+ draw_text_block_manual2
-&GetTextWrapCols
+ &GetTextWrapCols
&GetUnitsValue &DrawBarcode
&get_printingtypes
&get_layouts
@@ -66,11 +68,11 @@
&get_text_fields
get_layout &add_layout
-&save_layout
+ &save_layout
&set_active_layout &by_order
&build_text_dropbox
&delete_layout &get_active_layout
-&get_highest_batch
+ &get_highest_batch
);
@@ -198,9 +200,9 @@
}
sub get_text_fields {
- my ($layout_id, $sorttype) = @_;
+ my ( $layout_id, $sorttype ) = @_;
-#FIXME: use pushes, this is lame :)
+ #FIXME: use pushes, this is lame :)
my ( $a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l );
my $sortorder = get_layout($layout_id);
@@ -217,10 +219,16 @@
desc => "Dewey",
order => $sortorder->{'dewey'}
};
- $c = { code => 'issn', desc => "ISSN",
- order => $sortorder->{'issn'} };
- $d = { code => 'isbn', desc => "ISBN",
- order => $sortorder->{'isbn'} };
+ $c = {
+ code => 'issn',
+ desc => "ISSN",
+ order => $sortorder->{'issn'}
+ };
+ $d = {
+ code => 'isbn',
+ desc => "ISBN",
+ order => $sortorder->{'isbn'}
+ };
$e = {
code => 'class',
desc => "Classification",
@@ -241,13 +249,24 @@
$i = { code => 'title', desc => "Title", order => $sortorder->{'title'} };
- $j = { code => 'itemcallnumber', desc => "Item-Callnumber", order => $sortorder->{'itemcallnumber'} };
-
- $k = { code => 'subtitle', desc => "Subtitle", order => $sortorder->{'subtitle'} };
- $l = { code => 'ccode', desc => "Collection Code", order => $sortorder->{'ccode'} };
+ $j = {
+ code => 'itemcallnumber',
+ desc => "Item-Callnumber",
+ order => $sortorder->{'itemcallnumber'}
+ };
+ $k = {
+ code => 'subtitle',
+ desc => "Subtitle",
+ order => $sortorder->{'subtitle'}
+ };
+ $l = {
+ code => 'ccode',
+ desc => "Collection Code",
+ order => $sortorder->{'ccode'}
+ };
- my @text_fields = ( $a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k ,$l);
+ my @text_fields = ( $a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l );
my @new_fields;
foreach my $field (@text_fields) {
@@ -258,8 +277,10 @@
my $active_fields;
foreach my $field (@sorted_fields) {
- $sorttype eq 'codes' ? $active_fields .= "$field->{'code'} " :
- $active_fields .= "$field->{'desc'} ";
+ $sorttype eq 'codes'
+ ? $active_fields .=
+ "$field->{'code'} "
+ : $active_fields .= "$field->{'desc'} ";
}
return $active_fields;
@@ -289,7 +310,6 @@
return $new_batch;
}
-
sub get_highest_batch {
my $new_batch;
my $dbh = C4::Context->dbh;
@@ -310,7 +330,6 @@
return $new_batch;
}
-
sub get_batches {
my $dbh = C4::Context->dbh;
my $q = "select distinct batch_id from labels";
@@ -372,10 +391,10 @@
sub GetTextWrapCols {
my ( $fontsize, $label_width ) = @_;
my $string = "0";
- my $left_text_margin = 3;
+ my $text_margin = 3;
my ( $strtmp, $strwidth );
my $count = 0;
- my $textlimit = $label_width - $left_text_margin;
+ my $textlimit = $label_width - $text_margin;
while ( $strwidth < $textlimit ) {
$strwidth = prStrWidth( $string, 'C', $fontsize );
@@ -397,7 +416,6 @@
return $active_tmpl;
}
-
sub get_multi_label_templates {
my $dbh = C4::Context->dbh;
my $query = " SELECT * FROM labels_templates where tmpl_code like 'multi%'";
@@ -411,7 +429,6 @@
return @resultsloop;
}
-
sub get_multi_label_layouts {
my $dbh = C4::Context->dbh;
my $query = " SELECT * FROM labels_conf where laypoutname like 'multi%'";
@@ -425,10 +442,6 @@
return @resultsloop;
}
-
-
-
-
sub GetSingleLabelTemplate {
my ($tmpl_id) = @_;
my $dbh = C4::Context->dbh;
@@ -552,10 +565,11 @@
sub add_layout {
my (
- $barcodetype, $title, $subtitle, $isbn, $issn,
- $itemtype, $bcn, $dcn, $classif,
- $subclass, $itemcallnumber, $author, $tmpl_id,
- $printingtype, $guidebox, $startlabel, $layoutname
+ $barcodetype, $title, $subtitle, $isbn,
+ $issn, $itemtype, $bcn, $dcn,
+ $classif, $subclass, $itemcallnumber, $author,
+ $tmpl_id, $printingtype, $guidebox, $startlabel,
+ $layoutname
) = @_;
my $dbh = C4::Context->dbh;
@@ -580,18 +594,14 @@
return;
}
-
-
-
-
sub save_layout {
my (
- $barcodetype, $title, $subtitle , $isbn, $issn,
- $itemtype, $bcn, $dcn, $classif,
- $subclass, $itemcallnumber, $author, $ccode, $tmpl_id,
- $printingtype, $guidebox, $startlabel, $layoutname,
- $layout_id
+ $barcodetype, $title, $subtitle, $isbn,
+ $issn, $itemtype, $bcn, $dcn,
+ $classif, $subclass, $itemcallnumber, $author,
+ $ccode, $tmpl_id, $printingtype, $guidebox,
+ $startlabel, $layoutname, $layout_id
) = @_;
### @_;
@@ -606,10 +616,11 @@
guidebox=?, startlabel=?, layoutname=? where id = ?";
my $sth2 = $dbh->prepare($query2);
$sth2->execute(
- $barcodetype, $title, $subtitle , $isbn, $issn,
- $itemtype, $bcn, $dcn, $classif,
- $subclass, $itemcallnumber, $author, $ccode, $printingtype,
- $guidebox, $startlabel, $layoutname, $layout_id
+ $barcodetype, $title, $subtitle, $isbn,
+ $issn, $itemtype, $bcn, $dcn,
+ $classif, $subclass, $itemcallnumber, $author,
+ $ccode, $printingtype, $guidebox, $startlabel,
+ $layoutname, $layout_id
);
$sth2->finish;
@@ -667,7 +678,8 @@
$data1->{'batch_id'} = $batch_id;
$data1->{'summary'} =
"$data1->{'barcode'}, $data1->{'title'}, $data1->{'isbn'}";
-# $data1
+
+ # $data1
push( @resultsloop, $data1 );
$sth1->finish;
@@ -689,23 +701,23 @@
return @fields;
}
+sub draw_text_block_manual {
+ my (
+ $x_pos, $y_pos, $label_height,
+ $fontsize, $gutter, $text_wrap_cols,
+ @fields, $no_wrap, $justify
+ ) = @_;
-
-sub draw_text_block_manual{
-
- my ( $y_pos, $label_height, $fontsize, $x_pos, $gutter,
- $text_wrap_cols, @fields )
- = @_;
-
-# hack to fix column name mismatch betwen labels_conf.class,
-# and bibitems.classification
+ # hack to fix column name mismatch betwen labels_conf.class,
+ # and bibitems.classification
$Text::Wrap::columns = $text_wrap_cols;
$Text::Wrap::separator = "\n";
my $str;
-# $item
+
+ # $item
my $top_text_margin = ( $fontsize + $gutter );
my $line_spacer = ($fontsize); # number of pixels between text rows.
@@ -725,7 +737,6 @@
# if the display option for this field is selected in the DB,
# and the item record has some values for this field, display it.
- warn "CONF_TYPE = $field";
# get the string
$str = $field;
@@ -747,7 +758,7 @@
# then loop for each string line
foreach my $str (@strings) {
- #warn "HPOS , VPOS $hPos, $vPos ";
+warn "HPOS , VPOS $hPos, $vPos ";
# set the font size A
# prText( $hPos, $vPos, $str );
@@ -757,46 +768,115 @@
}
}
+sub draw_text_block_manual2 {
+
+ my (
+ $x_pos, $y_pos, $label_width, $label_height,
+ $fontsize, $gutter, $text_wrap_cols,
+ $no_wrap, $justify, @fields,
+ ) = @_;
+
+ # hack to fix column name mismatch betwen labels_conf.class,
+ # and bibitems.classification
+
+ $Text::Wrap::columns = $text_wrap_cols;
+ $Text::Wrap::separator = "\n";
+
+ my $str;
+
+ # $item
+
+ my $top_text_margin = ( $fontsize + $gutter );
+ my $line_spacer = ($fontsize); # number of pixels between text rows.
+
+ # add your printable fields manually in here
+#### @fields
+ # warn Dumper $conf_data;
+ #warn Dumper $item;
+ my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) );
+ my $hPos = ( $x_pos + $gutter );
+ foreach my $field (@fields) {
+ # if the display option for this field is selected in the DB,
+ # and the item record has some values for this field, display it.
+ # get the string
+ $str = $field;
+#### $str
+ # strip out naughty existing nl/cr's
+ $str =~ s/\n//g;
+ $str =~ s/\r//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;
+$justify = 'r';
-sub DrawSpineText {
+ # then loop for each string line
+ foreach my $str (@strings) {
- my ( $x_pos, $y_pos, $label_height, $fontsize,$x_pos, $left_text_margin,
- $text_wrap_cols, $item, $conf_data )
- = @_;
+ if ( $justify eq 'r' ) {
+ my $strwidth = prStrWidth( $str, 'C', $fontsize );
+#### $strwidth
+ $hPos = $x_pos + $label_width - ( $gutter + $strwidth);
-# hack to fix column name mismatch betwen labels_conf.class,
-# and bibitems.classification
+
+ }
+
+ warn "HPOS , VPOS $hPos, $vPos\n";
+ # set the font size A
+
+ # prText( $hPos, $vPos, $str );
+ PrintText( $hPos, $vPos, $fontsize, $str );
+ $vPos = $vPos - $line_spacer;
+
+ }
+ }
+}
+
+=c
+ sub DrawSpineText {
+
+ my (
+ $x_pos, $y_pos, $label_height,
+ $fontsize, $x_pos, $left_text_margin,
+ $text_wrap_cols, $item, $conf_data
+ ) = @_;
+
+ # 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 $str;
-# $item
+
+ # $item
my $top_text_margin = ( $fontsize + 3 );
my $line_spacer = ($fontsize); # number of pixels between text rows.
# add your printable fields manually in here
-my $layout_id = $$conf_data->{'id'};
+ my $layout_id = $$conf_data->{'id'};
-# my @fields = GetItemFields();
+ # my @fields = GetItemFields();
-my $str_fields = get_text_fields($layout_id, 'codes' );
-my @fields = split(/ /, $str_fields);
+ my $str_fields = get_text_fields( $layout_id, 'codes' );
+ my @fields = split( / /, $str_fields );
### @fields
my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) );
@@ -845,7 +925,8 @@
}
} # if field is } #foreach feild
}
-}
+ }
+=cut
sub PrintText {
my ( $hPos, $vPos, $fontsize, $text ) = @_;
@@ -946,7 +1027,6 @@
}
}
-
elsif ( $barcodetype eq 'COOP2OF5' ) {
$bar_length = '9.43333333333333';
$tot_bar_length =
@@ -988,7 +1068,7 @@
my $moo2 = $tot_bar_length * $xsize_ratio;
# warn " $x_pos, $y_pos, $barcode, $barcodetype\n";
- # warn "BAR_WDTH = $bar_width, TOT.BAR.LGHT=$tot_bar_length R*TOT.BAR =$moo2 \n";
+# warn "BAR_WDTH = $bar_width, TOT.BAR.LGHT=$tot_bar_length R*TOT.BAR =$moo2 \n";
}
=item build_circ_barcode;
@@ -1338,7 +1418,7 @@
sub drawbox {
my ( $llx, $lly, $urx, $ury ) = @_;
-warn "llx,y= $llx,$lly , urx,y=$urx,$ury\n";
+ warn "llx,y= $llx,$lly , urx,y=$urx,$ury\n";
my $str = "q\n"; # save the graphic state
$str .= "0.5 w\n"; # border color red
More information about the Koha-cvs
mailing list