# Suite 330, Boston, MA 02111-1307 USA
use strict;
-require Exporter;
-
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
+ );
+}
-$VERSION = do { my @v = '$Revision$' =~ /\d+/g;
- shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
-};
=head1 NAME
=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);
+ 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();
- my $conf_data = $sth->fetchrow_hashref;
+ 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;
- return $conf_data;
+}
+
+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 {
$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;
+ 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, 'C', $fontsize );
- $string = $string . '0';
-
- # warn "strwidth $strwidth, $textlimit, $string";
+ $strwidth = prStrWidth( $string, $font, $fontsize );
+ $string = $string . '0';
+ #warn "strwidth:$strwidth, textlimit:$textlimit, count:$count string:$string";
$count++;
}
return $count;
}
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 ($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) = @_;
- 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;
+ $sth->execute();
$query = "UPDATE labels_templates SET active = 1 WHERE tmpl_id = ?";
$sth = $dbh->prepare($query);
$sth->finish;
}
-sub DeleteTemplate {
- my ($tmpl_code) = @_;
+sub set_active_layout {
+
+ my ($layout_id) = @_;
my $dbh = C4::Context->dbh;
- my $query = " DELETE FROM labels_templates where tmpl_code = ?";
+ my $query = " UPDATE labels_conf SET active = NULL";
my $sth = $dbh->prepare($query);
- $sth->execute($tmpl_code);
+ $sth->execute();
+
+ $query = "UPDATE labels_conf SET active = 1 WHERE id = ?";
+ $sth = $dbh->prepare($query);
+ $sth->execute($layout_id);
$sth->finish;
}
-sub SaveTemplate {
+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, $active, $fontsize, $units
- )
- = @_;
-
- #warn "FONTSIZE =$fontsize";
-
- my $dbh = C4::Context->dbh;
+ $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=?, fontsize=?,
- units=?
+ page_height=?, label_width=?, label_height=?, topmargin=?,
+ leftmargin=?, cols=?, rows=?, colgap=?, rowgap=?, font=?, fontsize=?,
+ units=?
WHERE tmpl_id = ?";
my $sth = $dbh->prepare($query);
$tmpl_code, $tmpl_desc, $page_width, $page_height,
$label_width, $label_height, $topmargin, $leftmargin,
$cols, $rows, $colgap, $rowgap,
- $fontsize, $units, $tmpl_id
+ $font, $fontsize, $units, $tmpl_id
);
+ my $dberror = $sth->errstr;
$sth->finish;
-
- SetActiveTemplate($tmpl_id) if ( $active eq '1' );
+ return $dberror;
}
sub CreateTemplate {
$tmpl_code, $tmpl_desc, $page_width, $page_height,
$label_width, $label_height, $topmargin, $leftmargin,
$cols, $rows, $colgap, $rowgap,
- $active, $fontsize, $units
- )
- = @_;
+ $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, fontsize, units)
- VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?,?)";
+ 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,
- $fontsize, $units
+ $font, $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;
+ my $dberror = $sth->errstr;
+ $sth->finish;
+ return $dberror;
}
sub GetAllLabelTemplates {
}
$sth->finish;
+ #warn Dumper @resultsloop;
return @resultsloop;
}
-sub SaveConf {
+#sub SaveConf {
+sub add_layout {
my (
- $barcodetype, $title, $isbn, $itemtype,
- $bcn, $dcn, $classif, $subclass,
- $itemcallnumber, $author, $tmpl_id, $printingtype,
- $guidebox, $startlabel
- )
- = @_;
+ $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 = "DELETE FROM labels_conf";
+ my $query2 = "update labels_conf set active = NULL";
my $sth2 = $dbh->prepare($query2);
- $sth2->execute;
+ $sth2->execute();
$query2 = "INSERT INTO labels_conf
- ( barcodetype, title, isbn, itemtype, barcode,
- dewey, class, subclass, itemcallnumber, author, printingtype,
- guidebox, startlabel )
- values ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )";
+ ( 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, $isbn, $itemtype,
- $bcn, $dcn, $classif, $subclass,
- $itemcallnumber, $author, $printingtype, $guidebox,
- $startlabel
+ $barcodetype, $title, $subtitle, $isbn, $issn,
+
+ $itemtype, $bcn, $dcn, $classif,
+ $subclass, $itemcallnumber, $author, $printingtype,
+ $guidebox, $startlabel, $layoutname, $formatstring
);
$sth2->finish;
return;
}
-=item get_label_items;
+sub save_layout {
- $options = get_label_items()
+ 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 get_label_items {
+sub GetLabelItems {
+ my ($batch_id) = @_;
my $dbh = C4::Context->dbh;
- # get the actual items to be printed.
+ my @resultsloop = ();
+ my $count;
my @data;
- my $query3 = " Select * from labels ";
- my $sth = $dbh->prepare($query3);
- $sth->execute();
- my @resultsloop;
+ 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 * from biblio, biblioitems, items where itemnumber = ? and
- items.biblioitemnumber=biblioitems.biblioitemnumber and
- biblioitems.biblionumber=biblio.biblionumber";
-
- my $sth1 = $dbh->prepare($query1);
+ 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;
}
$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 ( $y_pos, $label_height, $fontsize, $x_pos, $left_text_margin,
- $text_wrap_cols, $item, $conf_data )
- = @_;
+ my ( $x_pos, $y_pos, $label_height, $label_width, $fontname, $fontsize, $left_text_margin,
+ $text_wrap_cols, $item, $conf_data, $printingtype, $nowrap ) = @_;
- $Text::Wrap::columns = $text_wrap_cols;
- $Text::Wrap::separator = "\n";
+ # 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 );
- my $line_spacer = ($fontsize); # number of pixels between text rows.
+ 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.).
- # 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 );
+ my $layout_id = $$conf_data->{'id'};
- foreach my $field (@fields) {
+ 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->{"$field"} && $$item->{"$field"} ) {
-
- # warn "CONF_TYPE = $field";
-
+ if ( ($$conf_data->{'formatstring'}) || ( $$conf_data->{$field->{code}} && $$item->{$field->{code}} ) ) {
# get the string
- $str = $$item->{"$field"};
-
+ 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...
+ # Wrap text lines exceeding $text_wrap_cols length, truncating all text beyond the second line...
+ $Text::Wrap::columns = $text_wrap_cols;
+ my @title = split(/\n/ ,wrap('', '', $str));
+ pop @title if scalar(@title) > 2;
+ push(@strings, @title);
+ }
+ # 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);
+}
- # chop the string up into _upto_ 12 chunks
- # and seperate the chunks with newlines
+sub DrawPatronCardText {
- $str = wrap( "", "", "$str" );
- $str = wrap( "", "", "$str" );
+ my ( $x_pos, $y_pos, $label_height, $label_width, $fontname, $fontsize, $left_text_margin,
+ $text_wrap_cols, $text, $printingtype )
+ = @_;
- # split the chunks between newline's, into an array
- my @strings = split /\n/, $str;
+ my $top_text_margin = 25; #FIXME: This should be a template parameter and passed in...
- # then loop for each string line
- foreach my $str (@strings) {
+ my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) );
+ my $font = prFont($fontname);
- #warn "HPOS , VPOS $hPos, $vPos ";
- prText( $hPos, $vPos, $str );
- $vPos = $vPos - $line_spacer;
- }
- } # if field is valid
- } #foreach feild
+ 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 ) = @_;
- $barcode = '123456789';
my $num_of_bars = length($barcode);
- my $bar_width = ( ( $width / 10 ) * 8 ); # %80 of lenght of label width
+ 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 = '14.4333333333333';
+ 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 );
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,
+ value => "*$barcode*",
+ ySize => ( .02 * $height ),
+ xSize => $xsize_ratio,
+ hide_asterisk => 1,
);
};
if ($@) {
}
}
- elsif ( $barcodetype eq 'COOP2of5' ) {
- $bar_length = '9.43333333333333';
+ 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;
}
}
- elsif ( $barcodetype eq 'Industrial2of5' ) {
- $bar_length = '13.1333333333333';
+ 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;
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";
+ 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 get_label_items();
+$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;
}
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,
- value => "*$value*",
- #hide_asterisk => $xsize_ratio,
);
};
if ($@) {
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;
+ $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++ ) {
# 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 .= "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
=head1 AUTHOR
Mason James <mason@katipo.co.nz>
+
=cut
projects / koha-ffzg.git / blobdiff