Browse Source

Adding labels generator.

Signed-off-by: Joshua Ferraro <jmf@liblime.com>
Signed-off-by: Chris Cormack <crc@liblime.com>
3.0.x
Ryan Higgins 15 years ago
committed by Chris Cormack
parent
commit
6e2564450e
  1. 638
      C4/Labels.pm
  2. 161
      barcodes/barcodes.pl
  3. 373
      barcodes/barcodesGenerator.pl
  4. 78
      barcodes/label-home.pl
  5. 154
      barcodes/label-manager.pl
  6. 189
      barcodes/label-print-opus-pdf.pl
  7. 135
      barcodes/label-print.pl
  8. 40
      barcodes/pdfViewer.pl
  9. 128
      barcodes/printerConfig.pl
  10. 33
      barcodes/test.textblock.pl
  11. 1
      installer/kohastructure.sql
  12. 85
      koha-tmpl/intranet-tmpl/prog/en/barcodes/barcodes.tmpl
  13. 69
      koha-tmpl/intranet-tmpl/prog/en/barcodes/label-create-template.tmpl
  14. 189
      koha-tmpl/intranet-tmpl/prog/en/barcodes/label-home.tmpl
  15. 60
      koha-tmpl/intranet-tmpl/prog/en/barcodes/label-manager.tmpl
  16. 52
      koha-tmpl/intranet-tmpl/prog/en/barcodes/label-templates.tmpl
  17. 88
      koha-tmpl/intranet-tmpl/prog/en/barcodes/printerConfig.tmpl
  18. 60
      koha-tmpl/intranet-tmpl/prog/en/barcodes/search.tmpl
  19. 7
      koha-tmpl/intranet-tmpl/prog/en/includes/label-status.inc
  20. 8
      koha-tmpl/intranet-tmpl/prog/en/includes/menu-labels.inc
  21. 4
      koha-tmpl/intranet-tmpl/prog/en/labels/label-bib-search.tmpl
  22. 281
      koha-tmpl/intranet-tmpl/prog/en/labels/label-create-layout.tmpl
  23. 64
      koha-tmpl/intranet-tmpl/prog/en/labels/label-create-template.tmpl
  24. 182
      koha-tmpl/intranet-tmpl/prog/en/labels/label-edit-layout.tmpl
  25. 46
      koha-tmpl/intranet-tmpl/prog/en/labels/label-edit-template.tmpl
  26. 57
      koha-tmpl/intranet-tmpl/prog/en/labels/label-home.tmpl
  27. 111
      koha-tmpl/intranet-tmpl/prog/en/labels/label-manager.tmpl
  28. 0
      koha-tmpl/intranet-tmpl/prog/en/labels/label-print.tmpl
  29. 57
      koha-tmpl/intranet-tmpl/prog/en/labels/label-templates.tmpl
  30. 91
      koha-tmpl/intranet-tmpl/prog/en/labels/result.tmpl
  31. 128
      koha-tmpl/intranet-tmpl/prog/en/labels/search.tmpl
  32. 4
      koha-tmpl/intranet-tmpl/prog/en/tools/tools-home.tmpl
  33. 84
      labels/label-create-layout.pl
  34. 85
      labels/label-create-template.pl
  35. 87
      labels/label-edit-layout.pl
  36. 80
      labels/label-edit-template.pl
  37. 95
      labels/label-home.pl
  38. 159
      labels/label-item-search.pl
  39. 195
      labels/label-manager.pl
  40. 175
      labels/label-print-pdf.pl
  41. 50
      labels/label-save-template.pl
  42. 32
      labels/label-select-pdf.pl
  43. 82
      labels/label-templates.pl

638
C4/Labels.pm

@ -24,10 +24,11 @@ use vars qw($VERSION @ISA @EXPORT);
use PDF::Reuse;
use Text::Wrap;
use Algorithm::CheckDigits;
# use Data::Dumper;
# use Smart::Comments;
$VERSION = do { my @v = '$Revision$' =~ /\d+/g;
shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
};
$VERSION = 0.01;
=head1 NAME
@ -39,17 +40,28 @@ C4::Labels - Functions for printing spine labels and barcodes in Koha
=cut
@ISA = qw(Exporter);
@ISA = qw(Exporter);
@EXPORT = qw(
&get_label_options &get_label_items
&build_circ_barcode &draw_boundaries
&get_label_options &get_label_items
&build_circ_barcode &draw_boundaries
&drawbox &GetActiveLabelTemplate
&GetAllLabelTemplates &DeleteTemplate
&GetSingleLabelTemplate &SaveTemplate
&CreateTemplate &SetActiveTemplate
&SaveConf &DrawSpineText &GetTextWrapCols
&GetUnitsValue &DrawBarcode
&get_printingtypes
&get_layouts
&get_barcode_types
&get_batches &delete_batch
&add_batch &SetFontSize &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
);
=item get_label_options;
@ -64,7 +76,7 @@ Return a pointer on a hash list containing info from labels_conf table in Koha D
#'
sub get_label_options {
my $dbh = C4::Context->dbh;
my $query2 = " SELECT * FROM labels_conf LIMIT 1 ";
my $query2 = " SELECT * FROM labels_conf where active = 1";
my $sth = $dbh->prepare($query2);
$sth->execute();
my $conf_data = $sth->fetchrow_hashref;
@ -72,6 +84,263 @@ sub get_label_options {
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;
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" } );
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);
# $sortorder
$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;
foreach my $field (@sorted_fields) {
$sorttype eq 'codes' ? $active_fields .= "$field->{'code'} " :
$active_fields .= "$field->{'desc'} ";
}
return $active_fields;
}
sub by_order {
$$a{order} <=> $$b{order};
}
sub add_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'} + 1 );
}
return $new_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 $dbh = C4::Context->dbh;
my $q = "select batch_id, count(*) as num from labels group by batch_id";
my $sth = $dbh->prepare($q);
$sth->execute();
my @resultsloop;
while ( my $data = $sth->fetchrow_hashref ) {
push( @resultsloop, $data );
}
$sth->finish;
# 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) = @_;
my $dbh = C4::Context->dbh;
my $q = "DELETE FROM labels 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;
@ -80,7 +349,6 @@ 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;
}
@ -94,7 +362,7 @@ sub GetTextWrapCols {
while ( $strwidth < $textlimit ) {
$strwidth = prStrWidth( $string, 'C', $fontsize );
$string = $string . '0';
$string = $string . '0';
# warn "strwidth $strwidth, $textlimit, $string";
$count++;
@ -113,11 +381,11 @@ sub GetActiveLabelTemplate {
}
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;
@ -126,45 +394,54 @@ sub GetSingleLabelTemplate {
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);
my $query = "UPDATE labels_templates SET active = 1 WHERE tmpl_id = ?";
my $sth = $dbh->prepare($query);
$sth->execute($tmpl_id);
$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();
my $query = "UPDATE labels_conf SET active = 1 WHERE id = ?";
my $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, $fontsize, $units
) = @_;
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=?, fontsize=?,
units=?
WHERE tmpl_id = ?";
my $sth = $dbh->prepare($query);
@ -175,8 +452,6 @@ sub SaveTemplate {
$fontsize, $units, $tmpl_id
);
$sth->finish;
SetActiveTemplate($tmpl_id) if ( $active eq '1' );
}
sub CreateTemplate {
@ -185,9 +460,8 @@ sub CreateTemplate {
$tmpl_code, $tmpl_desc, $page_width, $page_height,
$label_width, $label_height, $topmargin, $leftmargin,
$cols, $rows, $colgap, $rowgap,
$active, $fontsize, $units
)
= @_;
$fontsize, $units
) = @_;
my $dbh = C4::Context->dbh;
@ -203,24 +477,6 @@ sub CreateTemplate {
$cols, $rows, $colgap, $rowgap,
$fontsize, $units
);
warn "ACTIVE = $active";
if ( $active eq '1' ) {
# get the tmpl_id of the newly created template, then call SetActiveTemplate()
my $query =
"SELECT tmpl_id from labels_templates order by tmpl_id desc limit 1";
my $sth = $dbh->prepare($query);
$sth->execute();
my $data = $sth->fetchrow_hashref;
my $tmpl_id = $data->{'tmpl_id'};
SetActiveTemplate($tmpl_id);
$sth->finish;
}
return $tmpl_id;
}
sub GetAllLabelTemplates {
@ -237,34 +493,36 @@ 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
) = @_;
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;
$query2 = "INSERT INTO labels_conf
( barcodetype, title, isbn, itemtype, barcode,
$sth2->execute();
my $query2 = "INSERT INTO labels_conf
( barcodetype, title, subtitle, isbn,issn, itemtype, barcode,
dewey, class, subclass, itemcallnumber, author, printingtype,
guidebox, startlabel )
values ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )";
$sth2 = $dbh->prepare($query2);
guidebox, startlabel, layoutname, active )
values ( ?, ?, ?, ?, ?, ?, ?, ?,?, ?, ?, ?, ?, ?,?,?, 1 )";
my $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
);
$sth2->finish;
@ -272,6 +530,36 @@ sub SaveConf {
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 get_label_items;
$options = get_label_items()
@ -283,28 +571,46 @@ Returns an array of references-to-hash, whos keys are the field from the biblio,
#'
sub get_label_items {
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->{'batch_id'} = $batch_id;
$data1->{'summary'} =
"$data1->{'barcode'}, $data1->{'title'}, $data1->{'isbn'}";
push( @resultsloop, $data1 );
$sth1->finish;
@ -312,6 +618,17 @@ sub get_label_items {
}
$sth->finish;
return @resultsloop;
}
sub GetItemFields {
my @fields = qw (
barcode title subtitle
dewey isbn issn author class
itemtype subclass itemcallnumber
);
return @fields;
}
sub DrawSpineText {
@ -319,23 +636,39 @@ sub DrawSpineText {
my ( $y_pos, $label_height, $fontsize, $x_pos, $left_text_margin,
$text_wrap_cols, $item, $conf_data )
= @_;
# 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;
## $item
my $top_text_margin = ( $fontsize + 3 );
my $line_spacer = ($fontsize); # number of pixels between text rows.
# add your printable fields manually in here
my @fields =
qw (dewey isbn classification itemtype subclass itemcallnumber);
my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) );
my $hPos = ( $x_pos + $left_text_margin );
my $layout_id = $$conf_data->{'id'};
# my @fields = GetItemFields();
my $str_fields = get_text_fields($layout_id, 'codes' );
my @fields = split(/ /, $str_fields);
### @fields
my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) );
my $hPos = ( $x_pos + $left_text_margin );
# warn Dumper $conf_data;
#warn Dumper $item;
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"} ) {
@ -344,7 +677,6 @@ sub DrawSpineText {
# get the string
$str = $$item->{"$field"};
# strip out naughty existing nl/cr's
$str =~ s/\n//g;
$str =~ s/\r//g;
@ -362,26 +694,43 @@ sub DrawSpineText {
foreach my $str (@strings) {
#warn "HPOS , VPOS $hPos, $vPos ";
prText( $hPos, $vPos, $str );
# set the font size A
# prText( $hPos, $vPos, $str );
PrintText( $hPos, $vPos, $fontsize, $str );
$vPos = $vPos - $line_spacer;
}
} # if field is valid
} #foreach feild
} # if field is } #foreach feild
}
}
sub PrintText {
my ( $hPos, $vPos, $fontsize, $text ) = @_;
my $str = "BT /Ft1 $fontsize Tf $hPos $vPos Td ($text) Tj ET";
prAdd($str);
}
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 );
@ -389,10 +738,10 @@ sub DrawBarcode {
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 ($@) {
@ -400,8 +749,61 @@ sub DrawBarcode {
}
}
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;
@ -419,8 +821,8 @@ sub DrawBarcode {
}
}
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;
@ -437,6 +839,7 @@ sub DrawBarcode {
warn "$barcodetype, $barcode FAILED:$@";
}
}
my $moo2 = $tot_bar_length * $xsize_ratio;
warn " $x_pos, $y_pos, $barcode, $barcodetype\n";
@ -457,6 +860,8 @@ $item is the result of a previous call to get_label_items();
sub build_circ_barcode {
my ( $x_pos_circ, $y_pos, $value, $barcodetype, $item ) = @_;
#warn Dumper \$item;
#warn "value = $value\n";
#$DB::single = 1;
@ -495,15 +900,17 @@ sub build_circ_barcode {
}
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 ($@) {
@ -751,11 +1158,10 @@ sub draw_boundaries {
my (
$x_pos_spine, $x_pos_circ1, $x_pos_circ2, $y_pos,
$spine_width, $label_height, $circ_width
)
= @_;
) = @_;
my $y_pos_initial = ( ( 792 - 36 ) - 90 );
$y_pos = $y_pos_initial;
my $y_pos = $y_pos_initial;
my $i = 1;
for ( $i = 1 ; $i <= 8 ; $i++ ) {
@ -791,9 +1197,11 @@ sub drawbox {
# 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

161
barcodes/barcodes.pl

@ -1,161 +0,0 @@
#!/usr/bin/perl
# script to generate items barcodes
# written 07/04
# by Veleda Matias - matias_veleda@hotmail.com - Physics Library UNLP Argentina and
# Casta�eda Sebastian - seba3c@yahoo.com.ar - Physics Library UNLP Argentina and
# 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 CGI;
use C4::Auth;
use C4::Output;
use C4::Context;
use C4::Barcodes::PrinterConfig;
# This function returns the path to deal with the correct files, considering
# templates set and language.
sub getPath {
my $type = shift @_;
my $templatesSet = C4::Context->preference('template');
my $lang = C4::Context->preference('opaclanguages');
if ( $type eq "intranet" ) {
return "$ENV{'DOCUMENT_ROOT'}/intranet-tmpl/$templatesSet/$lang";
}
else {
return "$ENV{'DOCUMENT_ROOT'}/opac-tmpl/$templatesSet/$lang";
}
}
# Load a configuration file. Before use this function, check if that file exists.
sub loadConfFromFile {
my $fileName = shift @_;
my %keyValues;
open FILE, "<$fileName";
while (<FILE>) {
chomp;
if (/\s*([\w_]*)\s*=\s*([\[\]\<\>\w_\s:@,\.-]*)\s*/) {
$keyValues{$1} = $2;
}
}
close FILE;
return %keyValues;
}
# Save settings to a configuration file. It delete previous configuration settings.
sub saveConfToFile {
my $fileName = shift @_;
my %keyValues = %{ shift @_ };
my $i;
open FILE, ">$fileName";
foreach $i ( keys(%keyValues) ) {
print FILE $i . " = " . $keyValues{$i} . "\n";
}
close FILE;
}
# Load the config file.
my $filenameConf =
&getPath("intranet") . "/includes/labelConfig/itemsLabelConfig.conf";
my %labelConfig = &loadConfFromFile($filenameConf);
my $input = new CGI;
# Defines type of page to use in the printer process
my @labelTable =
C4::Barcodes::PrinterConfig::labelsPage( $labelConfig{'rows'},
$labelConfig{'columns'} );
# It creates a list of posible intervals to choose codes to generate
my %list = (
'continuous' => 'Continuous Range of items',
'individuals' => 'Individual Codes'
);
my @listValues = keys(%list);
my $rangeType = CGI::scrolling_list(
-name => 'rangeType',
-values => \@listValues,
-labels => \%list,
-size => 1,
-default => ['continuous'],
-multiple => 0,
-id => "rangeType",
-onChange => "changeRange(this)"
);
# It creates a list of posible standard codifications. First checks if the user has just added a new code.
if ( $input->param('addCode') ) {
my $newCountryName = $input->param('countryName');
my $newCountryCode = $input->param('countryCode');
my $countryCodesFilename =
&getPath("intranet") . "/includes/countryCodes/countryCodes.dat";
open COUNTRY_CODES, ">>$countryCodesFilename";
print COUNTRY_CODES $newCountryCode . " = " . $newCountryName . "\n";
close COUNTRY_CODES;
}
# Takes the country codes from a file and use them to set the country list.
my $countryCodes =
&getPath("intranet") . "/includes/countryCodes/countryCodes.dat";
%list = &loadConfFromFile($countryCodes);
@listValues = keys(%list);
my $number_system = CGI::scrolling_list(
-name => 'numbersystem',
-values => \@listValues,
-labels => \%list,
-size => 1,
-multiple => 0
);
# Set the script name
my $script_name = "/cgi-bin/koha/barcodes/barcodesGenerator.pl";
# Get the template to use
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
{
template_name => "barcodes/barcodes.tmpl",
type => "intranet",
query => $input,
authnotrequired => 0,
flagsrequired => { tools => 1 },
debug => 1,
}
);
# Replace the template values with the real ones
$template->param( SCRIPT_NAME => $script_name );
$template->param( NUMBER_SYSTEM => $number_system );
$template->param( PAGES => $labelConfig{'pageType'} );
$template->param( RANGE_TYPE => $rangeType );
$template->param( LABEL_TABLE => \@labelTable );
$template->param( COL_SPAN => $labelConfig{'columns'} );
if ( $input->param('error') ) {
$template->param( ERROR => 1 );
}
else {
$template->param( ERROR => 0 );
}
$template->param(
intranetcolorstylesheet =>
C4::Context->preference("intranetcolorstylesheet"),
intranetstylesheet => C4::Context->preference("intranetstylesheet"),
IntranetNav => C4::Context->preference("IntranetNav"),
);
# Shows the template with the real values replaced
output_html_with_http_headers $input, $cookie, $template->output;

373
barcodes/barcodesGenerator.pl

@ -1,373 +0,0 @@
#!/usr/bin/perl
# script to generate items barcodes
# written 07/04
# by Veleda Matias - matias_veleda@hotmail.com - Physics Library UNLP Argentina and
# Castañeda Sebastian - seba3c@yahoo.com.ar - Physics Library UNLP Argentina and
# 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
require Exporter;
use strict;
use CGI;
use C4::Context;
use C4::Output;
#FIXME : module deprecated ?
use PDF::API2;
use PDF::API2::Page;
use PDF::API2::Util;
use C4::Barcodes::PrinterConfig;
use Time::localtime;
# This function returns the path to deal with the correct files, considering
# templates set and language.
sub getPath {
my $type = shift @_;
my $templatesSet = C4::Context->preference('template');
my $lang = C4::Context->preference('opaclanguages');
if ( $type eq "intranet" ) {
return "$ENV{'DOCUMENT_ROOT'}/intranet-tmpl/$templatesSet/$lang";
}
else {
return "$ENV{'DOCUMENT_ROOT'}/opac-tmpl/$templatesSet/$lang";
}
}
# Load a configuration file. Before use this function, check if that file exists.
sub loadConfFromFile {
my $fileName = shift @_;
my %keyValues;
open FILE, "<$fileName";
while (<FILE>) {
chomp;
if (/\s*([\w_]*)\s*=\s*([\[\]\<\>\w_\s:@,\.-]*)\s*/) {
$keyValues{$1} = $2;
}
}
close FILE;
return %keyValues;
}
# Save settings to a configuration file. It delete previous configuration settings.
sub saveConfToFile {
my $fileName = shift @_;
my %keyValues = %{ shift @_ };
my $i;
open FILE, ">$fileName";
foreach $i ( keys(%keyValues) ) {
print FILE $i . " = " . $keyValues{$i} . "\n";
}
close FILE;
}
# Load the config file.
my $filenameConf =
&getPath("intranet") . "/includes/labelConfig/itemsLabelConfig.conf";
my %labelConfig = &loadConfFromFile($filenameConf);
# Creates a CGI object and take its parameters
my $cgi = new CGI;
my $from = $cgi->param('from');
my $to = $cgi->param('to');
my $individualCodes = $cgi->param('individualCodes');
my $rangeType = $cgi->param('rangeType');
my $pageType = $cgi->param('pages');
my $label = $cgi->param('label');
my $numbersystem = $cgi->param('numbersystem');
my $text_under_label = $cgi->param('text_under_label');
# Generate the checksum from an inventary code
sub checksum {
sub calculateDigit {
my $code = shift @_;
my $sum = 0;
my $odd_parity = 1;
my $i;
for ( $i = length($code) - 1 ; $i >= 0 ; $i-- ) {
if ($odd_parity) {
$sum = $sum + ( 3 * substr( $code, $i, 1 ) );
}
else {
$sum = $sum + substr( $code, $i, 1 );
}
$odd_parity = !$odd_parity;
}
my $check_digit = 10 - ( $sum % 10 );
if ( $check_digit == 10 ) {
$check_digit = 0;
}
return $code . $check_digit;
}
my $currentCode = shift @_;
$currentCode = &calculateDigit($currentCode);
return $currentCode;
}
# Assigns a temporary name to the PDF file
sub assingFilename {
my ( $from, $to ) = @_;
my $ip = $cgi->remote_addr();
my $random = int( rand(1000000) );
my $timeObj = localtime();
my ( $day, $month, $year, $hour, $min, $sec ) = (
$timeObj->mday,
$timeObj->mon + 1,
$timeObj->year + 1900,
$timeObj->hour, $timeObj->min, $timeObj->sec
);
my $tmpFileName =
$random . '-' . $ip
. '-(From '
. $from . ' to '
. $to . ')-['
. $day . '.'
. $month . '.'
. $year . ']-['
. $hour . ':'
. $min . ':'
. $sec . '].pdf';
return $tmpFileName;
}
sub getCallnum {
#grabs a callnumber for the specified barcode
my ($barcode) = @_;
my $query =
"select dewey from items,biblioitems where items.biblionumber=biblioitems.biblionumber and items.barcode=?";
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare($query);
$sth->execute($barcode);
my ($callnum) = $sth->fetchrow_array();
warn "Call number is:" . $barcode;
return $callnum;
}
# Takes inventary codes from database and if they are between
# the interval specify by parameters, it generates the correspond barcodes
sub barcodesGenerator {
my ( $from, $to, $rangeType, $individualCodes, $text_under_label ) = @_;
# Returns a database handler
my $dbh = C4::Context->dbh;
# Create the query to database
# Assigns a temporary filename for the pdf file
my $tmpFileName = &assingFilename( $from, $to );
# warn "range type: ".$rangeType;
if ( $rangeType eq 'continuous' ) {
# Set the temp directory for pdf´s files
if ( !defined( $ENV{'TEMP'} ) ) {
$ENV{'TEMP'} = '/tmp/';
}
$tmpFileName = $ENV{'TEMP'} . $tmpFileName;
# Creates a PDF object
my $pdf = PDF::API2->new( -file => $tmpFileName );
# Set the positions where barcodes are going to be placed
C4::Barcodes::PrinterConfig::setPositionsForX(
$labelConfig{'marginLeft'}, $labelConfig{'labelWidth'},
$labelConfig{'columns'}, $labelConfig{'pageType'}
);
C4::Barcodes::PrinterConfig::setPositionsForY(
$labelConfig{'marginBottom'}, $labelConfig{'labelHeigth'},
$labelConfig{'rows'}, $labelConfig{'pageType'}
);
# Creates a font object
my $tr = $pdf->corefont('Helvetica-Bold');
# Barcode position
my ( $page, $gfx, $text );
for ( my $code = $from ; $code <= $to ; $code++ ) {
# Generetase checksum
my $codeC = &checksum($code);
# Generate the corresponde barcode to $code
# warn "Code is :-->".$codeC."<--";
my $barcode = $pdf->barcode(
-font => $tr, # The font object to use
-type => 'ean128', # Standard of codification
-code => $codeC, # Text to codify
-extn => '012345', # Barcode extension (if it is aplicable)
-umzn => 10, # Top limit of the finished bar
-lmzn => 10, # Bottom limit of the finished bar
-zone => 15, # Bars size
-quzn => 0, # Space destinated for legend
-ofwt => 0.01, # Bars width
-fnsz => 8, # Font size
-text => ''
);
( my $x, my $y, $pdf, $page, $gfx, $text, $tr, $label ) =
C4::Barcodes::PrinterConfig::getLabelPosition( $label, $pdf,
$page, $gfx, $text, $tr, $pageType );
# Assigns a barcodes to $gfx
$gfx->barcode( $barcode, $x, $y,
( 72 / $labelConfig{'systemDpi'} ) );
# Assigns the additional information to the barcode (Legend)
$text->translate( $x - 48, $y - 22 );
#warn "code is ".$codeC;
if ($text_under_label) {
$text->text($text_under_label);
}
else {
$text->text( getCallnum($code) );
}
}
# Writes the objects added in $gfx to $page
$pdf->finishobjects( $page, $gfx, $text );
# Save changes to the PDF
$pdf->saveas;
# Close the conection with the PDF file
$pdf->end;
# Show the PDF file
print $cgi->redirect(
"/cgi-bin/koha/barcodes/pdfViewer.pl?tmpFileName=$tmpFileName");
}
else {
my $rangeCondition;
if ( $individualCodes ne "" ) {
$rangeCondition = "AND (I.barcode IN " . $individualCodes . ")";
}
else {
$rangeCondition =
"AND (I.barcode >= " . $from . " AND I.barcode <=" . $to . " )";
}
my $query =
"SELECT CONCAT('$numbersystem',REPEAT('0',((12 - LENGTH('$numbersystem')) - LENGTH(I.barcode))), I.barcode) AS Codigo, B.title, B.author FROM biblio B, items I WHERE (I.biblionumber = B.biblioNumber ) "
. $rangeCondition
. " AND (I.barcode <> 'FALTA') ORDER BY Codigo";
# Prepare the query
my $sth = $dbh->prepare($query);
# Executes the query
$sth->execute;
if ( $sth->rows ) { # There are inventary codes
# Set the temp directory for pdf´s files
if ( !defined( $ENV{'TEMP'} ) ) {
$ENV{'TEMP'} = '/tmp/';
}
# Assigns a temporary filename for the pdf file
my $tmpFileName = &assingFilename( $from, $to );
$tmpFileName = $ENV{'TEMP'} . $tmpFileName;
# Creates a PDF object
my $pdf = PDF::API2->new( -file => $tmpFileName );
# Set the positions where barcodes are going to be placed
C4::Barcodes::PrinterConfig::setPositionsForX(
$labelConfig{'marginLeft'}, $labelConfig{'labelWidth'},
$labelConfig{'columns'}, $labelConfig{'pageType'}
);
C4::Barcodes::PrinterConfig::setPositionsForY(
$labelConfig{'marginBottom'}, $labelConfig{'labelHeigth'},
$labelConfig{'rows'}, $labelConfig{'pageType'}
);
# Creates a font object
my $tr = $pdf->corefont('Helvetica-Bold');
# Barcode position
my ( $page, $gfx, $text );
while ( my ( $code, $dewey, $title, $author ) =
$sth->fetchrow_array )
{
# Generetase checksum
$code = &checksum($code);
# Generate the corresponde barcode to $code
my $barcode = $pdf->barcode(
-font => $tr, # The font object to use
-type => 'ean13', # Standard of codification
-code => $code, # Text to codify
-extn => '012345', # Barcode extension (if it is aplicable)
-umzn => 10, # Top limit of the finished bar
-lmzn => 10, # Bottom limit of the finished bar
-zone => 15, # Bars size
-quzn => 0, # Space destinated for legend
-ofwt => 0.01, # Bars width
-fnsz => 8, # Font size
-text => ''
);
( my $x, my $y, $pdf, $page, $gfx, $text, $tr, $label ) =
C4::Barcodes::PrinterConfig::getLabelPosition( $label, $pdf,
$page, $gfx, $text, $tr, $pageType );
# Assigns a barcodes to $gfx
$gfx->barcode( $barcode, $x, $y,
( 72 / $labelConfig{'systemDpi'} ) );
# Assigns the additional information to the barcode (Legend)
$text->translate( $x - 48, $y - 22 );
if ($text_under_label) {
$text->text($text_under_label);
}
else {
$text->text( substr $title, 0, 30 );
$text->translate( $x - 48, $y - 29 );
#$text->text(substr $author, 0, 30);
$text->text( substr $author, 0, 30 );
}
}
# Writes the objects added in $gfx to $page
$pdf->finishobjects( $page, $gfx, $text );
# Save changes to the PDF
$pdf->saveas;
# Close the conection with the PDF file
$pdf->end;
# Show the PDF file
print $cgi->redirect(
"/cgi-bin/koha/barcodes/pdfViewer.pl?tmpFileName=$tmpFileName");
}
else {
# Rollback and shows the error legend
print $cgi->redirect("/cgi-bin/koha/barcodes/barcodes.pl?error=1");
}
$sth->finish;
}
}
barcodesGenerator( $from, $to, $rangeType, $individualCodes,
$text_under_label );

78
barcodes/label-home.pl

@ -1,78 +0,0 @@
#!/usr/bin/perl
# 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 CGI;
use C4::Auth;
use C4::Output;
use C4::Labels;
use C4::Context;
my $query = new CGI;
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
{
template_name => "barcodes/label-home.tmpl",