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);
32 C4::Labels - Functions for printing spine labels and barcodes in Koha
42 &get_label_options &get_label_items
43 &build_circ_barcode &draw_boundaries
47 =item get_label_options;
49 $options = get_label_options()
52 Return a pointer on a hash list containing info from labels_conf table in Koha DB.
56 sub get_label_options {
57 my $dbh = C4::Context->dbh;
58 my $query2 = " SELECT * FROM labels_conf LIMIT 1 ";
59 my $sth = $dbh->prepare($query2);
61 my $conf_data = $sth->fetchrow_hashref;
66 =item get_label_items;
68 $options = get_label_items()
71 Returns an array of references-to-hash, whos keys are the field from the biblio, biblioitems, items and labels tables in the Koha database.
76 my $dbh = C4::Context->dbh;
78 # get the actual items to be printed.
80 my $query3 = " Select * from labels ";
81 my $sth = $dbh->prepare($query3);
86 while ( my $data = $sth->fetchrow_hashref ) {
88 # lets get some summary info from each item
90 " select * from biblio, biblioitems, items where itemnumber = ? and
91 items.biblioitemnumber=biblioitems.biblioitemnumber and
92 biblioitems.biblionumber=biblio.biblionumber";
94 my $sth1 = $dbh->prepare($query1);
95 $sth1->execute( $data->{'itemnumber'} );
96 my $data1 = $sth1->fetchrow_hashref();
98 push( @resultsloop, $data1 );
107 =item build_circ_barcode;
109 build_circ_barcode( $x_pos, $y_pos, $barcode,
110 $barcodetype, \$item);
112 $item is the result of a previous call to get_label_items();
116 sub build_circ_barcode {
117 my ( $x_pos_circ, $y_pos, $value, $barcodetype, $item ) = @_;
121 #warn "value = $value\n";
125 if ( $barcodetype eq 'EAN13' ) {
127 #testing EAN13 barcodes hack
128 $value = $value . '000000000';
130 $value = substr( $value, 0, 12 );
134 PDF::Reuse::Barcode::EAN13(
135 x => ( $x_pos_circ + 27 ),
136 y => ( $y_pos + 15 ),
144 # added for xpdf compat. doesnt use type3 fonts., but increases filesize from 20k to 200k
145 # i think its embedding extra fonts in the pdf file.
150 $item->{'barcodeerror'} = 1;
151 #warn "EAN13BARCODE FAILED:$@";
157 elsif ( $barcodetype eq 'Code39' ) {
160 PDF::Reuse::Barcode::Code39(
161 x => ( $x_pos_circ + 9 ),
162 y => ( $y_pos + 15 ),
172 $item->{'barcodeerror'} = 1;
173 #warn "CODE39BARCODE $value FAILED:$@";
180 elsif ( $barcodetype eq 'Matrix2of5' ) {
182 #warn "MATRIX ELSE:";
184 #testing MATRIX25 barcodes hack
185 # $value = $value.'000000000';
188 # $value = substr( $value, 0, 12 );
192 PDF::Reuse::Barcode::Matrix2of5(
193 x => ( $x_pos_circ + 27 ),
194 y => ( $y_pos + 15 ),
204 $item->{'barcodeerror'} = 1;
205 #warn "BARCODE FAILED:$@";
212 elsif ( $barcodetype eq 'EAN8' ) {
214 #testing ean8 barcodes hack
215 $value = $value . '000000000';
217 $value = substr( $value, 0, 8 );
223 PDF::Reuse::Barcode::EAN8(
224 x => ( $x_pos_circ + 42 ),
225 y => ( $y_pos + 15 ),
235 $item->{'barcodeerror'} = 1;
236 #warn "BARCODE FAILED:$@";
243 elsif ( $barcodetype eq 'UPC-E' ) {
245 PDF::Reuse::Barcode::UPCE(
246 x => ( $x_pos_circ + 27 ),
247 y => ( $y_pos + 15 ),
257 $item->{'barcodeerror'} = 1;
258 #warn "BARCODE FAILED:$@";
264 elsif ( $barcodetype eq 'NW7' ) {
266 PDF::Reuse::Barcode::NW7(
267 x => ( $x_pos_circ + 27 ),
268 y => ( $y_pos + 15 ),
278 $item->{'barcodeerror'} = 1;
279 #warn "BARCODE FAILED:$@";
285 elsif ( $barcodetype eq 'ITF' ) {
287 PDF::Reuse::Barcode::ITF(
288 x => ( $x_pos_circ + 27 ),
289 y => ( $y_pos + 15 ),
299 $item->{'barcodeerror'} = 1;
300 #warn "BARCODE FAILED:$@";
306 elsif ( $barcodetype eq 'Industrial2of5' ) {
308 PDF::Reuse::Barcode::Industrial2of5(
309 x => ( $x_pos_circ + 27 ),
310 y => ( $y_pos + 15 ),
319 $item->{'barcodeerror'} = 1;
320 #warn "BARCODE FAILED:$@";
326 elsif ( $barcodetype eq 'IATA2of5' ) {
328 PDF::Reuse::Barcode::IATA2of5(
329 x => ( $x_pos_circ + 27 ),
330 y => ( $y_pos + 15 ),
339 $item->{'barcodeerror'} = 1;
340 #warn "BARCODE FAILED:$@";
347 elsif ( $barcodetype eq 'COOP2of5' ) {
349 PDF::Reuse::Barcode::COOP2of5(
350 x => ( $x_pos_circ + 27 ),
351 y => ( $y_pos + 15 ),
360 $item->{'barcodeerror'} = 1;
361 #warn "BARCODE FAILED:$@";
367 elsif ( $barcodetype eq 'UPC-A' ) {
370 PDF::Reuse::Barcode::UPCA(
371 x => ( $x_pos_circ + 27 ),
372 y => ( $y_pos + 15 ),
381 $item->{'barcodeerror'} = 1;
382 #warn "BARCODE FAILED:$@";
391 =item draw_boundaries
393 sub draw_boundaries ($x_pos_spine, $x_pos_circ1, $x_pos_circ2,
394 $y_pos, $spine_width, $label_height, $circ_width)
396 This sub draws boundary lines where the label outlines are, to aid in printer testing, and debugging.
401 sub draw_boundaries {
403 my ($x_pos_spine, $x_pos_circ1, $x_pos_circ2,
404 $y_pos, $spine_width, $label_height, $circ_width) = @_;
406 my $y_pos_initial = ( ( 792 - 36 ) - 90 );
407 my $y_pos = $y_pos_initial;
410 for ( $i = 1 ; $i <= 8 ; $i++ ) {
412 &drawbox( $x_pos_spine, $y_pos, ($spine_width), ($label_height) );
414 #warn "OLD BOXES x=$x_pos_spine, y=$y_pos, w=$spine_width, h=$label_height";
415 &drawbox( $x_pos_circ1, $y_pos, ($circ_width), ($label_height) );
416 &drawbox( $x_pos_circ2, $y_pos, ($circ_width), ($label_height) );
418 $y_pos = ( $y_pos - $label_height );
425 sub drawbox { $lower_left_x, $lower_left_y,
426 $upper_right_x, $upper_right_y )
428 this is a low level sub, that draws a pdf box, it is called by draw_boxes
434 my ( $llx, $lly, $urx, $ury ) = @_;
436 my $str = "q\n"; # save the graphic state
437 $str .= "1.0 0.0 0.0 RG\n"; # border color red
438 $str .= "1 1 1 rg\n"; # fill color blue
439 $str .= "$llx $lly $urx $ury re\n"; # a rectangle
440 $str .= "B\n"; # fill (and a little more)
441 $str .= "Q\n"; # save the graphic state
447 END { } # module clean-up code here (global destructor)
456 Mason James <mason@katipo.co.nz>