3 # Copyright 2006 Katipo Communications.
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
23 use vars qw($VERSION @ISA @EXPORT);
28 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
29 shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
34 C4::Labels - Functions for printing spine labels and barcodes in Koha
44 &get_label_options &get_label_items
45 &build_circ_barcode &draw_boundaries
46 &drawbox &GetActiveLabelTemplate
47 &GetAllLabelTemplates &DeleteTemplate
48 &GetSingleLabelTemplate &SaveTemplate
49 &CreateTemplate &SetActiveTemplate
50 &SaveConf &DrawSpineText &GetTextWrapCols
51 &GetUnitsValue &DrawBarcode
55 =item get_label_options;
57 $options = get_label_options()
60 Return a pointer on a hash list containing info from labels_conf table in Koha DB.
65 sub get_label_options {
66 my $dbh = C4::Context->dbh;
67 my $query2 = " SELECT * FROM labels_conf LIMIT 1 ";
68 my $sth = $dbh->prepare($query2);
70 my $conf_data = $sth->fetchrow_hashref;
79 $unitvalue = '1' if ( $units eq 'POINT' );
80 $unitvalue = '2.83464567' if ( $units eq 'MM' );
81 $unitvalue = '28.3464567' if ( $units eq 'CM' );
82 $unitvalue = 72 if ( $units eq 'INCH' );
83 warn $units, $unitvalue;
88 my ( $fontsize, $label_width ) = @_;
90 my $left_text_margin = 3;
91 my ( $strtmp, $strwidth );
93 my $textlimit = $label_width - $left_text_margin;
95 while ( $strwidth < $textlimit ) {
96 $strwidth = prStrWidth( $string, 'C', $fontsize );
97 $string = $string . '0';
99 # warn "strwidth $strwidth, $textlimit, $string";
105 sub GetActiveLabelTemplate {
106 my $dbh = C4::Context->dbh;
107 my $query = " SELECT * FROM labels_templates where active = 1 limit 1";
108 my $sth = $dbh->prepare($query);
110 my $active_tmpl = $sth->fetchrow_hashref;
115 sub GetSingleLabelTemplate {
116 my ($tmpl_code) = @_;
117 my $dbh = C4::Context->dbh;
118 my $query = " SELECT * FROM labels_templates where tmpl_code = ?";
119 my $sth = $dbh->prepare($query);
120 $sth->execute($tmpl_code);
121 my $template = $sth->fetchrow_hashref;
126 sub SetActiveTemplate {
129 warn "TMPL_ID = $tmpl_id";
130 my $dbh = C4::Context->dbh;
131 my $query = " UPDATE labels_templates SET active = NULL";
132 my $sth = $dbh->prepare($query);
135 $query = "UPDATE labels_templates SET active = 1 WHERE tmpl_id = ?";
136 $sth = $dbh->prepare($query);
137 $sth->execute($tmpl_id);
142 my ($tmpl_code) = @_;
143 my $dbh = C4::Context->dbh;
144 my $query = " DELETE FROM labels_templates where tmpl_code = ?";
145 my $sth = $dbh->prepare($query);
146 $sth->execute($tmpl_code);
153 $tmpl_id, $tmpl_code, $tmpl_desc, $page_width,
154 $page_height, $label_width, $label_height, $topmargin,
155 $leftmargin, $cols, $rows, $colgap,
156 $rowgap, $active, $fontsize, $units
160 #warn "FONTSIZE =$fontsize";
162 my $dbh = C4::Context->dbh;
164 " UPDATE labels_templates SET tmpl_code=?, tmpl_desc=?, page_width=?,
165 page_height=?, label_width=?, label_height=?, topmargin=?,
166 leftmargin=?, cols=?, rows=?, colgap=?, rowgap=?, fontsize=?,
170 my $sth = $dbh->prepare($query);
172 $tmpl_code, $tmpl_desc, $page_width, $page_height,
173 $label_width, $label_height, $topmargin, $leftmargin,
174 $cols, $rows, $colgap, $rowgap,
175 $fontsize, $units, $tmpl_id
179 SetActiveTemplate($tmpl_id) if ( $active eq '1' );
185 $tmpl_code, $tmpl_desc, $page_width, $page_height,
186 $label_width, $label_height, $topmargin, $leftmargin,
187 $cols, $rows, $colgap, $rowgap,
188 $active, $fontsize, $units
192 my $dbh = C4::Context->dbh;
194 my $query = "INSERT INTO labels_templates (tmpl_code, tmpl_desc, page_width,
195 page_height, label_width, label_height, topmargin,
196 leftmargin, cols, rows, colgap, rowgap, fontsize, units)
197 VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?,?)";
199 my $sth = $dbh->prepare($query);
201 $tmpl_code, $tmpl_desc, $page_width, $page_height,
202 $label_width, $label_height, $topmargin, $leftmargin,
203 $cols, $rows, $colgap, $rowgap,
207 warn "ACTIVE = $active";
209 if ( $active eq '1' ) {
211 # get the tmpl_id of the newly created template, then call SetActiveTemplate()
213 "SELECT tmpl_id from labels_templates order by tmpl_id desc limit 1";
214 my $sth = $dbh->prepare($query);
217 my $data = $sth->fetchrow_hashref;
218 my $tmpl_id = $data->{'tmpl_id'};
220 SetActiveTemplate($tmpl_id);
226 sub GetAllLabelTemplates {
227 my $dbh = C4::Context->dbh;
229 # get the actual items to be printed.
231 my $query = " Select * from labels_templates ";
232 my $sth = $dbh->prepare($query);
235 while ( my $data = $sth->fetchrow_hashref ) {
236 push( @resultsloop, $data );
246 $barcodetype, $title, $isbn, $itemtype,
247 $bcn, $dcn, $classif, $subclass,
248 $itemcallnumber, $author, $tmpl_id, $printingtype,
249 $guidebox, $startlabel
253 my $dbh = C4::Context->dbh;
254 my $query2 = "DELETE FROM labels_conf";
255 my $sth2 = $dbh->prepare($query2);
257 $query2 = "INSERT INTO labels_conf
258 ( barcodetype, title, isbn, itemtype, barcode,
259 dewey, class, subclass, itemcallnumber, author, printingtype,
260 guidebox, startlabel )
261 values ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )";
262 $sth2 = $dbh->prepare($query2);
264 $barcodetype, $title, $isbn, $itemtype,
265 $bcn, $dcn, $classif, $subclass,
266 $itemcallnumber, $author, $printingtype, $guidebox,
271 SetActiveTemplate($tmpl_id);
275 =item get_label_items;
277 $options = get_label_items()
280 Returns an array of references-to-hash, whos keys are the field from the biblio, biblioitems, items and labels tables in the Koha database.
285 sub get_label_items {
286 my $dbh = C4::Context->dbh;
288 # get the actual items to be printed.
290 my $query3 = " Select * from labels ";
291 my $sth = $dbh->prepare($query3);
294 my $cnt = $sth->rows;
296 while ( my $data = $sth->fetchrow_hashref ) {
298 # lets get some summary info from each item
300 " select * from biblio, biblioitems, items where itemnumber = ? and
301 items.biblioitemnumber=biblioitems.biblioitemnumber and
302 biblioitems.biblionumber=biblio.biblionumber";
304 my $sth1 = $dbh->prepare($query1);
305 $sth1->execute( $data->{'itemnumber'} );
306 my $data1 = $sth1->fetchrow_hashref();
308 push( @resultsloop, $data1 );
319 my ( $y_pos, $label_height, $fontsize, $x_pos, $left_text_margin,
320 $text_wrap_cols, $item, $conf_data )
323 $Text::Wrap::columns = $text_wrap_cols;
324 $Text::Wrap::separator = "\n";
328 my $top_text_margin = ( $fontsize + 3 );
329 my $line_spacer = ($fontsize); # number of pixels between text rows.
331 # add your printable fields manually in here
333 qw (dewey isbn classification itemtype subclass itemcallnumber);
334 my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) );
335 my $hPos = ( $x_pos + $left_text_margin );
337 foreach my $field (@fields) {
339 # if the display option for this field is selected in the DB,
340 # and the item record has some values for this field, display it.
341 if ( $$conf_data->{"$field"} && $$item->{"$field"} ) {
343 # warn "CONF_TYPE = $field";
346 $str = $$item->{"$field"};
348 # strip out naughty existing nl/cr's
352 # chop the string up into _upto_ 12 chunks
353 # and seperate the chunks with newlines
355 $str = wrap( "", "", "$str" );
356 $str = wrap( "", "", "$str" );
358 # split the chunks between newline's, into an array
359 my @strings = split /\n/, $str;
361 # then loop for each string line
362 foreach my $str (@strings) {
364 #warn "HPOS , VPOS $hPos, $vPos ";
365 prText( $hPos, $vPos, $str );
366 $vPos = $vPos - $line_spacer;
368 } # if field is valid
374 my ( $x_pos, $y_pos, $height, $width, $barcode, $barcodetype ) = @_;
375 $barcode = '123456789';
376 my $num_of_bars = length($barcode);
377 my $bar_width = ( ( $width / 10 ) * 8 ); # %80 of lenght of label width
380 my $guard_length = 10;
383 if ( $barcodetype eq 'Code39' ) {
384 $bar_length = '14.4333333333333';
386 ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
387 $xsize_ratio = ( $bar_width / $tot_bar_length );
389 PDF::Reuse::Barcode::Code39(
390 x => ( $x_pos + ( $width / 10 ) ),
391 y => ( $y_pos + ( $height / 10 ) ),
392 value => "*$barcode*",
393 ySize => ( .02 * $height ),
394 xSize => $xsize_ratio,
395 hide_asterisk => $xsize_ratio,
399 warn "$barcodetype, $barcode FAILED:$@";
403 elsif ( $barcodetype eq 'COOP2of5' ) {
404 $bar_length = '9.43333333333333';
406 ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
407 $xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
409 PDF::Reuse::Barcode::COOP2of5(
410 x => ( $x_pos + ( $width / 10 ) ),
411 y => ( $y_pos + ( $height / 10 ) ),
413 ySize => ( .02 * $height ),
414 xSize => $xsize_ratio,
418 warn "$barcodetype, $barcode FAILED:$@";
422 elsif ( $barcodetype eq 'Industrial2of5' ) {
423 $bar_length = '13.1333333333333';
425 ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
426 $xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
428 PDF::Reuse::Barcode::Industrial2of5(
429 x => ( $x_pos + ( $width / 10 ) ),
430 y => ( $y_pos + ( $height / 10 ) ),
432 ySize => ( .02 * $height ),
433 xSize => $xsize_ratio,
437 warn "$barcodetype, $barcode FAILED:$@";
440 my $moo2 = $tot_bar_length * $xsize_ratio;
442 warn " $x_pos, $y_pos, $barcode, $barcodetype\n";
444 "BAR_WDTH = $bar_width, TOT.BAR.LGHT=$tot_bar_length R*TOT.BAR =$moo2 \n";
447 =item build_circ_barcode;
449 build_circ_barcode( $x_pos, $y_pos, $barcode,
450 $barcodetype, \$item);
452 $item is the result of a previous call to get_label_items();
457 sub build_circ_barcode {
458 my ( $x_pos_circ, $y_pos, $value, $barcodetype, $item ) = @_;
460 #warn "value = $value\n";
464 if ( $barcodetype eq 'EAN13' ) {
466 #testing EAN13 barcodes hack
467 $value = $value . '000000000';
469 $value = substr( $value, 0, 12 );
473 PDF::Reuse::Barcode::EAN13(
474 x => ( $x_pos_circ + 27 ),
475 y => ( $y_pos + 15 ),
483 # added for xpdf compat. doesnt use type3 fonts., but increases filesize from 20k to 200k
484 # i think its embedding extra fonts in the pdf file.
489 $item->{'barcodeerror'} = 1;
491 #warn "EAN13BARCODE FAILED:$@";
497 elsif ( $barcodetype eq 'Code39' ) {
499 PDF::Reuse::Barcode::Code39(
500 x => ( $x_pos_circ + 9 ),
501 y => ( $y_pos + 15 ),
506 #hide_asterisk => $xsize_ratio,
510 $item->{'barcodeerror'} = 1;
512 #warn "CODE39BARCODE $value FAILED:$@";
519 elsif ( $barcodetype eq 'Matrix2of5' ) {
521 #warn "MATRIX ELSE:";
523 #testing MATRIX25 barcodes hack
524 # $value = $value.'000000000';
527 # $value = substr( $value, 0, 12 );
531 PDF::Reuse::Barcode::Matrix2of5(
532 x => ( $x_pos_circ + 27 ),
533 y => ( $y_pos + 15 ),
543 $item->{'barcodeerror'} = 1;
545 #warn "BARCODE FAILED:$@";
552 elsif ( $barcodetype eq 'EAN8' ) {
554 #testing ean8 barcodes hack
555 $value = $value . '000000000';
557 $value = substr( $value, 0, 8 );
563 PDF::Reuse::Barcode::EAN8(
564 x => ( $x_pos_circ + 42 ),
565 y => ( $y_pos + 15 ),
575 $item->{'barcodeerror'} = 1;
577 #warn "BARCODE FAILED:$@";
584 elsif ( $barcodetype eq 'UPC-E' ) {
586 PDF::Reuse::Barcode::UPCE(
587 x => ( $x_pos_circ + 27 ),
588 y => ( $y_pos + 15 ),
598 $item->{'barcodeerror'} = 1;
600 #warn "BARCODE FAILED:$@";
606 elsif ( $barcodetype eq 'NW7' ) {
608 PDF::Reuse::Barcode::NW7(
609 x => ( $x_pos_circ + 27 ),
610 y => ( $y_pos + 15 ),
620 $item->{'barcodeerror'} = 1;
622 #warn "BARCODE FAILED:$@";
628 elsif ( $barcodetype eq 'ITF' ) {
630 PDF::Reuse::Barcode::ITF(
631 x => ( $x_pos_circ + 27 ),
632 y => ( $y_pos + 15 ),
642 $item->{'barcodeerror'} = 1;
644 #warn "BARCODE FAILED:$@";
650 elsif ( $barcodetype eq 'Industrial2of5' ) {
652 PDF::Reuse::Barcode::Industrial2of5(
653 x => ( $x_pos_circ + 27 ),
654 y => ( $y_pos + 15 ),
663 $item->{'barcodeerror'} = 1;
665 #warn "BARCODE FAILED:$@";
671 elsif ( $barcodetype eq 'IATA2of5' ) {
673 PDF::Reuse::Barcode::IATA2of5(
674 x => ( $x_pos_circ + 27 ),
675 y => ( $y_pos + 15 ),
684 $item->{'barcodeerror'} = 1;
686 #warn "BARCODE FAILED:$@";
693 elsif ( $barcodetype eq 'COOP2of5' ) {
695 PDF::Reuse::Barcode::COOP2of5(
696 x => ( $x_pos_circ + 27 ),
697 y => ( $y_pos + 15 ),
706 $item->{'barcodeerror'} = 1;
708 #warn "BARCODE FAILED:$@";
714 elsif ( $barcodetype eq 'UPC-A' ) {
717 PDF::Reuse::Barcode::UPCA(
718 x => ( $x_pos_circ + 27 ),
719 y => ( $y_pos + 15 ),
728 $item->{'barcodeerror'} = 1;
730 #warn "BARCODE FAILED:$@";
739 =item draw_boundaries
741 sub draw_boundaries ($x_pos_spine, $x_pos_circ1, $x_pos_circ2,
742 $y_pos, $spine_width, $label_height, $circ_width)
744 This sub draws boundary lines where the label outlines are, to aid in printer testing, and debugging.
749 sub draw_boundaries {
752 $x_pos_spine, $x_pos_circ1, $x_pos_circ2, $y_pos,
753 $spine_width, $label_height, $circ_width
757 my $y_pos_initial = ( ( 792 - 36 ) - 90 );
758 $y_pos = $y_pos_initial;
761 for ( $i = 1 ; $i <= 8 ; $i++ ) {
763 &drawbox( $x_pos_spine, $y_pos, ($spine_width), ($label_height) );
765 #warn "OLD BOXES x=$x_pos_spine, y=$y_pos, w=$spine_width, h=$label_height";
766 &drawbox( $x_pos_circ1, $y_pos, ($circ_width), ($label_height) );
767 &drawbox( $x_pos_circ2, $y_pos, ($circ_width), ($label_height) );
769 $y_pos = ( $y_pos - $label_height );
776 sub drawbox { $lower_left_x, $lower_left_y,
777 $upper_right_x, $upper_right_y )
779 this is a low level sub, that draws a pdf box, it is called by draw_boxes
781 FYI: the $upper_right_x and $upper_right_y values are RELATIVE to $lower_left_x and $lower_left_y
783 and $lower_left_x, $lower_left_y are ABSOLUTE, this caught me out!
789 my ( $llx, $lly, $urx, $ury ) = @_;
791 # warn "llx,y= $llx,$lly , urx,y=$urx,$ury \n";
793 my $str = "q\n"; # save the graphic state
794 $str .= "0.5 w\n"; # border color red
795 $str .= "1.0 0.0 0.0 RG\n"; # border color red
796 $str .= "0.5 0.75 1.0 rg\n"; # fill color blue
797 $str .= "$llx $lly $urx $ury re\n"; # a rectangle
798 $str .= "B\n"; # fill (and a little more)
799 $str .= "Q\n"; # save the graphic state
805 END { } # module clean-up code here (global destructor)
814 Mason James <mason@katipo.co.nz>