X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FLabels.pm;h=428be025363a20d3a0337e12eb6dbf68dc67e527;hb=9f5a1bc7ebbe3954607da88b87bab6e9c2689dad;hp=a0081998db22bf25765406b86b4bb0c87140cd90;hpb=36896c6c4fb7723087e93a2839be1006b473a86a;p=koha.git diff --git a/C4/Labels.pm b/C4/Labels.pm index a0081998db..428be02536 100644 --- a/C4/Labels.pm +++ b/C4/Labels.pm @@ -1,1553 +1,12 @@ 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; -use vars qw($VERSION @ISA @EXPORT); - -use PDF::Reuse; -use Text::Wrap; -use Algorithm::CheckDigits; -use C4::Members; -use C4::Branch; -# use Data::Dumper; -# use Smart::Comments; - BEGIN { - $VERSION = 0.03; - require Exporter; - @ISA = qw(Exporter); - @EXPORT = qw( - &get_label_options &GetLabelItems - &build_circ_barcode &draw_boundaries - &drawbox &GetActiveLabelTemplate - &GetAllLabelTemplates &DeleteTemplate - &GetSingleLabelTemplate &SaveTemplate - &CreateTemplate &SetActiveTemplate - &SaveConf &DrawSpineText &GetTextWrapCols - &GetUnitsValue &DrawBarcode &DrawPatronCardText - &get_printingtypes &GetPatronCardItems - &get_layouts - &get_barcode_types - &get_batches &delete_batch - &add_batch &printText - &GetItemFields - &get_text_fields - get_layout &save_layout &add_layout - &set_active_layout &by_order - &build_text_dropbox - &delete_layout &get_active_layout - &get_highest_batch - &deduplicate_batch - &GetAllPrinterProfiles &GetSinglePrinterProfile - &SaveProfile &CreateProfile &DeleteProfile - &GetAssociatedProfile &SetAssociatedProfile - ); -} - -my $DEBUG = 0; - -=head1 NAME - -C4::Labels - Functions for printing spine labels and barcodes in Koha - -=head1 FUNCTIONS - -=over 2 - -=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 where active = 1"; - my $sth = $dbh->prepare($query2); - $sth->execute(); - my $conf_data = $sth->fetchrow_hashref; - $sth->finish; - return $conf_data; -} - -sub get_layouts { - -## FIXME: this if/else could be compacted... - my $dbh = C4::Context->dbh; - my @data; - my $query = " Select * from labels_conf"; - my $sth = $dbh->prepare($query); - $sth->execute(); - my @resultsloop; - while ( my $data = $sth->fetchrow_hashref ) { - - $data->{'fieldlist'} = get_text_fields( $data->{'id'} ); - push( @resultsloop, $data ); - } - $sth->finish; - - # @resultsloop - - return @resultsloop; -} - -sub get_layout { - my ($layout_id) = @_; - my $dbh = C4::Context->dbh; - - # get the actual items to be printed. - my $query = " Select * from labels_conf where id = ?"; - my $sth = $dbh->prepare($query); - $sth->execute($layout_id); - my $data = $sth->fetchrow_hashref; - $sth->finish; - return $data; -} - -sub get_active_layout { - my ($layout_id) = @_; - my $dbh = C4::Context->dbh; - - # get the actual items to be printed. - my $query = " Select * from labels_conf where active = 1"; - my $sth = $dbh->prepare($query); - $sth->execute(); - my $data = $sth->fetchrow_hashref; - $sth->finish; - return $data; -} - -sub delete_layout { - my ($layout_id) = @_; - my $dbh = C4::Context->dbh; - - # get the actual items to be printed. - my $query = "delete from labels_conf where id = ?"; - my $sth = $dbh->prepare($query); - $sth->execute($layout_id); - $sth->finish; -} - -sub get_printingtypes { - my ($layout_id) = @_; - my @printtypes; -# FIXME: hard coded print types - push( @printtypes, { code => 'BAR', desc => "barcode" } ); - push( @printtypes, { code => 'BIB', desc => "biblio" } ); - push( @printtypes, { code => 'BARBIB', desc => "barcode / biblio" } ); - push( @printtypes, { code => 'BIBBAR', desc => "biblio / barcode" } ); - push( @printtypes, { code => 'ALT', desc => "alternating labels" } ); - push( @printtypes, { code => 'PATCRD', desc => "patron cards" } ); - - my $conf = get_layout($layout_id); - my $active_printtype = $conf->{'printingtype'}; - - # lop thru layout, insert selected to hash - - foreach my $printtype (@printtypes) { - if ( $printtype->{'code'} eq $active_printtype ) { - $printtype->{'active'} = 'MOO'; - } - } - return @printtypes; -} - -sub build_text_dropbox { - my ($order) = @_; - - # my @fields = get_text_fields(); - # my $field_count = scalar @fields; - my $field_count = 10; # <----------- FIXME hard coded - - my @lines; - !$order - ? push( @lines, { num => '', selected => '1' } ) - : push( @lines, { num => '' } ); - for ( my $i = 1 ; $i <= $field_count ; $i++ ) { - my $line = { num => "$i" }; - $line->{'selected'} = 1 if $i eq $order; - push( @lines, $line ); - } - - # add a blank row too - - return @lines; -} - -sub get_text_fields { - my ($layout_id, $sorttype) = @_; - - my ( $a, $b, $c, $d, $e, $f, $g, $h, $i ,$j, $k ); - - my $sortorder = get_layout($layout_id); - - # FIXME: This is all hardcoded and should be user selectable I think or are these the only text fields? -fbcit - $a = { - code => 'itemtype', - desc => "Item Type", - order => $sortorder->{'itemtype'} - }; - - $b = { - code => 'dewey', - desc => "Dewey", - order => $sortorder->{'dewey'} - }; - - $c = { - code => 'issn', - desc => "ISSN", - order => $sortorder->{'issn'} - }; - - $d = { - code => 'isbn', - desc => "ISBN", - order => $sortorder->{'isbn'} - }; - - $e = { - code => 'class', - desc => "Classification", - order => $sortorder->{'class'} - }; - - $f = { - code => 'subclass', - desc => "Sub-Class", - order => $sortorder->{'subclass'} - }; - - $g = { - code => 'barcode', - desc => "Barcode", - order => $sortorder->{'barcode'} - }; - - $h = { - code => 'author', - desc => "Author", - order => $sortorder->{'author'} - }; - - $i = { - code => 'title', - desc => "Title", - order => $sortorder->{'title'} - }; - - $j = { - code => 'itemcallnumber', - desc => "Call Number", - order => $sortorder->{'itemcallnumber'} - }; - - $k = { - code => 'subtitle', - desc => "Subtitle", - order => $sortorder->{'subtitle'} - }; - - my @text_fields = ( $a, $b, $c, $d, $e, $f, $g, $h, $i ,$j, $k ); - - my @new_fields; - foreach my $field (@text_fields) { - push( @new_fields, $field ) if $field->{'order'} > 0; - } - - my @sorted_fields = sort by_order @new_fields; - - my $active_fields; - - if ($sorttype eq 'codes') { # FIXME: This sub should really always return the array of hashrefs and let the caller take what he wants from that -fbcit - return @sorted_fields; - } else { - foreach my $field (@sorted_fields) { - $active_fields .= "$field->{'desc'} "; - } - return $active_fields; - } - -} - -sub by_order { - $$a{order} <=> $$b{order}; -} - -=head2 sub add_batch -=over 4 - add_batch($batch_type,\@batch_list); - if $batch_list is supplied, - create a new batch with those items. - else, return the next available batch_id. -=return -=cut -sub add_batch { - my ( $batch_type,$batch_list ) = @_; - my $new_batch; - my $dbh = C4::Context->dbh; - my $q ="SELECT MAX(DISTINCT batch_id) FROM $batch_type"; - my $sth = $dbh->prepare($q); - $sth->execute(); - my ($batch_id) = $sth->fetchrow_array; - $sth->finish; - if($batch_id) { - $batch_id++; - } else { - $batch_id = 1; - } - # TODO: let this block use $batch_type - if(ref($batch_list) && ($batch_type eq 'labels') ) { - my $sth = $dbh->prepare("INSERT INTO labels (`batch_id`,`itemnumber`) VALUES (?,?)"); - for my $item (@$batch_list) { - $sth->execute($batch_id,$item); - } - } - return $batch_id; -} - -#FIXME: Needs to be ported to receive $batch_type -# ... this looks eerily like add_batch() ... -sub get_highest_batch { - my $new_batch; - my $dbh = C4::Context->dbh; - my $q = - "select distinct batch_id from labels order by batch_id desc limit 1"; - my $sth = $dbh->prepare($q); - $sth->execute(); - my $data = $sth->fetchrow_hashref; - $sth->finish; - - if ( !$data->{'batch_id'} ) { - $new_batch = 1; - } - else { - $new_batch = $data->{'batch_id'}; - } - - return $new_batch; -} - - -sub get_batches { - my ( $batch_type ) = @_; - my $dbh = C4::Context->dbh; - my $q = "SELECT batch_id, COUNT(*) AS num FROM $batch_type GROUP BY batch_id"; - my $sth = $dbh->prepare($q); - $sth->execute(); - my @resultsloop; - while ( my $data = $sth->fetchrow_hashref ) { - push( @resultsloop, $data ); - } - $sth->finish; - -# Not sure why we are doing this rather than simply telling the user that no batches are currently defined. -# So I'm commenting this out and modifying label-manager.tmpl to properly inform the user as stated. -fbcit - # adding a dummy batch=1 value , if none exists in the db -# if ( !scalar(@resultsloop) ) { -# push( @resultsloop, { batch_id => '1' , num => '0' } ); -# } - return @resultsloop; -} - -sub delete_batch { - my ($batch_id, $batch_type) = @_; - warn "Deleteing batch of type $batch_type"; - my $dbh = C4::Context->dbh; - my $q = "DELETE FROM $batch_type WHERE batch_id = ?"; - my $sth = $dbh->prepare($q); - $sth->execute($batch_id); - $sth->finish; -} - -sub get_barcode_types { - my ($layout_id) = @_; - my $layout = get_layout($layout_id); - my $barcode = $layout->{'barcodetype'}; - my @array; - - push( @array, { code => 'CODE39', desc => 'Code 39' } ); - push( @array, { code => 'CODE39MOD', desc => 'Code39 + Modulo43' } ); - push( @array, { code => 'CODE39MOD10', desc => 'Code39 + Modulo10' } ); - push( @array, { code => 'ITF', desc => 'Interleaved 2 of 5' } ); - - foreach my $line (@array) { - if ( $line->{'code'} eq $barcode ) { - $line->{'active'} = 1; - } - - } - return @array; -} - -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' ); - return $unitvalue; -} - -sub GetTextWrapCols { - my ( $font, $fontsize, $label_width, $left_text_margin ) = @_; - my $string = '0'; - my $strwidth; - my $count = 0; -# my $textlimit = $label_width - ($left_text_margin); - my $textlimit = $label_width - ( 2* $left_text_margin); - - while ( $strwidth < $textlimit ) { - $strwidth = prStrWidth( $string, $font, $fontsize ); - $string = $string . '0'; - #warn "strwidth:$strwidth, textlimit:$textlimit, count:$count string:$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_id) = @_; - my $dbh = C4::Context->dbh; - my $query = " SELECT * FROM labels_templates where tmpl_id = ?"; - my $sth = $dbh->prepare($query); - $sth->execute($tmpl_id); - my $template = $sth->fetchrow_hashref; - $sth->finish; - return $template; -} - -sub SetActiveTemplate { - - my ($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 set_active_layout { - - my ($layout_id) = @_; - my $dbh = C4::Context->dbh; - my $query = " UPDATE labels_conf SET active = NULL"; - my $sth = $dbh->prepare($query); - $sth->execute(); - - $query = "UPDATE labels_conf SET active = 1 WHERE id = ?"; - $sth = $dbh->prepare($query); - $sth->execute($layout_id); - $sth->finish; -} - -sub DeleteTemplate { - my ($tmpl_id) = @_; - my $dbh = C4::Context->dbh; - my $query = " DELETE FROM labels_templates where tmpl_id = ?"; - my $sth = $dbh->prepare($query); - $sth->execute($tmpl_id); - $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, $font, $fontsize, $units - ) = @_; - warn "Passed \$font:$font"; - 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=?, font=?, 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, - $font, $fontsize, $units, $tmpl_id - ); - my $dberror = $sth->errstr; - $sth->finish; - return $dberror; -} - -sub CreateTemplate { - my $tmpl_id; - my ( - $tmpl_code, $tmpl_desc, $page_width, $page_height, - $label_width, $label_height, $topmargin, $leftmargin, - $cols, $rows, $colgap, $rowgap, - $font, $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, font, 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, - $font, $fontsize, $units - ); - my $dberror = $sth->errstr; - $sth->finish; - return $dberror; -} - -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 { -sub add_layout { - - my ( - $barcodetype, $title, $subtitle, $isbn, $issn, - $itemtype, $bcn, $dcn, $classif, - $subclass, $itemcallnumber, $author, $tmpl_id, - $printingtype, $guidebox, $startlabel, $layoutname - ) = @_; - - my $dbh = C4::Context->dbh; - my $query2 = "update labels_conf set active = NULL"; - my $sth2 = $dbh->prepare($query2); - $sth2->execute(); - $query2 = "INSERT INTO labels_conf - ( barcodetype, title, subtitle, isbn,issn, itemtype, barcode, - dewey, class, subclass, itemcallnumber, author, printingtype, - guidebox, startlabel, layoutname, active ) - values ( ?, ?, ?, ?, ?, ?, ?, ?,?, ?, ?, ?, ?, ?,?,?, 1 )"; - $sth2 = $dbh->prepare($query2); - $sth2->execute( - $barcodetype, $title, $subtitle, $isbn, $issn, - - $itemtype, $bcn, $dcn, $classif, - $subclass, $itemcallnumber, $author, $printingtype, - $guidebox, $startlabel, $layoutname - ); - $sth2->finish; - - SetActiveTemplate($tmpl_id); - return; -} - -sub save_layout { - - my ( - $barcodetype, $title, $subtitle, $isbn, $issn, - $itemtype, $bcn, $dcn, $classif, - $subclass, $itemcallnumber, $author, $tmpl_id, - $printingtype, $guidebox, $startlabel, $layoutname, - $layout_id - ) = @_; -### $layoutname -### $layout_id - - my $dbh = C4::Context->dbh; - my $query2 = "update labels_conf set - barcodetype=?, title=?, subtitle=?, isbn=?,issn=?, - itemtype=?, barcode=?, dewey=?, class=?, - subclass=?, itemcallnumber=?, author=?, printingtype=?, - guidebox=?, startlabel=?, layoutname=? where id = ?"; - my $sth2 = $dbh->prepare($query2); - $sth2->execute( - $barcodetype, $title, $subtitle, $isbn, $issn, - $itemtype, $bcn, $dcn, $classif, - $subclass, $itemcallnumber, $author, $printingtype, - $guidebox, $startlabel, $layoutname, $layout_id - ); - $sth2->finish; - - return; -} - -=item GetAllPrinterProfiles; - - @profiles = GetAllPrinterProfiles() - -Returns an array of references-to-hash, whos keys are ..... - -=cut - -sub GetAllPrinterProfiles { - - my $dbh = C4::Context->dbh; - my @data; - my $query = "SELECT * FROM printers_profile AS pp INNER JOIN labels_templates AS lt ON pp.tmpl_id = lt.tmpl_id; "; - my $sth = $dbh->prepare($query); - $sth->execute(); - my @resultsloop; - while ( my $data = $sth->fetchrow_hashref ) { - push( @resultsloop, $data ); - } - $sth->finish; - - return @resultsloop; -} - -=item GetSinglePrinterProfile; - - $profile = GetSinglePrinterProfile() - -Returns a hashref whos keys are... - -=cut - -sub GetSinglePrinterProfile { - my ($prof_id) = @_; - my $dbh = C4::Context->dbh; - my $query = " SELECT * FROM printers_profile WHERE prof_id = ?; "; - my $sth = $dbh->prepare($query); - $sth->execute($prof_id); - my $template = $sth->fetchrow_hashref; - $sth->finish; - return $template; -} - -=item SaveProfile; - - SaveProfile('parameters') - -When passed a set of parameters, this function updates the given profile with the new parameters. - -=cut - -sub SaveProfile { - my ( - $prof_id, $offset_horz, $offset_vert, $creep_horz, $creep_vert, $units - ) = @_; - my $dbh = C4::Context->dbh; - my $query = - " UPDATE printers_profile - SET offset_horz=?, offset_vert=?, creep_horz=?, creep_vert=?, unit=? - WHERE prof_id = ? "; - my $sth = $dbh->prepare($query); - $sth->execute( - $offset_horz, $offset_vert, $creep_horz, $creep_vert, $units, $prof_id - ); - $sth->finish; -} - -=item CreateProfile; - - CreateProfile('parameters') - -When passed a set of parameters, this function creates a new profile containing those parameters -and returns any errors. - -=cut - -sub CreateProfile { - my ( - $prof_id, $printername, $paper_bin, $tmpl_id, $offset_horz, - $offset_vert, $creep_horz, $creep_vert, $units - ) = @_; - my $dbh = C4::Context->dbh; - my $query = - " INSERT INTO printers_profile (prof_id, printername, paper_bin, tmpl_id, - offset_horz, offset_vert, creep_horz, creep_vert, unit) - VALUES(?,?,?,?,?,?,?,?,?) "; - my $sth = $dbh->prepare($query); - $sth->execute( - $prof_id, $printername, $paper_bin, $tmpl_id, $offset_horz, - $offset_vert, $creep_horz, $creep_vert, $units - ); - my $error = $sth->errstr; - $sth->finish; - return $error; -} - -=item DeleteProfile; - - DeleteProfile(prof_id) - -When passed a profile id, this function deletes that profile from the database and returns any errors. - -=cut - -sub DeleteProfile { - my ($prof_id) = @_; - my $dbh = C4::Context->dbh; - my $query = " DELETE FROM printers_profile WHERE prof_id = ?"; - my $sth = $dbh->prepare($query); - $sth->execute($prof_id); - my $error = $sth->errstr; - $sth->finish; - return $error; -} - -=item GetAssociatedProfile; - - $assoc_prof = GetAssociatedProfile(tmpl_id) - -When passed a template id, this function returns the parameters from the currently associated printer profile -in a hashref where key=fieldname and value=fieldvalue. - -=cut - -sub GetAssociatedProfile { - my ($tmpl_id) = @_; - my $dbh = C4::Context->dbh; - # First we find out the prof_id for the associated profile... - my $query = "SELECT * FROM labels_profile WHERE tmpl_id = ?"; - my $sth = $dbh->prepare($query); - $sth->execute($tmpl_id); - my $assoc_prof = $sth->fetchrow_hashref; - $sth->finish; - # Then we retrieve that profile and return it to the caller... - $assoc_prof = GetSinglePrinterProfile($assoc_prof->{'prof_id'}); - return $assoc_prof; -} - -=item SetAssociatedProfile; - - SetAssociatedProfile($prof_id, $tmpl_id) - -When passed both a profile id and template id, this function establishes an association between the two. No more -than one profile may be associated with any given template at the same time. - -=cut - -sub SetAssociatedProfile { - - my ($prof_id, $tmpl_id) = @_; - - my $dbh = C4::Context->dbh; - my $query = "INSERT INTO labels_profile (prof_id, tmpl_id) VALUES (?,?) ON DUPLICATE KEY UPDATE prof_id = ?"; - my $sth = $dbh->prepare($query); - $sth->execute($prof_id, $tmpl_id, $prof_id); - $sth->finish; -} - -=item GetLabelItems; - - $options = GetLabelItems() - -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 GetLabelItems { - my ($batch_id) = @_; - my $dbh = C4::Context->dbh; - - my @resultsloop = (); - my $count; - my @data; - my $sth; - - if ($batch_id) { - my $query3 = "Select * from labels where batch_id = ? order by labelid "; - $sth = $dbh->prepare($query3); - $sth->execute($batch_id); - - } - else { - - my $query3 = "Select * from labels"; - $sth = $dbh->prepare($query3); - $sth->execute(); - } - my $cnt = $sth->rows; - my $i1 = 1; - while ( my $data = $sth->fetchrow_hashref ) { - - # lets get some summary info from each item - my $query1 = " - select i.*, bi.*, b.* from items i,biblioitems bi,biblio b - where itemnumber=? and i.biblioitemnumber=bi.biblioitemnumber and - bi.biblionumber=b.biblionumber"; - - my $sth1 = $dbh->prepare($query1); - $sth1->execute( $data->{'itemnumber'} ); - - my $data1 = $sth1->fetchrow_hashref(); - $data1->{'labelno'} = $i1; - $data1->{'labelid'} = $data->{'labelid'}; - $data1->{'batch_id'} = $batch_id; - $data1->{'summary'} = - "$data1->{'barcode'}, $data1->{'title'}, $data1->{'isbn'}"; - - push( @resultsloop, $data1 ); - $sth1->finish; - - $i1++; - } - $sth->finish; - return @resultsloop; - -} - -sub GetItemFields { - my @fields = qw ( - barcode title subtitle - dewey isbn issn author class - itemtype subclass itemcallnumber - - ); - return @fields; -} - -sub GetPatronCardItems { - - my ( $batch_id ) = @_; - my @resultsloop; - - my $dbh = C4::Context->dbh; -# my $query = "SELECT * FROM patroncards WHERE batch_id = ? ORDER BY borrowernumber"; - my $query = "SELECT * FROM patroncards WHERE batch_id = ? ORDER BY cardid"; - my $sth = $dbh->prepare($query); - $sth->execute($batch_id); - my $cardno = 1; - while ( my $data = $sth->fetchrow_hashref ) { - my $patron_data = GetMember( $data->{'borrowernumber'} ); - $patron_data->{'branchname'} = GetBranchName( $patron_data->{'branchcode'} ); - $patron_data->{'cardno'} = $cardno; - $patron_data->{'cardid'} = $data->{'cardid'}; - $patron_data->{'batch_id'} = $batch_id; - push( @resultsloop, $patron_data ); - $cardno++; - } - $sth->finish; - return @resultsloop; - -} - -sub deduplicate_batch { - my ( $batch_id, $batch_type ) = @_; - my $query = " - SELECT DISTINCT - batch_id," . (($batch_type eq 'labels') ? 'itemnumber' : 'borrowernumber') . ", - count(". (($batch_type eq 'labels') ? 'labelid' : 'cardid') . ") as count - FROM $batch_type - WHERE batch_id = ? - GROUP BY " . (($batch_type eq 'labels') ? 'itemnumber' : 'borrowernumber') . ",batch_id - HAVING count > 1 - ORDER BY batch_id, - count DESC "; - my $sth = C4::Context->dbh->prepare($query); - $sth->execute($batch_id); - warn $sth->errstr if $sth->errstr; - $sth->rows or return undef, $sth->errstr; - - my $del_query = " - DELETE - FROM $batch_type - WHERE batch_id = ? - AND " . (($batch_type eq 'labels') ? 'itemnumber' : 'borrowernumber') . " = ? - ORDER BY timestamp ASC - "; - my $killed = 0; - while (my $data = $sth->fetchrow_hashref()) { - my $itemnumber = $data->{(($batch_type eq 'labels') ? 'itemnumber' : 'borrowernumber')} or next; - my $limit = $data->{count} - 1 or next; - my $sth2 = C4::Context->dbh->prepare("$del_query LIMIT $limit"); - # die sprintf "$del_query LIMIT %s\n (%s, %s)", $limit, $batch_id, $itemnumber; - # $sth2->execute($batch_id, C4::Context->dbh->quote($data->{itemnumber}), $data->{count} - 1) - $sth2->execute($batch_id, $itemnumber) and - $killed += ($data->{count} - 1); - warn $sth2->errstr if $sth2->errstr; - } - return $killed, undef; -} - -sub DrawSpineText { - - my ( $x_pos, $y_pos, $label_height, $label_width, $fontname, $fontsize, $left_text_margin, - $text_wrap_cols, $item, $conf_data, $printingtype, $nowrap ) - = @_; -# hack to fix column name mismatch betwen labels_conf.class, and bibitems.classification - $$item->{'class'} = $$item->{'classification'}; - - $Text::Wrap::columns = $text_wrap_cols; - $Text::Wrap::separator = "\n"; - - my $str; - - my $top_text_margin = ( $fontsize + 3 ); #FIXME: This should be a template parameter and passed in... - my $line_spacer = ( $fontsize * 1 ); # number of pixels between text rows (This is actually leading: baseline to baseline minus font size. Recommended starting point is 20% of font size.). - - my $layout_id = $$conf_data->{'id'}; - - my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) ); - my $font = prFont($fontname); - - my @str_fields = get_text_fields($layout_id, 'codes' ); - my @fields; - foreach my $field (@str_fields) { - push (@fields, $field->{'code'}); - } - - foreach my $field (@fields) { - - # testing hack -# $$item->{"$field"} = $field . ": " . $$item->{"$field"}; - - # 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; - my @strings; - if (($nowrap == 0) || (!$nowrap)) { - # wrap lines based on segmentation markers: '/' (other types of segmentation markers can be added as needed here or this could be added as a syspref.) - - while ( $str =~ /\// ) { - $str =~ /^(.*)\/(.*)$/; - - #warn "\$2=$2"; - unshift @strings, $2; - $str = $1; - } - unshift @strings, $str; - } else { - push @strings, $str; # if we are not wrapping the call number just send it along as we found it... - } - - # strip out division slashes - #$str =~ s/\///g; - #warn "\$str after striping division marks: $str"; - # 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) { - my $hPos; - if ( $printingtype eq 'BIB' ) { #FIXME: This is a hack and needs to be implimented as a text justification option in the template... - # some code to try and center each line on the label based on font size and string point width... - my $stringwidth = prStrWidth($str, $fontname, $fontsize); - my $whitespace = ( $label_width - ( $stringwidth + (2 * $left_text_margin) ) ); - $hPos = ( ( $whitespace / 2 ) + $x_pos + $left_text_margin ); - #warn "\$label_width=$label_width \$stringwidth=$stringwidth \$whitespace=$whitespace \$left_text_margin=$left_text_margin for $str\n"; - } else { - $hPos = ( $x_pos + $left_text_margin ); - } - PrintText( $hPos, $vPos, $font, $fontsize, $str ); - $vPos = $vPos - $line_spacer; - - } - } # if field is - } #foreach feild -} - -sub PrintText { - my ( $hPos, $vPos, $font, $fontsize, $text ) = @_; - my $str = "BT /$font $fontsize Tf $hPos $vPos Td ($text) Tj ET"; - prAdd($str); -} - -sub DrawPatronCardText { - - my ( $x_pos, $y_pos, $label_height, $label_width, $fontname, $fontsize, $left_text_margin, - $text_wrap_cols, $text, $printingtype ) - = @_; - - my $top_text_margin = 25; #FIXME: This should be a template parameter and passed in... - - my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) ); - my $font = prFont($fontname); - - my $hPos; - - foreach my $line (keys %$text) { - warn "Current text is \"$line\" and font size for \"$line\" is $text->{$line} points"; - # some code to try and center each line on the label based on font size and string point width... - my $stringwidth = prStrWidth($line, $fontname, $text->{$line}); - my $whitespace = ( $label_width - ( $stringwidth + (2 * $left_text_margin) ) ); - $hPos = ( ( $whitespace / 2 ) + $x_pos + $left_text_margin ); - - PrintText( $hPos, $vPos, $font, $text->{$line}, $line ); - my $line_spacer = ( $text->{$line} * 1 ); # number of pixels between text rows (This is actually leading: baseline to baseline minus font size. Recommended starting point is 20% (0.20) of font size.). - $vPos = $vPos - ($line_spacer + $text->{$line}); # Linefeed equiv: leading + font size - } -} - -# Not used anywhere. - -#sub SetFontSize { -# -# my ($fontsize) = @_; -#### fontsize -# my $str = "BT/F13 30 Tf288 720 Td( AAAAAAAAAA ) TjET"; -# prAdd($str); -#} - -sub DrawBarcode { - - # x and y are from the top-left :) - my ( $x_pos, $y_pos, $height, $width, $barcode, $barcodetype ) = @_; - my $num_of_bars = length($barcode); - my $bar_width = $width * .8; # %80 of length of label width - my $tot_bar_length; - my $bar_length; - my $guard_length = 10; - my $xsize_ratio; - - if ( $barcodetype eq 'CODE39' ) { - $bar_length = '17.5'; - $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 => 1, - ); - }; - if ($@) { - warn "$barcodetype, $barcode FAILED:$@"; - } - } - - elsif ( $barcodetype eq 'CODE39MOD' ) { - - # get modulo43 checksum - my $c39 = CheckDigits('code_39'); - $barcode = $c39->complete($barcode); - - $bar_length = '19'; - $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 => 1, - ); - }; - - if ($@) { - warn "$barcodetype, $barcode FAILED:$@"; - } - } - elsif ( $barcodetype eq 'CODE39MOD10' ) { - - # get modulo43 checksum - my $c39_10 = CheckDigits('visa'); - $barcode = $c39_10->complete($barcode); - - $bar_length = '19'; - $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 => 1, - text => 0, - ); - }; - - 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" if $DEBUG; - warn "BAR_WDTH = $bar_width, TOT.BAR.LGHT=$tot_bar_length R*TOT.BAR =$moo2" if $DEBUG; -} - -=item build_circ_barcode; - - build_circ_barcode( $x_pos, $y_pos, $barcode, - $barcodetype, \$item); - -$item is the result of a previous call to GetLabelItems(); - -=cut - -#' -sub build_circ_barcode { - my ( $x_pos_circ, $y_pos, $value, $barcodetype, $item ) = @_; - - #warn Dumper \$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 ), - value => $value, - - # prolong => 2.96, - xSize => .85, - - ySize => 1.3, - ); - }; - 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; - - } + use C4::Labels::Batch; + use C4::Labels::Label; + use C4::Labels::Layout; + use C4::Labels::Profile; + use C4::Labels::Template; } -=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; # FIXME - why are we ignoring the y_pos parameter by redefining it? - 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 .= "1.0 1.0 1.0 rg\n"; # fill color white - - $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 -