X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FLabels.pm;h=43fa99d4e36cdebd4fac83200b27d2e81380c16b;hb=8705e18aa5d9fe3f59625d84ee6360645c28c1c4;hp=933506b1de37721b1697062673cba62890d23281;hpb=2ffd5b7228f4e638583162d483e1dd2febeafe1b;p=koha_gimpoz diff --git a/C4/Labels.pm b/C4/Labels.pm old mode 100755 new mode 100644 index 933506b1de..43fa99d4e3 --- a/C4/Labels.pm +++ b/C4/Labels.pm @@ -1,816 +1,13 @@ 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 +BEGIN { + use version; our $VERSION = qv('1.0.0_1'); -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; + use C4::Labels::Batch 1.000000; + use C4::Labels::Label 1.000000; + use C4::Labels::Layout 1.000000; + use C4::Labels::Profile 1.000000; + use C4::Labels::Template 1.000000; } -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 -