[Koha-cvs] koha/C4 Labels.pm [rel_3_0]
Antoine Farnault
antoine at koha-fr.org
Thu Oct 19 18:24:09 CEST 2006
CVSROOT: /sources/koha
Module name: koha
Branch: rel_3_0
Changes by: Antoine Farnault <toins> 06/10/19 16:24:09
Modified files:
C4 : Labels.pm
Log message:
sync with dev_week.
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Labels.pm?cvsroot=koha&only_with_tag=rel_3_0&r1=1.3&r2=1.3.6.1
Patches:
Index: Labels.pm
===================================================================
RCS file: /sources/koha/koha/C4/Labels.pm,v
retrieving revision 1.3
retrieving revision 1.3.6.1
diff -u -b -r1.3 -r1.3.6.1
--- Labels.pm 10 Jul 2006 23:36:02 -0000 1.3
+++ Labels.pm 19 Oct 2006 16:24:09 -0000 1.3.6.1
@@ -23,7 +23,7 @@
use vars qw($VERSION @ISA @EXPORT);
#use Data::Dumper;
use PDF::Reuse;
-
+use Text::Wrap;
$VERSION = 0.01;
@@ -41,7 +41,13 @@
@EXPORT = qw(
&get_label_options &get_label_items
&build_circ_barcode &draw_boundaries
- &draw_box
+ &drawbox &GetActiveLabelTemplate
+ &GetAllLabelTemplates &DeleteTemplate
+ &GetSingleLabelTemplate &SaveTemplate
+ &CreateTemplate &SetActiveTemplate
+ &SaveConf &DrawSpineText &GetTextWrapCols
+ &GetUnitsValue &DrawBarcode
+
);
=item get_label_options;
@@ -52,6 +58,7 @@
Return a pointer on a hash list containing info from labels_conf table in Koha DB.
=cut
+
#'
sub get_label_options {
my $dbh = C4::Context->dbh;
@@ -63,6 +70,208 @@
return $conf_data;
}
+sub GetUnitsValue {
+ my ($units) = @_;
+ my $unitvalue;
+
+ $unitvalue = '1' if ( $units eq 'POINT' );
+ $unitvalue = '2.83464567' if ( $units eq 'MM' );
+ $unitvalue = '28.3464567' if ( $units eq 'CM' );
+ $unitvalue = 72 if ( $units eq 'INCH' );
+ warn $units, $unitvalue;
+ return $unitvalue;
+}
+
+sub GetTextWrapCols {
+ my ( $fontsize, $label_width ) = @_;
+ my $string = "0";
+ my $left_text_margin = 3;
+ my ( $strtmp, $strwidth );
+ my $count = 0;
+ my $textlimit = $label_width - $left_text_margin;
+
+ while ( $strwidth < $textlimit ) {
+ $strwidth = prStrWidth( $string, 'C', $fontsize );
+ $string = $string . '0';
+
+ # warn "strwidth $strwidth, $textlimit, $string";
+ $count++;
+ }
+ return $count;
+}
+
+sub GetActiveLabelTemplate {
+ my $dbh = C4::Context->dbh;
+ my $query = " SELECT * FROM labels_templates where active = 1 limit 1";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ my $active_tmpl = $sth->fetchrow_hashref;
+ $sth->finish;
+ return $active_tmpl;
+}
+
+sub GetSingleLabelTemplate {
+ my ($tmpl_code) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = " SELECT * FROM labels_templates where tmpl_code = ?";
+ my $sth = $dbh->prepare($query);
+ $sth->execute($tmpl_code);
+ my $template = $sth->fetchrow_hashref;
+ $sth->finish;
+ return $template;
+}
+
+sub SetActiveTemplate {
+
+ my ($tmpl_id) = @_;
+ warn "TMPL_ID = $tmpl_id";
+ my $dbh = C4::Context->dbh;
+ my $query = " UPDATE labels_templates SET active = NULL";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+
+ my $query = "UPDATE labels_templates SET active = 1 WHERE tmpl_id = ?";
+ my $sth = $dbh->prepare($query);
+ $sth->execute($tmpl_id);
+ $sth->finish;
+}
+
+sub DeleteTemplate {
+ my ($tmpl_code) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = " DELETE FROM labels_templates where tmpl_code = ?";
+ my $sth = $dbh->prepare($query);
+ $sth->execute($tmpl_code);
+ $sth->finish;
+}
+
+sub SaveTemplate {
+
+ my (
+ $tmpl_id, $tmpl_code, $tmpl_desc, $page_width,
+ $page_height, $label_width, $label_height, $topmargin,
+ $leftmargin, $cols, $rows, $colgap,
+ $rowgap, $active, $fontsize, $units
+ )
+ = @_;
+
+ #warn "FONTSIZE =$fontsize";
+ #warn Dumper @_;
+
+ my $dbh = C4::Context->dbh;
+ my $query =
+ " UPDATE labels_templates SET tmpl_code=?, tmpl_desc=?, page_width=?,
+ page_height=?, label_width=?, label_height=?, topmargin=?,
+ leftmargin=?, cols=?, rows=?, colgap=?, rowgap=?, fontsize=?,
+ units=?
+ WHERE tmpl_id = ?";
+
+ my $sth = $dbh->prepare($query);
+ $sth->execute(
+ $tmpl_code, $tmpl_desc, $page_width, $page_height,
+ $label_width, $label_height, $topmargin, $leftmargin,
+ $cols, $rows, $colgap, $rowgap,
+ $fontsize, $units, $tmpl_id
+ );
+ $sth->finish;
+
+ SetActiveTemplate($tmpl_id) if ( $active eq '1' );
+}
+
+sub CreateTemplate {
+ my $tmpl_id;
+ my (
+ $tmpl_code, $tmpl_desc, $page_width, $page_height,
+ $label_width, $label_height, $topmargin, $leftmargin,
+ $cols, $rows, $colgap, $rowgap,
+ $active, $fontsize, $units
+ )
+ = @_;
+
+ my $dbh = C4::Context->dbh;
+
+ my $query = "INSERT INTO labels_templates (tmpl_code, tmpl_desc, page_width,
+ page_height, label_width, label_height, topmargin,
+ leftmargin, cols, rows, colgap, rowgap, fontsize, units)
+ VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?,?)";
+
+ my $sth = $dbh->prepare($query);
+ $sth->execute(
+ $tmpl_code, $tmpl_desc, $page_width, $page_height,
+ $label_width, $label_height, $topmargin, $leftmargin,
+ $cols, $rows, $colgap, $rowgap,
+ $fontsize, $units
+ );
+
+ warn "ACTIVE = $active";
+
+ if ( $active eq '1' ) {
+
+ # get the tmpl_id of the newly created template, then call SetActiveTemplate()
+ my $query =
+ "SELECT tmpl_id from labels_templates order by tmpl_id desc limit 1";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+
+ my $data = $sth->fetchrow_hashref;
+ my $tmpl_id = $data->{'tmpl_id'};
+
+ SetActiveTemplate($tmpl_id);
+ $sth->finish;
+ }
+ return $tmpl_id;
+}
+
+sub GetAllLabelTemplates {
+ my $dbh = C4::Context->dbh;
+
+ # get the actual items to be printed.
+ my @data;
+ my $query = " Select * from labels_templates ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ my @resultsloop;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push( @resultsloop, $data );
+ }
+ $sth->finish;
+
+ #warn Dumper @resultsloop;
+ return @resultsloop;
+}
+
+sub SaveConf {
+
+ my (
+ $barcodetype, $title, $isbn, $itemtype,
+ $bcn, $dcn, $classif, $subclass,
+ $itemcallnumber, $author, $tmpl_id, $printingtype,
+ $guidebox, $startlabel
+ )
+ = @_;
+
+ my $dbh = C4::Context->dbh;
+ my $query2 = "DELETE FROM labels_conf";
+ my $sth2 = $dbh->prepare($query2);
+ $sth2->execute();
+ my $query2 = "INSERT INTO labels_conf
+ ( barcodetype, title, isbn, itemtype, barcode,
+ dewey, class, subclass, itemcallnumber, author, printingtype,
+ guidebox, startlabel )
+ values ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )";
+ my $sth2 = $dbh->prepare($query2);
+ $sth2->execute(
+ $barcodetype, $title, $isbn, $itemtype,
+ $bcn, $dcn, $classif, $subclass,
+ $itemcallnumber, $author, $printingtype, $guidebox,
+ $startlabel
+ );
+ $sth2->finish;
+
+ SetActiveTemplate($tmpl_id);
+ return;
+}
+
=item get_label_items;
$options = get_label_items()
@@ -71,6 +280,7 @@
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 {
my $dbh = C4::Context->dbh;
@@ -104,6 +314,138 @@
return @resultsloop;
}
+sub DrawSpineText {
+
+ my ( $y_pos, $label_height, $fontsize, $x_pos, $left_text_margin,
+ $text_wrap_cols, $item, $conf_data )
+ = @_;
+
+ $Text::Wrap::columns = $text_wrap_cols;
+ $Text::Wrap::separator = "\n";
+
+ my $str;
+
+ my $top_text_margin = ( $fontsize + 3 );
+ my $line_spacer = ($fontsize); # number of pixels between text rows.
+
+ # add your printable fields manually in here
+ my @fields =
+ qw (dewey isbn classification itemtype subclass itemcallnumber);
+ my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) );
+ my $hPos = ( $x_pos + $left_text_margin );
+
+ # warn Dumper $conf_data;
+ #warn Dumper $item;
+
+ 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.
+ if ( $$conf_data->{"$field"} && $$item->{"$field"} ) {
+
+ # warn "CONF_TYPE = $field";
+
+ # get the string
+ $str = $$item->{"$field"};
+
+ # 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;
+
+ # then loop for each string line
+ foreach my $str (@strings) {
+
+ #warn "HPOS , VPOS $hPos, $vPos ";
+ prText( $hPos, $vPos, $str );
+ $vPos = $vPos - $line_spacer;
+ }
+ } # if field is valid
+ } #foreach feild
+}
+
+sub DrawBarcode {
+
+ my ( $x_pos, $y_pos, $height, $width, $barcode, $barcodetype ) = @_;
+ $barcode = '123456789';
+ my $num_of_bars = length($barcode);
+ my $bar_width = ( ( $width / 10 ) * 8 ); # %80 of lenght of label width
+ my $tot_bar_length;
+ my $bar_length;
+ my $guard_length = 10;
+ my $xsize_ratio;
+
+ if ( $barcodetype eq 'Code39' ) {
+ $bar_length = '14.4333333333333';
+ $tot_bar_length =
+ ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
+ $xsize_ratio = ( $bar_width / $tot_bar_length );
+ eval {
+ PDF::Reuse::Barcode::Code39(
+ x => ( $x_pos + ( $width / 10 ) ),
+ y => ( $y_pos + ( $height / 10 ) ),
+ value => $barcode,
+ ySize => ( .02 * $height ),
+ xSize => $xsize_ratio,
+ );
+ };
+ if ($@) {
+ warn "$barcodetype, $barcode FAILED:$@";
+ }
+ }
+
+ elsif ( $barcodetype eq 'COOP2of5' ) {
+ $bar_length = '9.43333333333333';
+ $tot_bar_length =
+ ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
+ $xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
+ eval {
+ PDF::Reuse::Barcode::COOP2of5(
+ x => ( $x_pos + ( $width / 10 ) ),
+ y => ( $y_pos + ( $height / 10 ) ),
+ value => $barcode,
+ ySize => ( .02 * $height ),
+ xSize => $xsize_ratio,
+ );
+ };
+ if ($@) {
+ warn "$barcodetype, $barcode FAILED:$@";
+ }
+ }
+
+ elsif ( $barcodetype eq 'Industrial2of5' ) {
+ $bar_length = '13.1333333333333';
+ $tot_bar_length =
+ ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
+ $xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
+ eval {
+ PDF::Reuse::Barcode::Industrial2of5(
+ x => ( $x_pos + ( $width / 10 ) ),
+ y => ( $y_pos + ( $height / 10 ) ),
+ value => $barcode,
+ ySize => ( .02 * $height ),
+ xSize => $xsize_ratio,
+ );
+ };
+ if ($@) {
+ warn "$barcodetype, $barcode FAILED:$@";
+ }
+ }
+ 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";
+}
+
=item build_circ_barcode;
build_circ_barcode( $x_pos, $y_pos, $barcode,
@@ -112,6 +454,7 @@
$item is the result of a previous call to get_label_items();
=cut
+
#'
sub build_circ_barcode {
my ( $x_pos_circ, $y_pos, $value, $barcodetype, $item ) = @_;
@@ -148,6 +491,7 @@
};
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "EAN13BARCODE FAILED:$@";
}
@@ -170,6 +514,7 @@
};
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "CODE39BARCODE $value FAILED:$@";
}
@@ -202,6 +547,7 @@
};
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "BARCODE FAILED:$@";
}
@@ -233,6 +579,7 @@
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "BARCODE FAILED:$@";
}
@@ -255,6 +602,7 @@
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "BARCODE FAILED:$@";
}
@@ -276,6 +624,7 @@
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "BARCODE FAILED:$@";
}
@@ -297,6 +646,7 @@
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "BARCODE FAILED:$@";
}
@@ -317,6 +667,7 @@
};
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "BARCODE FAILED:$@";
}
@@ -337,6 +688,7 @@
};
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "BARCODE FAILED:$@";
}
@@ -358,6 +710,7 @@
};
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "BARCODE FAILED:$@";
}
@@ -379,6 +732,7 @@
};
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "BARCODE FAILED:$@";
}
@@ -400,8 +754,11 @@
#'
sub draw_boundaries {
- my ($x_pos_spine, $x_pos_circ1, $x_pos_circ2,
- $y_pos, $spine_width, $label_height, $circ_width) = @_;
+ my (
+ $x_pos_spine, $x_pos_circ1, $x_pos_circ2, $y_pos,
+ $spine_width, $label_height, $circ_width
+ )
+ = @_;
my $y_pos_initial = ( ( 792 - 36 ) - 90 );
my $y_pos = $y_pos_initial;
@@ -427,15 +784,22 @@
this is a low level sub, that draws a pdf box, it is called by draw_boxes
+FYI: the $upper_right_x and $upper_right_y values are RELATIVE to $lower_left_x and $lower_left_y
+
+and $lower_left_x, $lower_left_y are ABSOLUTE, this caught me out!
+
=cut
#'
sub drawbox {
my ( $llx, $lly, $urx, $ury ) = @_;
+ # 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
$str .= "1.0 0.0 0.0 RG\n"; # border color red
- $str .= "1 1 1 rg\n"; # fill color blue
+ $str .= "0.5 0.75 1.0 rg\n"; # fill color blue
$str .= "$llx $lly $urx $ury re\n"; # a rectangle
$str .= "B\n"; # fill (and a little more)
$str .= "Q\n"; # save the graphic state
More information about the Koha-cvs
mailing list