package C4::Labels; # Copyright 2006 Katipo Communications. # # This file is part of Koha. # # Koha is free software; you can redistribute it and/or modify it under the # terms of the GNU General Public License as published by the Free Software # Foundation; either version 2 of the License, or (at your option) any later # version. # # Koha is distributed in the hope that it will be useful, but WITHOUT ANY # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR # A PARTICULAR PURPOSE. See the GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along with # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, # Suite 330, Boston, MA 02111-1307 USA use strict; require Exporter; use vars qw($VERSION @ISA @EXPORT); use PDF::Reuse; use Text::Wrap; $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); }; =head1 NAME C4::Labels - Functions for printing spine labels and barcodes in Koha =head1 FUNCTIONS =over 2 =cut @ISA = qw(Exporter); @EXPORT = qw( &get_label_options &get_label_items &build_circ_barcode &draw_boundaries &drawbox &GetActiveLabelTemplate &GetAllLabelTemplates &DeleteTemplate &GetSingleLabelTemplate &SaveTemplate &CreateTemplate &SetActiveTemplate &SaveConf &DrawSpineText &GetTextWrapCols &GetUnitsValue &DrawBarcode ); =item get_label_options; $options = get_label_options() 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; my $query2 = " SELECT * FROM labels_conf LIMIT 1 "; my $sth = $dbh->prepare($query2); $sth->execute(); my $conf_data = $sth->fetchrow_hashref; $sth->finish; 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; $query = "UPDATE labels_templates SET active = 1 WHERE tmpl_id = ?"; $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"; 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; 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; $query2 = "INSERT INTO labels_conf ( barcodetype, title, isbn, itemtype, barcode, dewey, class, subclass, itemcallnumber, author, printingtype, guidebox, startlabel ) values ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )"; $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() 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; # get the actual items to be printed. my @data; my $query3 = " Select * from labels "; my $sth = $dbh->prepare($query3); $sth->execute(); my @resultsloop; my $cnt = $sth->rows; my $i1 = 1; while ( my $data = $sth->fetchrow_hashref ) { # lets get some summary info from each item my $query1 = " select * from biblio, biblioitems, items where itemnumber = ? and items.biblioitemnumber=biblioitems.biblioitemnumber and biblioitems.biblionumber=biblio.biblionumber"; my $sth1 = $dbh->prepare($query1); $sth1->execute( $data->{'itemnumber'} ); my $data1 = $sth1->fetchrow_hashref(); push( @resultsloop, $data1 ); $sth1->finish; $i1++; } $sth->finish; 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 ); 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, hide_asterisk => $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, $barcodetype, \$item); $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 ) = @_; #warn "value = $value\n"; #$DB::single = 1; if ( $barcodetype eq 'EAN13' ) { #testing EAN13 barcodes hack $value = $value . '000000000'; $value =~ s/-//; $value = substr( $value, 0, 12 ); #warn $value; eval { PDF::Reuse::Barcode::EAN13( x => ( $x_pos_circ + 27 ), y => ( $y_pos + 15 ), value => $value, # prolong => 2.96, # xSize => 1.5, # ySize => 1.2, # added for xpdf compat. doesnt use type3 fonts., but increases filesize from 20k to 200k # i think its embedding extra fonts in the pdf file. # mode => 'graphic', ); }; if ($@) { $item->{'barcodeerror'} = 1; #warn "EAN13BARCODE FAILED:$@"; } #warn $barcodetype; } elsif ( $barcodetype eq 'Code39' ) { eval { PDF::Reuse::Barcode::Code39( x => ( $x_pos_circ + 9 ), y => ( $y_pos + 15 ), # prolong => 2.96, xSize => .85, ySize => 1.3, value => "*$value*", #hide_asterisk => $xsize_ratio, ); }; if ($@) { $item->{'barcodeerror'} = 1; #warn "CODE39BARCODE $value FAILED:$@"; } #warn $barcodetype; } elsif ( $barcodetype eq 'Matrix2of5' ) { #warn "MATRIX ELSE:"; #testing MATRIX25 barcodes hack # $value = $value.'000000000'; $value =~ s/-//; # $value = substr( $value, 0, 12 ); #warn $value; eval { PDF::Reuse::Barcode::Matrix2of5( x => ( $x_pos_circ + 27 ), y => ( $y_pos + 15 ), value => $value, # prolong => 2.96, # xSize => 1.5, # ySize => 1.2, ); }; if ($@) { $item->{'barcodeerror'} = 1; #warn "BARCODE FAILED:$@"; } #warn $barcodetype; } elsif ( $barcodetype eq 'EAN8' ) { #testing ean8 barcodes hack $value = $value . '000000000'; $value =~ s/-//; $value = substr( $value, 0, 8 ); #warn $value; #warn "EAN8 ELSEIF"; eval { PDF::Reuse::Barcode::EAN8( x => ( $x_pos_circ + 42 ), y => ( $y_pos + 15 ), value => $value, prolong => 2.96, xSize => 1.5, # ySize => 1.2, ); }; if ($@) { $item->{'barcodeerror'} = 1; #warn "BARCODE FAILED:$@"; } #warn $barcodetype; } elsif ( $barcodetype eq 'UPC-E' ) { eval { PDF::Reuse::Barcode::UPCE( x => ( $x_pos_circ + 27 ), y => ( $y_pos + 15 ), value => $value, prolong => 2.96, xSize => 1.5, # ySize => 1.2, ); }; if ($@) { $item->{'barcodeerror'} = 1; #warn "BARCODE FAILED:$@"; } #warn $barcodetype; } elsif ( $barcodetype eq 'NW7' ) { eval { PDF::Reuse::Barcode::NW7( x => ( $x_pos_circ + 27 ), y => ( $y_pos + 15 ), value => $value, prolong => 2.96, xSize => 1.5, # ySize => 1.2, ); }; if ($@) { $item->{'barcodeerror'} = 1; #warn "BARCODE FAILED:$@"; } #warn $barcodetype; } elsif ( $barcodetype eq 'ITF' ) { eval { PDF::Reuse::Barcode::ITF( x => ( $x_pos_circ + 27 ), y => ( $y_pos + 15 ), value => $value, prolong => 2.96, xSize => 1.5, # ySize => 1.2, ); }; if ($@) { $item->{'barcodeerror'} = 1; #warn "BARCODE FAILED:$@"; } #warn $barcodetype; } elsif ( $barcodetype eq 'Industrial2of5' ) { eval { PDF::Reuse::Barcode::Industrial2of5( x => ( $x_pos_circ + 27 ), y => ( $y_pos + 15 ), value => $value, prolong => 2.96, xSize => 1.5, # ySize => 1.2, ); }; if ($@) { $item->{'barcodeerror'} = 1; #warn "BARCODE FAILED:$@"; } #warn $barcodetype; } elsif ( $barcodetype eq 'IATA2of5' ) { eval { PDF::Reuse::Barcode::IATA2of5( x => ( $x_pos_circ + 27 ), y => ( $y_pos + 15 ), value => $value, prolong => 2.96, xSize => 1.5, # ySize => 1.2, ); }; if ($@) { $item->{'barcodeerror'} = 1; #warn "BARCODE FAILED:$@"; } #warn $barcodetype; } elsif ( $barcodetype eq 'COOP2of5' ) { eval { PDF::Reuse::Barcode::COOP2of5( x => ( $x_pos_circ + 27 ), y => ( $y_pos + 15 ), value => $value, prolong => 2.96, xSize => 1.5, # ySize => 1.2, ); }; if ($@) { $item->{'barcodeerror'} = 1; #warn "BARCODE FAILED:$@"; } #warn $barcodetype; } elsif ( $barcodetype eq 'UPC-A' ) { eval { PDF::Reuse::Barcode::UPCA( x => ( $x_pos_circ + 27 ), y => ( $y_pos + 15 ), value => $value, prolong => 2.96, xSize => 1.5, # ySize => 1.2, ); }; if ($@) { $item->{'barcodeerror'} = 1; #warn "BARCODE FAILED:$@"; } #warn $barcodetype; } } =item draw_boundaries sub draw_boundaries ($x_pos_spine, $x_pos_circ1, $x_pos_circ2, $y_pos, $spine_width, $label_height, $circ_width) This sub draws boundary lines where the label outlines are, to aid in printer testing, and debugging. =cut #' sub draw_boundaries { 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 ); $y_pos = $y_pos_initial; my $i = 1; for ( $i = 1 ; $i <= 8 ; $i++ ) { &drawbox( $x_pos_spine, $y_pos, ($spine_width), ($label_height) ); #warn "OLD BOXES x=$x_pos_spine, y=$y_pos, w=$spine_width, h=$label_height"; &drawbox( $x_pos_circ1, $y_pos, ($circ_width), ($label_height) ); &drawbox( $x_pos_circ2, $y_pos, ($circ_width), ($label_height) ); $y_pos = ( $y_pos - $label_height ); } } =item drawbox sub drawbox { $lower_left_x, $lower_left_y, $upper_right_x, $upper_right_y ) 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 .= "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 prAdd($str); } END { } # module clean-up code here (global destructor) 1; __END__ =back =head1 AUTHOR Mason James =cut