X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FLabels.pm;h=43fa99d4e36cdebd4fac83200b27d2e81380c16b;hb=6dda8a63795439cde4d97f97b9d09b63011ef54a;hp=e78df94817c62c32f5e2ace12f6184a2ee80cbc2;hpb=a5f90c7d688a581e7f7cc29f38b70c7f92c8e7f0;p=koha.git diff --git a/C4/Labels.pm b/C4/Labels.pm index e78df94817..43fa99d4e3 100644 --- a/C4/Labels.pm +++ b/C4/Labels.pm @@ -1,1575 +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 - -use strict; -use vars qw($VERSION @ISA @EXPORT); - -use PDF::Reuse; -#use Text::Wrap; -use Algorithm::CheckDigits; -use C4::Members; -use C4::Branch; -use C4::Debug; -use C4::Biblio; -use Text::CSV_XS; -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 - &build_text_dropbox - &delete_layout &get_active_layout - &get_highest_batch - &deduplicate_batch - &GetAllPrinterProfiles &GetSinglePrinterProfile - &SaveProfile &CreateProfile &DeleteProfile - &GetAssociatedProfile &SetAssociatedProfile - ); -} - - -=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 $query2 = " SELECT * FROM labels_conf where active = 1"; # FIXME: exact same as get_active_layout - my $sth = C4::Context->dbh->prepare($query2); - $sth->execute(); - return $sth->fetchrow_hashref; -} - -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 $query = " Select * from labels_conf where active = 1"; # FIXME: exact same as get_label_options - my $sth = C4::Context->dbh->prepare($query); - $sth->execute(); - return $sth->fetchrow_hashref; -} - -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 only" } ); - push( @printtypes, { code => 'BIB', desc => "biblio only" } ); - push( @printtypes, { code => 'BARBIB', desc => "barcode / biblio" } ); - push( @printtypes, { code => 'BIBBAR', desc => "biblio / barcode" } ); - push( @printtypes, { code => 'ALT', desc => "alternating labels" } ); - push( @printtypes, { code => 'CSV', desc => "csv output" } ); - 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'} = 1; - } - } - return @printtypes; -} - -# this sub (build_text_dropbox) is deprecated and should be deleted. -# rch 2008.04.15 -# -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 @sorted_fields; - my $error; - my $sortorder = get_layout($layout_id); - if( $sortorder->{formatstring}) { - if(! $sorttype) { - return $sortorder->{formatstring} ; - } else { - my $csv = Text::CSV_XS->new( { allow_whitespace => 1 } ) ; - my $line= $sortorder->{formatstring} ; - my $status = $csv->parse( $line ); - @sorted_fields = map {{ 'code' => $_ , desc => $_ } } $csv->fields() ; - $error = $csv->error_input(); - warn $error if $error ; # TODO - do more with this. - } - } else { - # These fields are hardcoded based on the template for label-edit-layout.pl - my @text_fields = ( - { - code => 'itemtype', - desc => "Item Type", - order => $sortorder->{'itemtype'} - }, - { - code => 'dewey', - desc => "Dewey", - order => $sortorder->{'dewey'} - }, - { - code => 'issn', - desc => "ISSN", - order => $sortorder->{'issn'} - }, - { - code => 'isbn', - desc => "ISBN", - order => $sortorder->{'isbn'} - }, - { - code => 'class', - desc => "Classification", - order => $sortorder->{'class'} - }, - { - code => 'subclass', - desc => "Sub-Class", - order => $sortorder->{'subclass'} - }, - { - code => 'barcode', - desc => "Barcode", - order => $sortorder->{'barcode'} - }, - { - code => 'author', - desc => "Author", - order => $sortorder->{'author'} - }, - { - code => 'title', - desc => "Title", - order => $sortorder->{'title'} - }, - { - code => 'itemcallnumber', - desc => "Call Number", - order => $sortorder->{'itemcallnumber'} - }, - { - code => 'subtitle', - desc => "Subtitle", - order => $sortorder->{'subtitle'} - } - ); - - - my @new_fields; - foreach my $field (@text_fields) { - push( @new_fields, $field ) if $field->{'order'} > 0; - } - - @sorted_fields = sort { $$a{order} <=> $$b{order} } @new_fields; - } - # if we have a 'formatstring', then we ignore these hardcoded 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; - } - -} - -=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 $table = (@_ and 'patroncards' eq shift) ? 'patroncards' : 'labels'; - my $batch_list = (@_) ? shift : undef; - my $dbh = C4::Context->dbh; - my $q ="SELECT MAX(DISTINCT batch_id) FROM $table"; - my $sth = $dbh->prepare($q); - $sth->execute(); - my ($batch_id) = $sth->fetchrow_array || 0; - $batch_id++; - if ($batch_list) { - if ($table eq 'patroncards') { - $sth = $dbh->prepare("INSERT INTO $table (`batch_id`,`borrowernumber`) VALUES (?,?)"); - } else { - $sth = $dbh->prepare("INSERT INTO $table (`batch_id`,`itemnumber` ) VALUES (?,?)"); - } - for (@$batch_list) { - $sth->execute($batch_id,$_); - } - } - return $batch_id; -} - -#FIXME: Needs to be ported to receive $batch_type -# ... this looks eerily like add_batch() ... -sub get_highest_batch { - my $table = (@_ and 'patroncards' eq shift) ? 'patroncards' : 'labels'; - my $q = - "select distinct batch_id from $table order by batch_id desc limit 1"; - my $sth = C4::Context->dbh->prepare($q); - $sth->execute(); - my $data = $sth->fetchrow_hashref or return 1; - return ($data->{'batch_id'} || 1); -} - - -sub get_batches (;$) { - my $table = (@_ and 'patroncards' eq shift) ? 'patroncards' : 'labels'; - my $q = "SELECT batch_id, COUNT(*) AS num FROM $table GROUP BY batch_id"; - my $sth = C4::Context->dbh->prepare($q); - $sth->execute(); - my $batches = $sth->fetchall_arrayref({}); - return @$batches; -} - -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 - ( 3 * $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 - ) = @_; - $debug and 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; + use version; our $VERSION = qv('1.0.0_1'); - 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; + 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; - - #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, $formatstring - ) = @_; - - 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, classification, subclass, itemcallnumber, author, printingtype, - guidebox, startlabel, layoutname, formatstring, 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, $formatstring - ); - $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, $formatstring, - $layout_id - ) = @_; -### $layoutname -### $layout_id - - my $dbh = C4::Context->dbh; - my $query2 = "update labels_conf set - barcodetype=?, title=?, subtitle=?, isbn=?,issn=?, - itemtype=?, barcode=?, dewey=?, classification=?, - subclass=?, itemcallnumber=?, author=?, printingtype=?, - guidebox=?, startlabel=?, layoutname=?, formatstring=? 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, $formatstring, $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; -} - -=head GetBarcodeData - -=over 4 -Parse labels_conf.formatstring value -(one value of the csv, which has already been split) -and return string from koha tables or MARC record. -=back -=cut -#' -sub GetBarcodeData { - my ($f,$item,$record) = @_; - my $kohatables= &_descKohaTables(); - my $datastring; - my $last_f = $f; - my $match_kohatable = join('|', (@{$kohatables->{biblio}},@{$kohatables->{biblioitems}},@{$kohatables->{items}}) ); - while( $f ) { - if( $f =~ /^'(.*)'.*/ ) { - # single quotes indicate a static text string. - $datastring .= $1 ; - $f = $'; - } elsif ( $f =~ /^($match_kohatable).*/ ) { - # grep /$f/, (@$kohatables->{biblio},@$kohatables->{biblioitems},@$kohatables->{items}) ) { - $datastring .= $item->{$f}; - $f = $'; - } elsif ( $f =~ /^([0-9a-z]{3})(\w)(\W*).*/ ) { - $datastring .= $record->subfield($1,$2) . $3 if($record->subfield($1,$2)) ; - $f = $'; - } - last if ( $f eq $last_f ); # failed to match - } - return $datastring; -} - -=head descKohaTables -Return a hashref of an array of hashes, -with name,type keys. -=cut - -sub _descKohaTables { - my $dbh = C4::Context->dbh(); - my $kohatables; - for my $table ( 'biblio','biblioitems','items' ) { - my $sth = $dbh->column_info(undef,undef,$table,'%'); - while (my $info = $sth->fetchrow_hashref()){ - push @{$kohatables->{$table}} , $info->{'COLUMN_NAME'} ; - } - $sth->finish; - } - return $kohatables; -} - -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 ) = @_; - - # Replaced item's itemtype with the more user-friendly description... - my $dbh = C4::Context->dbh; - my %itemtypes; - my $sth = $dbh->prepare("SELECT itemtype,description FROM itemtypes"); - $sth->execute(); - while ( my $data = $sth->fetchrow_hashref ) { - $$item->{'itemtype'} = $data->{'description'} if ($$item->{'itemtype'} eq $data->{'itemtype'}); - } - - 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 @str_fields = get_text_fields($layout_id, 'codes' ); - my $record = GetMarcBiblio($$item->{biblionumber}); - # FIXME - returns all items, so you can't get data from an embedded holdings field. - # TODO - add a GetMarcBiblio1item(bibnum,itemnum) or a GetMarcItem(itemnum). - - my $old_fontname = $fontname; # We need to keep track of the original font passed in... - - for my $field (@str_fields) { - $field->{'code'} or warn "get_text_fields($layout_id, 'codes') element missing 'code' field"; - if ($$conf_data->{'formatstring'}) { - $field->{'data'} = GetBarcodeData($field->{'code'},$$item,$record) ; - } else { - $field->{data} = $$item->{$field->{'code'}} ; - } - - # This allows us to print the title in italic (oblique) type... (Times Roman has a different nomenclature.) - # It seems there should be a better way to handle fonts in the label/patron card tool altogether -fbcit - ($field->{code} eq 'title') ? (($old_fontname =~ /T/) ? ($fontname = 'TI') : ($fontname = ($old_fontname . 'O'))) : ($fontname = $old_fontname); - my $font = prFont($fontname); - # 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->{'formatstring'}) || ( $$conf_data->{$field->{code}} && $$item->{$field->{code}} ) ) { - # get the string - my $str = $field->{data} ; - # strip out naughty existing nl/cr's - $str =~ s/\n//g; - $str =~ s/\r//g; - my @strings; - if ($field->{code} eq 'itemcallnumber') { # If the field contains the call number, we do some special processing on it here... - 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 =~ /^(.*)\/(.*)$/; - unshift @strings, $2; - $str = $1; - } - unshift @strings, $str; - } else { - push @strings, $str; # if $nowrap == 1 do not wrap or remove segmentation markers... - } - } else { - $str =~ s/\/$//g; # Here we will strip out all trailing '/' in fields other than the call number... - if ( length($str) > $text_wrap_cols ) { # wrap lines greater than $text_wrap_cols width... - my $wrap = substr($str, ($text_wrap_cols - length($str)), $text_wrap_cols, ""); - push @strings, $str; - push @strings, $wrap; - } else { - push @strings, $str; - } - } - # 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; - } - } - } #foreach field -} - -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) { - $debug and 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; - - } - -} - -=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 -