Koha-community/Koha
13
7
Fork 0
Code Issues Releases Wiki Activity

[35/40] Work on C4::Labels tests and various bugfixs resulting

Browse source 
This patch also moves the Labels tests into their own sub directory.

Due to a squash mistake this patch also includes the following:

Fixing up POD for C4::Labels modules

Also a minor bugfix and code refactoring.
This commit is contained in:
Chris Nighswonger 2009-09-01 14:50:57 -04:00
parent ee37448387
commit 9b56b1ead9
15 changed files with 1541 additions and 1006 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

253
C4/Labels/Batch.pm
View file

@ -1,22 +1,5 @@
package C4::Labels::Batch; package C4::Labels::Batch;
# Copyright 2009 Foundations Bible College.
#
# 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 strict;
use warnings; use warnings;
@ -24,7 +7,6 @@ use Sys::Syslog qw(syslog);
use C4::Context; use C4::Context;
use C4::Debug; use C4::Debug;
use Data::Dumper;
BEGIN { BEGIN {
use version; our $VERSION = qv('1.0.0_1'); use version; our $VERSION = qv('1.0.0_1');
@ -57,32 +39,6 @@ sub _check_params {
return $exit_code; return $exit_code;
} }
=head1 NAME
C4::Labels::Batch - A class for creating and manipulating batch objects in Koha
=cut
=head1 METHODS
=head2 C4::Labels::Batch->new()
Invoking the I<new> method constructs a new batch object with no items. It is possible to pre-populate the batch with items and a branch code by passing them
as in the second example below.
B<NOTE:> The items list must be an arrayref pointing to an array of hashes containing a key/data pair after this fashion: {item_number => item_number}. The order of
the array elements determines the order of the items in the batch.
example:
C<my $batch = C4::Labels::Batch->new(); # Creates and returns a new batch object>
C<my $batch = C4::Labels::Batch->new(items => $arrayref, branch_code => branch_code) # Creates and returns a new batch object containing the items passed in
with the branch code passed in.>
B<NOTE:> This batch is I<not> written to the database until C<$batch->save()> is invoked. You have been warned!
=cut
sub new { sub new {
my ($invocant) = shift; my ($invocant) = shift;
my $type = ref($invocant) || $invocant; my $type = ref($invocant) || $invocant;
@ -101,15 +57,6 @@ sub new {
return $self; return $self;
} }
=head2 $batch->add_item(item_number => $item_number, branch_code => $branch_code)
Invoking the I<add_item> method will add the supplied item to the batch object.
example:
$batch->add_item(item_number => $item_number, branch_code => $branch_code);
=cut
sub add_item { sub add_item {
my $self = shift; my $self = shift;
my $item_number = shift; my $item_number = shift;
@ -126,33 +73,15 @@ sub add_item {
$sth1->execute($self->{'batch_id'}, $item_number, $self->{'branch_code'}); $sth1->execute($self->{'batch_id'}, $item_number, $self->{'branch_code'});
my $label_id = $sth1->fetchrow_array; my $label_id = $sth1->fetchrow_array;
push (@{$self->{'items'}}, {item_number => $item_number, label_id => $label_id}); push (@{$self->{'items'}}, {item_number => $item_number, label_id => $label_id});
$self->{'batch_stat'} = 0; $self->{'batch_stat'} = 1;
return 0; return 0;
} }
=head2 $batch->get_attr()
Invoking the I<get_attr> method will return the requested attribute.
example:
my @items = $batch->get_attr($attr);
=cut
sub get_attr { sub get_attr {
my $self = shift; my $self = shift;
return $self->{$_[0]}; return $self->{$_[0]};
} }
=head2 $batch->remove_item()
Invoking the I<remove_item> method will remove the supplied item from the batch object.
example:
$batch->remove_item();
=cut
sub remove_item { sub remove_item {
my $self = shift; my $self = shift;
my $label_id = shift; my $label_id = shift;
@ -169,42 +98,35 @@ sub remove_item {
return 0; return 0;
} }
=head2 $batch->save() # FIXME: This method is effectively useless the way the current add_item method is written. Ideally, the items should be added to the object
# and then the save method called. This does not work well in practice due to the inability to pass objects accross cgi script calls.
Invoking the I<save> method attempts to insert the batch into the database. The method returns # I'm leaving it here because it should be here and for consistency's sake. -cnighswonger
the new record batch_id upon success and -1 upon failure (This avoids conflicting with a record #
batch_id of 1). Errors are logged to the syslog. #=head2 $batch->save()
#
example: # Invoking the I<save> method attempts to insert the batch into the database. The method returns
my $exitstat = $batch->save(); # to save the record behind the $batch object # the new record batch_id upon success and -1 upon failure (This avoids conflicting with a record
# batch_id of 1). Errors are logged to the syslog.
=cut #
# example:
sub save { # my $exitstat = $batch->save(); # to save the record behind the $batch object
my $self = shift; #
foreach my $item_number (@{$self->{'items'}}) { #=cut
my $query = "INSERT INTO labels_batches (batch_id, item_number, branch_code) VALUES (?,?,?);"; #
my $sth1 = C4::Context->dbh->prepare($query); #sub save {
$sth1->execute($self->{'batch_id'}, $item_number->{'item_number'}, $self->{'branch_code'}); # my $self = shift;
if ($sth1->err) { # foreach my $item_number (@{$self->{'items'}}) {
syslog("LOG_ERR", "C4::Labels::Batch->save : Database returned the following error on attempted INSERT: %s", $sth1->errstr); # my $query = "INSERT INTO labels_batches (batch_id, item_number, branch_code) VALUES (?,?,?);";
return -1; # my $sth1 = C4::Context->dbh->prepare($query);
} # $sth1->execute($self->{'batch_id'}, $item_number->{'item_number'}, $self->{'branch_code'});
$self->{'batch_stat'} = 1; # if ($sth1->err) {
return $self->{'batch_id'}; # syslog("LOG_ERR", "C4::Labels::Batch->save : Database returned the following error on attempted INSERT: %s", $sth1->errstr);
} # return -1;
} # }
# $self->{'batch_stat'} = 1;
=head2 C4::Labels::Batch->retrieve(batch_id) # return $self->{'batch_id'};
# }
Invoking the I<retrieve> method constructs a new batch object containing the current values for batch_id. The method returns #}
a new object upon success and 1 upon failure. Errors are logged to the syslog.
examples:
my $batch = C4::Labels::Batch->retrieve(batch_id => 1); # Retrieves batch record 1 and returns an object containing the record
=cut
sub retrieve { sub retrieve {
my $invocant = shift; my $invocant = shift;
@ -234,17 +156,6 @@ sub retrieve {
return $self; return $self;
} }
=head2 C4::Labels::Batch->delete(batch_id => batch_id) | $batch->delete()
Invoking the delete method attempts to delete the batch from the database. The method returns 0 upon success
and 1 upon failure. Errors are logged to the syslog.
examples:
my $exitstat = $batch->delete(); # to delete the record behind the $batch object
my $exitstat = C4::Labels::Batch->delete(batch_id => 1); # to delete batch record 1
=cut
sub delete { sub delete {
my $self = {}; my $self = {};
my %opts = (); my %opts = ();
@ -275,16 +186,6 @@ sub delete {
return 0; return 0;
} }
=head2 C4::Labels::Batch->remove_duplicates(batch_id => batch_id) | $batch->remove_duplicates()
Invoking the remove_duplicates method attempts to remove duplicates the batch from the database. The method returns the count of duplicate
records removed upon success and -1 upon failure. Errors are logged to the syslog.
examples:
my $remove_count = $batch->remove_duplicates(); # to remove duplicates the record behind the $batch object
=cut
sub remove_duplicates { sub remove_duplicates {
my $self = shift; my $self = shift;
my %seen=(); my %seen=();
@ -306,9 +207,103 @@ sub remove_duplicates {
1; 1;
__END__ __END__
=head1 NAME
C4::Labels::Batch - A class for creating and manipulating batch objects in Koha
=head1 ABSTRACT
This module provides methods for creating, and otherwise manipulating batch objects used by Koha to create and export labels.
=head1 METHODS
=head2 new()
Invoking the I<new> method constructs a new batch object with no items. It is possible to pre-populate the batch with items and a branch code by passing them
as in the second example below.
B<NOTE:> The items list must be an arrayref pointing to an array of hashes containing a key/data pair after this fashion: {item_number => item_number}. The order of
the array elements determines the order of the items in the batch.
example:
C<my $batch = C4::Labels::Batch->new(); # Creates and returns a new batch object>
C<my $batch = C4::Labels::Batch->new(items => $arrayref, branch_code => branch_code) # Creates and returns a new batch object containing the items passed in
with the branch code passed in.>
B<NOTE:> This batch is I<not> written to the database until C<$batch->save()> is invoked. You have been warned!
=head2 $batch->add_item(item_number => $item_number, branch_code => $branch_code)
Invoking the I<add_item> method will add the supplied item to the batch object.
example:
$batch->add_item(item_number => $item_number, branch_code => $branch_code);
=head2 $batch->get_attr($attribute)
Invoking the I<get_attr> method will return the requested attribute.
example:
my @items = $batch->get_attr('items');
=head2 $batch->remove_item($item_number)
Invoking the I<remove_item> method will remove the supplied item number from the batch object.
example:
$batch->remove_item($item_number);
=head2 C4::Labels::Batch->retrieve(batch_id => $batch_id)
Invoking the I<retrieve> method constructs a new batch object containing the current values for batch_id. The method returns a new object upon success and 1 upon failure.
Errors are logged to the syslog.
examples:
my $batch = C4::Labels::Batch->retrieve(batch_id => 1); # Retrieves batch 1 and returns an object containing the record
=head2 delete()
Invoking the delete method attempts to delete the template from the database. The method returns -1 upon failure. Errors are logged to the syslog.
NOTE: This method may also be called as a function and passed a key/value pair simply deleteing that batch from the database. See the example below.
examples:
my $exitstat = $batch->delete(); # to delete the record behind the $batch object
my $exitstat = C4::Labels::Batch->delete(batch_id => 1); # to delete batch 1
=head2 remove_duplicates()
Invoking the remove_duplicates method attempts to remove duplicate items in the batch from the database. The method returns the count of duplicate records removed upon
success and -1 upon failure. Errors are logged to the syslog.
NOTE: This method may also be called as a function and passed a key/value pair removing duplicates in the batch passed in. See the example below.
examples:
my $remove_count = $batch->remove_duplicates(); # to remove duplicates the record behind the $batch object
my $remove_count = C4::Labels::Batch->remove_duplicates(batch_id => 1); # to remove duplicates in batch 1
=head1 AUTHOR =head1 AUTHOR
Chris Nighswonger <cnighswonger AT foundations DOT edu> Chris Nighswonger <cnighswonger AT foundations DOT edu>
=head1 COPYRIGHT
Copyright 2009 Foundations Bible College.
=head1 LICENSE
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.
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
=head1 DISCLAIMER OF WARRANTY
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.
=cut =cut

424
C4/Labels/Label.pm
View file

@ -1,23 +1,5 @@
package C4::Labels::Label; package C4::Labels::Label;
# Copyright 2006 Katipo Communications.
# Some parts Copyright 2009 Foundations Bible College.
#
# 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 strict;
use warnings; use warnings;
@ -29,7 +11,6 @@ use Text::CSV_XS;
use C4::Context; use C4::Context;
use C4::Debug; use C4::Debug;
use C4::Biblio; use C4::Biblio;
use Data::Dumper;
BEGIN { BEGIN {
use version; our $VERSION = qv('1.0.0_1'); use version; our $VERSION = qv('1.0.0_1');
@ -37,6 +18,47 @@ BEGIN {
my $possible_decimal = qr/\d{3,}(?:\.\d+)?/; # at least three digits for a DDCN my $possible_decimal = qr/\d{3,}(?:\.\d+)?/; # at least three digits for a DDCN
sub _check_params {
my $given_params = {};
my $exit_code = 0;
my @valid_label_params = (
'batch_id',
'item_number',
'llx',
'lly',
'height',
'width',
'top_text_margin',
'left_text_margin',
'barcode_type',
'printing_type',
'guidebox',
'font',
'font_size',
'callnum_split',
'justify',
'format_string',
'text_wrap_cols',
'barcode',
);
if (scalar(@_) >1) {
$given_params = {@_};
foreach my $key (keys %{$given_params}) {
if (!(grep m/$key/, @valid_label_params)) {
syslog("LOG_ERR", "C4::Labels::Label : Unrecognized parameter type of \"%s\".", $key);
$exit_code = 1;
}
}
}
else {
if (!(grep m/$_/, @valid_label_params)) {
syslog("LOG_ERR", "C4::Labels::Label : Unrecognized parameter type of \"%s\".", $_);
$exit_code = 1;
}
}
return $exit_code;
}
sub _guide_box { sub _guide_box {
my ( $llx, $lly, $width, $height ) = @_; my ( $llx, $lly, $width, $height ) = @_;
my $obj_stream = "q\n"; # save the graphic state my $obj_stream = "q\n"; # save the graphic state
@ -53,14 +75,10 @@ sub _get_label_item {
my $item_number = shift; my $item_number = shift;
my $barcode_only = shift || 0; my $barcode_only = shift || 0;
my $dbh = C4::Context->dbh; my $dbh = C4::Context->dbh;
my $query =
# FIXME This makes for a very bulky data structure; data from tables w/duplicate col names also gets overwritten. # FIXME This makes for a very bulky data structure; data from tables w/duplicate col names also gets overwritten.
# Something like this, perhaps, but this also causes problems because we need more fields sometimes. # Something like this, perhaps, but this also causes problems because we need more fields sometimes.
# SELECT i.barcode, i.itemcallnumber, i.itype, bi.isbn, bi.issn, b.title, b.author # SELECT i.barcode, i.itemcallnumber, i.itype, bi.isbn, bi.issn, b.title, b.author
"SELECT bi.*, i.*, b.* my $sth = $dbh->prepare("SELECT bi.*, i.*, b.* FROM items AS i, biblioitems AS bi ,biblio AS b WHERE itemnumber=? AND i.biblioitemnumber=bi.biblioitemnumber AND bi.biblionumber=b.biblionumber;");
FROM items AS i, biblioitems AS bi ,biblio AS b
WHERE itemnumber=? AND i.biblioitemnumber=bi.biblioitemnumber AND bi.biblionumber=b.biblionumber";
my $sth = $dbh->prepare($query);
$sth->execute($item_number); $sth->execute($item_number);
if ($sth->err) { if ($sth->err) {
syslog("LOG_ERR", "C4::Labels::Label::_get_label_item : Database returned the following error: %s", $sth->errstr); syslog("LOG_ERR", "C4::Labels::Label::_get_label_item : Database returned the following error: %s", $sth->errstr);
@ -115,8 +133,6 @@ sub _split_ddcn {
my ($ddcn) = @_; my ($ddcn) = @_;
$_ = $ddcn; $_ = $ddcn;
s/\///g; # in theory we should be able to simply remove all segmentation markers and arrive at the correct call number... s/\///g; # in theory we should be able to simply remove all segmentation markers and arrive at the correct call number...
# ddcn examples: 'R220.3 H2793Z H32 c.2', 'BIO JP2 R5c.1'
my (@parts) = m/ my (@parts) = m/
^([a-zA-Z-]+(?:$possible_decimal)?) # R220.3 # BIO # first example will require extra splitting ^([a-zA-Z-]+(?:$possible_decimal)?) # R220.3 # BIO # first example will require extra splitting
\s+ \s+
@ -278,12 +294,57 @@ sub _desc_koha_tables {
return $kohatables; return $kohatables;
} }
### This series of functions calculates the position of text and barcode on individual labels
### Please *do not* add printing types which are non-atomic. Instead, build code which calls the necessary atomic printing types to form the non-atomic types. See the ALT type
### in labels/label-create-pdf.pl as an example.
### NOTE: Each function must be passed seven parameters and return seven even if some are 0 or undef
sub _BIB {
my $self = shift;
my $line_spacer = ($self->{'font_size'} * 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 $text_lly = ($self->{'lly'} + ($self->{'height'} - $self->{'top_text_margin'}));
return $self->{'llx'}, $text_lly, $line_spacer, 0, 0, 0, 0;
}
sub _BAR {
my $self = shift;
my $barcode_llx = $self->{'llx'} + $self->{'left_text_margin'}; # this places the bottom left of the barcode the left text margin distance to right of the the left edge of the label ($llx)
my $barcode_lly = $self->{'lly'} + $self->{'top_text_margin'}; # this places the bottom left of the barcode the top text margin distance above the bottom of the label ($lly)
my $barcode_width = 0.8 * $self->{'width'}; # this scales the barcode width to 80% of the label width
my $barcode_y_scale_factor = 0.01 * $self->{'height'}; # this scales the barcode height to 10% of the label height
return 0, 0, 0, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
}
sub _BIBBAR {
my $self = shift;
my $barcode_llx = $self->{'llx'} + $self->{'left_text_margin'}; # this places the bottom left of the barcode the left text margin distance to right of the the left edge of the label ($self->{'llx'})
my $barcode_lly = $self->{'lly'} + $self->{'top_text_margin'}; # this places the bottom left of the barcode the top text margin distance above the bottom of the label ($lly)
my $barcode_width = 0.8 * $self->{'width'}; # this scales the barcode width to 80% of the label width
my $barcode_y_scale_factor = 0.01 * $self->{'height'}; # this scales the barcode height to 10% of the label height
my $line_spacer = ($self->{'font_size'} * 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 $text_lly = ($self->{'lly'} + ($self->{'height'} - $self->{'top_text_margin'}));
return $self->{'llx'}, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
}
sub _BARBIB {
my $self = shift;
my $barcode_llx = $self->{'llx'} + $self->{'left_text_margin'}; # this places the bottom left of the barcode the left text margin distance to right of the the left edge of the label ($self->{'llx'})
my $barcode_lly = ($self->{'lly'} + $self->{'height'}) - $self->{'top_text_margin'}; # this places the bottom left of the barcode the top text margin distance below the top of the label ($self->{'lly'})
my $barcode_width = 0.8 * $self->{'width'}; # this scales the barcode width to 80% of the label width
my $barcode_y_scale_factor = 0.01 * $self->{'height'}; # this scales the barcode height to 10% of the label height
my $line_spacer = ($self->{'font_size'} * 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 $text_lly = (($self->{'lly'} + $self->{'height'}) - $self->{'top_text_margin'} - (($self->{'lly'} + $self->{'height'}) - $barcode_lly));
return $self->{'llx'}, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
}
sub new { sub new {
my ($invocant, %params) = @_; my ($invocant, %params) = @_;
my $type = ref($invocant) || $invocant; my $type = ref($invocant) || $invocant;
my $self = { my $self = {
batch_id => $params{'batch_id'}, batch_id => $params{'batch_id'},
item_number => $params{'item_number'}, item_number => $params{'item_number'},
llx => $params{'llx'},
lly => $params{'lly'},
height => $params{'height'}, height => $params{'height'},
width => $params{'width'}, width => $params{'width'},
top_text_margin => $params{'top_text_margin'}, top_text_margin => $params{'top_text_margin'},
@ -311,20 +372,11 @@ sub get_label_type {
return $self->{'printing_type'}; return $self->{'printing_type'};
} }
=head2 $label->get_attr("attr")
Invoking the I<get_attr> method will return the value of the requested attribute or 1 on errors.
example:
my $value = $label->get_attr("attr");
=cut
sub get_attr { sub get_attr {
my $self = shift; my $self = shift;
# if (_check_params(@_) eq 1) { if (_check_params(@_) eq 1) {
# return -1; return -1;
# } }
my ($attr) = @_; my ($attr) = @_;
if (exists($self->{$attr})) { if (exists($self->{$attr})) {
return $self->{$attr}; return $self->{$attr};
@ -335,20 +387,32 @@ sub get_attr {
return; return;
} }
=head2 $label->draw_label_text() sub create_label {
my $self = shift;
Invoking the I<draw_label_text> method generates the label text for the label object. my $label_text = '';
example: my ($text_llx, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor);
$label->draw_label_text( {
llx => $text_llx, no strict 'refs';
lly => $text_lly, ($text_llx, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor) = &{"_$self->{'printing_type'}"}($self); # an obfuscated call to the correct printing type sub
top_text_margin => $label_top_text_margin, }
line_spacer => $text_leading, if ($self->{'printing_type'} =~ /BIB/) {
font => $text_font, $label_text = draw_label_text( $self,
font_size => $text_font_size, llx => $text_llx,
justify => $text_justification, lly => $text_lly,
line_spacer => $line_spacer,
);
}
if ($self->{'printing_type'} =~ /BAR/) {
barcode( $self,
llx => $barcode_llx,
lly => $barcode_lly,
width => $barcode_width,
y_scale_factor => $barcode_y_scale_factor,
); );
=cut }
return $label_text if $label_text;
return;
}
sub draw_label_text { sub draw_label_text {
my ($self, %params) = @_; my ($self, %params) = @_;
@ -441,30 +505,13 @@ sub draw_label_text {
return \@label_text; return \@label_text;
} }
=head2 $label->barcode()
Invoking the I<barcode> method generates a barcode for the label object and inserts it into the current pdf stream. C<barcode_data> is optional
and omitting it will cause the barcode from the current item to be used. C<barcode_type> is also optional. Omission results in the barcode
type of the current template being used.
example:
$label->barcode(
llx => $barcode_llx,
lly => $barcode_lly,
width => $barcode_width,
y_scale_factor => $barcode_y_scale_factor,
barcode_data => $barcode,
barcode_type => $barcodetype,
);
=cut
sub barcode { sub barcode {
my $self = shift; my $self = shift;
my %params = @_; my %params = @_;
$params{'barcode'} = _get_label_item($self->{'item_number'}, 1) if !$params{'barcode'}; $params{'barcode_data'} = _get_label_item($self->{'item_number'}, 1) if !$params{'barcode_data'};
$params{'barcode_type'} = $self->{'barcode_type'} if !$params{'barcode_type'}; $params{'barcode_type'} = $self->{'barcode_type'} if !$params{'barcode_type'};
my $x_scale_factor = 1; my $x_scale_factor = 1;
my $num_of_bars = length($params{'barcode'}); my $num_of_bars = length($params{'barcode_data'});
my $tot_bar_length = 0; my $tot_bar_length = 0;
my $bar_length = 0; my $bar_length = 0;
my $guard_length = 10; my $guard_length = 10;
@ -475,18 +522,18 @@ sub barcode {
$x_scale_factor = ($params{'width'} / $tot_bar_length); $x_scale_factor = ($params{'width'} / $tot_bar_length);
if ($params{'barcode_type'} eq 'CODE39MOD') { if ($params{'barcode_type'} eq 'CODE39MOD') {
my $c39 = CheckDigits('visa'); # get modulo43 checksum my $c39 = CheckDigits('visa'); # get modulo43 checksum
$params{'barcode'} = $c39->complete($params{'barcode'}); $params{'barcode_data'} = $c39->complete($params{'barcode_data'});
} }
elsif ($params{'barcode_type'} eq 'CODE39MOD10') { elsif ($params{'barcode_type'} eq 'CODE39MOD10') {
my $c39_10 = CheckDigits('visa'); # get modulo43 checksum my $c39_10 = CheckDigits('visa'); # get modulo43 checksum
$params{'barcode'} = $c39_10->complete($params{'barcode'}); $params{'barcode_data'} = $c39_10->complete($params{'barcode_data'});
$hide_text = ''; $hide_text = '';
} }
eval { eval {
PDF::Reuse::Barcode::Code39( PDF::Reuse::Barcode::Code39(
x => $params{'llx'}, x => $params{'llx'},
y => $params{'lly'}, y => $params{'lly'},
value => "*$params{barcode}*", value => "*$params{barcode_data}*",
xSize => $x_scale_factor, xSize => $x_scale_factor,
ySize => $params{'y_scale_factor'}, ySize => $params{'y_scale_factor'},
hide_asterisk => 1, hide_asterisk => 1,
@ -506,7 +553,7 @@ sub barcode {
PDF::Reuse::Barcode::COOP2of5( PDF::Reuse::Barcode::COOP2of5(
x => $params{'llx'}, x => $params{'llx'},
y => $params{'lly'}, y => $params{'lly'},
value => "*$params{barcode}*", value => "*$params{barcode_data}*",
xSize => $x_scale_factor, xSize => $x_scale_factor,
ySize => $params{'y_scale_factor'}, ySize => $params{'y_scale_factor'},
mode => 'graphic', mode => 'graphic',
@ -524,7 +571,7 @@ sub barcode {
PDF::Reuse::Barcode::Industrial2of5( PDF::Reuse::Barcode::Industrial2of5(
x => $params{'llx'}, x => $params{'llx'},
y => $params{'lly'}, y => $params{'lly'},
value => "*$params{barcode}*", value => "*$params{barcode_data}*",
xSize => $x_scale_factor, xSize => $x_scale_factor,
ySize => $params{'y_scale_factor'}, ySize => $params{'y_scale_factor'},
mode => 'graphic', mode => 'graphic',
@ -548,10 +595,235 @@ sub csv_data {
1; 1;
__END__ __END__
=head1 NAME
C4::Labels::Label - A class for creating and manipulating label objects in Koha
=head1 ABSTRACT
This module provides methods for creating, and otherwise manipulating single label objects used by Koha to create and export labels.
=head1 METHODS
=head2 new()
Invoking the I<new> method constructs a new label object containing the supplied values. Depending on the final output format of the label data
the minimal required parameters change. (See the implimentation of this object type in labels/label-create-pdf.pl and labels/label-create-csv.pl
and labels/label-create-xml.pl for examples.) The following parameters are optionally accepted as key => value pairs:
C<batch_id> Batch id with which this label is associated
C<item_number> Item number of item to be the data source for this label
C<height> Height of this label (All measures passed to this method B<must> be supplied in postscript points)
C<width> Width of this label
C<top_text_margin> Top margin of this label
C<left_text_margin> Left margin of this label
C<barcode_type> Defines the barcode type to be used on labels. NOTE: At present only the following barcode types are supported in the label creator code:
=over 9
=item .
CODE39 = Code 3 of 9
=item .
CODE39MOD = Code 3 of 9 with modulo 43 checksum
=item .
CODE39MOD10 = Code 3 of 9 with modulo 10 checksum
=item .
COOP2OF5 = A varient of 2 of 5 barcode based on NEC's "Process 8000" code
=item .
INDUSTRIAL2OF5 = The standard 2 of 5 barcode (a binary level bar code developed by Identicon Corp. and Computer Identics Corp. in 1970)
=back
C<printing_type> Defines the general layout to be used on labels. NOTE: At present there are only five printing types supported in the label creator code:
=over 9
=item .
BIB = Only the bibliographic data is printed
=item .
BARBIB = Barcode proceeds bibliographic data
=item .
BIBBAR = Bibliographic data proceeds barcode
=item .
ALT = Barcode and bibliographic data are printed on alternating labels
=item .
BAR = Only the barcode is printed
=back
C<guidebox> Setting this to '1' will result in a guide box being drawn around the labels marking the edge of each label
C<font> Defines the type of font to be used on labels. NOTE: The following fonts are available by default on most systems:
=over 9
=item .
TR = Times-Roman
=item .
TB = Times Bold
=item .
TI = Times Italic
=item .
TBI = Times Bold Italic
=item .
C = Courier
=item .
CB = Courier Bold
=item .
CO = Courier Oblique (Italic)
=item .
CBO = Courier Bold Oblique
=item .
H = Helvetica
=item .
HB = Helvetica Bold
=item .
HBO = Helvetical Bold Oblique
=back
C<font_size> Defines the size of the font in postscript points to be used on labels
C<callnum_split> Setting this to '1' will enable call number splitting on labels
C<text_justify> Defines the text justification to be used on labels. NOTE: The following justification styles are currently supported by label creator code:
=over 9
=item .
L = Left
=item .
C = Center
=item .
R = Right
=back
C<format_string> Defines what fields will be printed and in what order they will be printed on labels. These include any of the data fields that may be mapped
to your MARC frameworks. Specify MARC subfields as a 4-character tag-subfield string: ie. 254a Enclose a whitespace-separated list of fields
to concatenate on one line in double quotes. ie. "099a 099b" or "itemcallnumber barcode" Static text strings may be entered in single-quotes:
ie. 'Some static text here.'
C<text_wrap_cols> Defines the column after which the text will wrap to the next line.
=head2 get_label_type()
Invoking the I<get_label_type> method will return the printing type of the label object.
example:
C<my $label_type = $label->get_label_type();>
=head2 get_attr($attribute)
Invoking the I<get_attr> method will return the value of the requested attribute or -1 on errors.
example:
C<my $value = $label->get_attr($attribute);>
=head2 create_label()
Invoking the I<create_label> method generates the text for that label and returns it as an arrayref of an array contianing the formatted text as well as creating the barcode
and writing it directly to the pdf stream. The handling of the barcode is not quite good OO form due to the linear format of PDF::Reuse::Barcode. Be aware that the instantiating
code is responsible to properly format the text for insertion into the pdf stream as well as the actual insertion.
example:
my $label_text = $label->create_label();
=head2 draw_label_text()
Invoking the I<draw_label_text> method generates the label text for the label object and returns it as an arrayref of an array containing the formatted text. The same caveats
apply to this method as to C<create_label()>. This method accepts the following parameters as key => value pairs: (NOTE: The unit is the postscript point - 72 per inch)
C<llx> The lower-left x coordinate for the text block (The point of origin for all PDF's is the lower left of the page per ISO 32000-1)
C<lly> The lower-left y coordinate for the text block
C<top_text_margin> The top margin for the text block.
C<line_spacer> The number of pixels between text rows (This is actually leading: baseline to baseline minus font size. Recommended starting point is 20% of font size)
C<font> The font to use for this label. See documentation on the new() method for supported fonts.
C<font_size> The font size in points to use for this label.
C<justify> The style of justification to use for this label. See documentation on the new() method for supported justification styles.
example:
C<my $label_text = $label->draw_label_text(
llx => $text_llx,
lly => $text_lly,
top_text_margin => $label_top_text_margin,
line_spacer => $text_leading,
font => $text_font,
font_size => $text_font_size,
justify => $text_justification,
);>
=head2 barcode()
Invoking the I<barcode> method generates a barcode for the label object and inserts it into the current pdf stream. This method accepts the following parameters as key => value
pairs (C<barcode_data> is optional and omitting it will cause the barcode from the current item to be used. C<barcode_type> is also optional. Omission results in the barcode
type of the current template being used.):
C<llx> The lower-left x coordinate for the barcode block (The point of origin for all PDF's is the lower left of the page per ISO 32000-1)
C<lly> The lower-left y coordinate for the barcode block
C<width> The width of the barcode block
C<y_scale_factor> The scale factor to be applied to the y axis of the barcode block
C<barcode_data> The data to be encoded in the barcode
C<barcode_type> The barcode type (See the C<new()> method for supported barcode types)
example:
C<$label->barcode(
llx => $barcode_llx,
lly => $barcode_lly,
width => $barcode_width,
y_scale_factor => $barcode_y_scale_factor,
barcode_data => $barcode,
barcode_type => $barcodetype,
);>
=head2 csv_data()
Invoking the I<csv_data> method returns an arrayref of an array containing the label data suitable for passing to Text::CSV_XS->combine() to produce csv output.
example:
C<my $csv_data = $label->csv_data();>
=head1 AUTHOR =head1 AUTHOR
Mason James <mason@katipo.co.nz> Mason James <mason@katipo.co.nz>
Chris Nighswonger <cnighswonger AT foundations DOT edu> Chris Nighswonger <cnighswonger AT foundations DOT edu>
=cut =head1 COPYRIGHT
Copyright 2006 Katipo Communications.
Copyright 2009 Foundations Bible College.
=head1 LICENSE
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.
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
=head1 DISCLAIMER OF WARRANTY
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.
=cut

292
C4/Labels/Layout.pm
View file

@ -1,22 +1,5 @@
package C4::Labels::Layout; package C4::Labels::Layout;
# Copyright 2009 Foundations Bible College.
#
# 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 strict;
use warnings; use warnings;
@ -25,7 +8,7 @@ use DBI qw(neat);
use C4::Context; use C4::Context;
use C4::Debug; use C4::Debug;
use Data::Dumper; use C4::Labels::PDF;
BEGIN { BEGIN {
use version; our $VERSION = qv('1.0.0_1'); use version; our $VERSION = qv('1.0.0_1');
@ -74,25 +57,6 @@ sub _check_params {
return $exit_code; return $exit_code;
} }
=head1 NAME
C4::Labels::Layout -A class for creating and manipulating layout objects in Koha
=cut
=head1 METHODS
=head2 C4::Labels::Layout->new()
Invoking the I<new> method constructs a new layout object containing the default values for a layout.
example:
my $layout = Layout->new(); # Creates and returns a new layout object
B<NOTE:> This layout is I<not> written to the database untill $layout->save() is invoked. You have been warned!
=cut
sub new { sub new {
my $invocant = shift; my $invocant = shift;
if (_check_params(@_) eq 1) { if (_check_params(@_) eq 1) {
@ -115,16 +79,6 @@ sub new {
return $self; return $self;
} }
=head2 Layout->retrieve(layout_id => layout_id)
Invoking the I<retrieve> method constructs a new layout object containing the current values for layout_id. The method returns
a new object upon success and 1 upon failure. Errors are logged to the syslog.
example:
my $layout = Layout->retrieve(layout_id => 1); # Retrieves layout record 1 and returns an object containing the record
=cut
sub retrieve { sub retrieve {
my $invocant = shift; my $invocant = shift;
my %opts = @_; my %opts = @_;
@ -141,17 +95,6 @@ sub retrieve {
return $self; return $self;
} }
=head2 Layout->delete(layout_id => layout_id) | $layout->delete()
Invoking the delete method attempts to delete the layout from the database. The method returns 0 upon success
and 1 upon failure. Errors are logged to the syslog.
examples:
my $exitstat = $layout->delete(); # to delete the record behind the $layout object
my $exitstat = Layout->delete(layout_id => 1); # to delete layout record 1
=cut
sub delete { sub delete {
my $self = {}; my $self = {};
my %opts = (); my %opts = ();
@ -181,17 +124,6 @@ sub delete {
return 0; return 0;
} }
=head2 $layout->save()
Invoking the I<save> method attempts to insert the layout into the database if the layout is new and
update the existing layout record if the layout exists. The method returns the new record id upon
success and -1 upon failure (This avoids conflicting with a record id of 1). Errors are logged to the syslog.
example:
my $exitstat = $layout->save(); # to save the record behind the $layout object
=cut
sub save { sub save {
my $self = shift; my $self = shift;
if ($self->{'layout_id'}) { # if we have an id, the record exists and needs UPDATE if ($self->{'layout_id'}) { # if we have an id, the record exists and needs UPDATE
@ -241,15 +173,6 @@ sub save {
} }
} }
=head2 $layout->get_attr("attr")
Invoking the I<get_attr> method will return the value of the requested attribute or 1 on errors.
example:
my $value = $layout->get_attr("attr");
=cut
sub get_attr { sub get_attr {
my $self = shift; my $self = shift;
if (_check_params(@_) eq 1) { if (_check_params(@_) eq 1) {
@ -265,15 +188,6 @@ sub get_attr {
return; return;
} }
=head2 $layout->set_attr(attr => value)
Invoking the I<set_attr> method will set the value of the supplied attribute to the supplied value.
example:
$layout->set_attr(attr => value);
=cut
sub set_attr { sub set_attr {
my $self = shift; my $self = shift;
if (_check_params(@_) eq 1) { if (_check_params(@_) eq 1) {
@ -286,16 +200,6 @@ sub set_attr {
return 0; return 0;
} }
=head2 $layout->get_text_wrap_cols()
Invoking the I<get_text_wrap_cols> method will return the number of columns that can be printed on the
label before wrapping to the next line.
examples:
my $text_wrap_cols = $layout->get_text_wrap_cols();
=cut
sub get_text_wrap_cols { sub get_text_wrap_cols {
my $self = shift; my $self = shift;
my %params = @_; my %params = @_;
@ -315,8 +219,202 @@ sub get_text_wrap_cols {
1; 1;
__END__ __END__
=head1 NAME
C4::Labels::Layout -A class for creating and manipulating layout objects in Koha
=head1 ABSTRACT
This module provides methods for creating, retrieving, and otherwise manipulating label layout objects used by Koha to create and export labels.
=head1 METHODS
=head2 new()
Invoking the I<new> method constructs a new layout object containing the default values for a layout.
The following parameters are optionally accepted as key => value pairs:
C<barcode_type> Defines the barcode type to be used on labels. NOTE: At present only the following barcode types are supported in the label creator code:
=over 9
=item .
CODE39 = Code 3 of 9
=item .
CODE39MOD = Code 3 of 9 with modulo 43 checksum
=item .
CODE39MOD10 = Code 3 of 9 with modulo 10 checksum
=item .
COOP2OF5 = A varient of 2 of 5 barcode based on NEC's "Process 8000" code
=item .
INDUSTRIAL2OF5 = The standard 2 of 5 barcode (a binary level bar code developed by Identicon Corp. and Computer Identics Corp. in 1970)
=back
C<printing_type> Defines the general layout to be used on labels. NOTE: At present there are only five printing types supported in the label creator code:
=over 9
=item .
BIB = Only the bibliographic data is printed
=item .
BARBIB = Barcode proceeds bibliographic data
=item .
BIBBAR = Bibliographic data proceeds barcode
=item .
ALT = Barcode and bibliographic data are printed on alternating labels
=item .
BAR = Only the barcode is printed
=back
C<layout_name> The descriptive name for this layout.
C<guidebox> Setting this to '1' will result in a guide box being drawn around the labels marking the edge of each label
C<font> Defines the type of font to be used on labels. NOTE: The following fonts are available by default on most systems:
=over 9
=item .
TR = Times-Roman
=item .
TB = Times Bold
=item .
TI = Times Italic
=item .
TBI = Times Bold Italic
=item .
C = Courier
=item .
CB = Courier Bold
=item .
CO = Courier Oblique (Italic)
=item .
CBO = Courier Bold Oblique
=item .
H = Helvetica
=item .
HB = Helvetica Bold
=item .
HBO = Helvetical Bold Oblique
=back
C<font_size> Defines the size of the font in postscript points to be used on labels
C<callnum_split> Setting this to '1' will enable call number splitting on labels
C<text_justify> Defines the text justification to be used on labels. NOTE: The following justification styles are currently supported by label creator code:
=over 9
=item .
L = Left
=item .
C = Center
=item .
R = Right
=back
C<format_string> Defines what fields will be printed and in what order they will be printed on labels. These include any of the data fields that may be mapped
to your MARC frameworks. Specify MARC subfields as a 4-character tag-subfield string: ie. 254a Enclose a whitespace-separated list of fields
to concatenate on one line in double quotes. ie. "099a 099b" or "itemcallnumber barcode" Static text strings may be entered in single-quotes:
ie. 'Some static text here.'
example:
C<my $layout = Layout->new(); # Creates and returns a new layout object>
C<my $layout = C4::Labels::Layout->new(barcode_type => 'CODE39', printing_type => 'BIBBAR', font => 'C', font_size => 6); # Creates and returns a new layout object using
the supplied values to override the defaults>
B<NOTE:> This layout is I<not> written to the database until save() is invoked. You have been warned!
=head2 retrieve(layout_id => layout_id)
Invoking the I<retrieve> method constructs a new layout object containing the current values for layout_id. The method returns a new object upon success and 1 upon failure.
Errors are logged to the syslog.
example:
C<my $layout = Layout->retrieve(layout_id => 1); # Retrieves layout record 1 and returns an object containing the record>
=head2 delete()
Invoking the delete method attempts to delete the layout from the database. The method returns 0 upon success and -1 upon failure. Errors are logged to the syslog.
NOTE: This method may also be called as a function and passed a key/value pair simply deleteing that template from the database. See the example below.
examples:
C<my $exitstat = $layout->delete(); # to delete the record behind the $layout object>
C<my $exitstat = Layout->delete(layout_id => 1); # to delete layout record 1>
=head2 save()
Invoking the I<save> method attempts to insert the layout into the database if the layout is new and update the existing layout record if the layout exists.
The method returns the new record id upon success and -1 upon failure (This avoids conflicting with a record id of 1). Errors are logged to the syslog.
example:
C<my $exitstat = $layout->save(); # to save the record behind the $layout object>
=head2 get_attr($attribute)
Invoking the I<get_attr> method will return the value of the requested attribute or -1 on errors.
example:
C<my $value = $layout->get_attr($attribute);>
=head2 set_attr(attribute => value, attribute_2 => value)
Invoking the I<set_attr> method will set the value of the supplied attributes to the supplied values. The method accepts key/value pairs separated by
commas.
example:
C<$layout->set_attr(attribute => value);>
=head2 get_text_wrap_cols()
Invoking the I<get_text_wrap_cols> method will return the number of columns that can be printed on the label before wrapping to the next line.
examples:
C<my $text_wrap_cols = $layout->get_text_wrap_cols();>
=head1 AUTHOR =head1 AUTHOR
Chris Nighswonger <cnighswonger AT foundations DOT edu> Chris Nighswonger <cnighswonger AT foundations DOT edu>
=head1 COPYRIGHT
Copyright 2009 Foundations Bible College.
=head1 LICENSE
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.
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
=head1 DISCLAIMER OF WARRANTY
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.
=cut =cut

262
C4/Labels/Profile.pm
View file

@ -1,26 +1,8 @@
package C4::Labels::Profile; package C4::Labels::Profile;
# Copyright 2009 Foundations Bible College.
#
# 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 strict;
use warnings; use warnings;
use Sys::Syslog qw(syslog); use Sys::Syslog qw(syslog);
use Data::Dumper;
use C4::Context; use C4::Context;
use C4::Debug; use C4::Debug;
@ -71,25 +53,6 @@ sub _conv_points {
return $self; return $self;
} }
=head1 NAME
C4::Labels::Profile - A class for creating and manipulating profile objects in Koha
=cut
=head1 METHODS
=head2 C4::Labels::Profile->new()
Invoking the I<new> method constructs a new profile object containing the default values for a template.
example:
my $profile = Profile->new(); # Creates and returns a new profile object
B<NOTE:> This profile is I<not> written to the database untill $profile->save() is invoked. You have been warned!
=cut
sub new { sub new {
my $invocant = shift; my $invocant = shift;
if (_check_params(@_) eq 1) { if (_check_params(@_) eq 1) {
@ -111,21 +74,6 @@ sub new {
return $self; return $self;
} }
=head2 C4::Labels::Profile->retrieve(profile_id => profile_id, convert => 1)
Invoking the I<retrieve> method constructs a new profile object containing the current values for profile_id. The method returns
a new object upon success and 1 upon failure. Errors are logged to the syslog. One further option maybe accessed. See the examples
below for further description.
examples:
my $profile = C4::Labels::Profile->retrieve(profile_id => 1); # Retrieves profile record 1 and returns an object containing the record
my $profile = C4::Labels::Profile->retrieve(profile_id => 1, convert => 1); # Retrieves profile record 1, converts the units to points,
and returns an object containing the record
=cut
sub retrieve { sub retrieve {
my $invocant = shift; my $invocant = shift;
my %opts = @_; my %opts = @_;
@ -143,17 +91,6 @@ sub retrieve {
return $self; return $self;
} }
=head2 C4::Labels::Profile::delete(profile_id => profile_id) | $profile->delete()
Invoking the delete method attempts to delete the profile from the database. The method returns 0 upon success
and 1 upon failure. Errors are logged to the syslog.
examples:
my $exitstat = $profile->delete(); # to delete the record behind the $profile object
my $exitstat = C4::Labels::Profile::delete(profile_id => 1); # to delete profile record 1
=cut
sub delete { sub delete {
my $self = {}; my $self = {};
my %opts = (); my %opts = ();
@ -177,20 +114,8 @@ sub delete {
my $sth = C4::Context->dbh->prepare($query); my $sth = C4::Context->dbh->prepare($query);
# $sth->{'TraceLevel'} = 3; # $sth->{'TraceLevel'} = 3;
$sth->execute($query_param); $sth->execute($query_param);
return 0;
} }
=head2 $profile->save()
Invoking the I<save> method attempts to insert the profile into the database if the profile is new and
update the existing profile record if the profile exists. The method returns the new record profile_id upon
success and -1 upon failure (This avoids conflicting with a record profile_id of 1). Errors are logged to the syslog.
example:
my $exitstat = $profile->save(); # to save the record behind the $profile object
=cut
sub save { sub save {
my $self = shift; my $self = shift;
if ($self->{'profile_id'}) { # if we have an profile_id, the record exists and needs UPDATE if ($self->{'profile_id'}) { # if we have an profile_id, the record exists and needs UPDATE
@ -240,15 +165,6 @@ sub save {
} }
} }
=head2 $profile->get_attr(attr)
Invoking the I<get_attr> method will return the value of the requested attribute or 1 on errors.
example:
my $value = $profile->get_attr(attr);
=cut
sub get_attr { sub get_attr {
my $self = shift; my $self = shift;
if (_check_params(@_) eq 1) { if (_check_params(@_) eq 1) {
@ -264,15 +180,6 @@ sub get_attr {
} }
} }
=head2 $profile->set_attr(attr => value)
Invoking the I<set_attr> method will set the value of the supplied attribute to the supplied value.
example:
$profile->set_attr(attr => value);
=cut
sub set_attr { sub set_attr {
my $self = shift; my $self = shift;
if (_check_params(@_) eq 1) { if (_check_params(@_) eq 1) {
@ -285,54 +192,165 @@ sub set_attr {
return 0; return 0;
} }
1; 1;
__END__ __END__
=head1 NAME
C4::Labels::Profile - A class for creating and manipulating profile objects in Koha
=head1 ABSTRACT
This module provides methods for creating, retrieving, and otherwise manipulating label profile objects used by Koha to create and export labels.
=head1 METHODS
=head2 new()
Invoking the I<new> method constructs a new profile object containing the default values for a template.
The following parameters are optionally accepted as key => value pairs:
C<printer_name> The name of the printer to which this profile applies.
C<template_id> The template to which this profile may be applied. NOTE: There may be multiple profiles which may be applied to the same template.
C<paper_bin> The paper bin of the above printer to which this profile applies. NOTE: printer name, template id, and paper bin must form a unique combination.
C<offset_horz> Amount of compensation for horizontal offset (position of text on a single label). This amount is measured in the units supplied by the units parameter in this profile.
C<offset_vert> Amount of compensation for vertical offset.
C<creep_horz> Amount of compensation for horizontal creep (tendency of text to 'creep' off of the labels over the span of the entire page).
C<creep_vert> Amount of compensation for vertical creep.
C<units> The units of measure used for this template. These B<must> match the measures you supply above or
bad things will happen to your document. NOTE: The only supported units at present are:
=over 9
=item .
POINT = Postscript Points (This is the base unit in the Koha label creator.)
=item .
AGATE = Adobe Agates (5.1428571 points per)
=item .
INCH = US Inches (72 points per)
=item .
MM = SI Millimeters (2.83464567 points per)
=item .
CM = SI Centimeters (28.3464567 points per)
=back
example:
C<my $profile = C4::Labels::Profile->new(); # Creates and returns a new profile object>
C<my $profile = C4::Labels::Profile->new(template_id => 1, paper_bin => 'Bypass Tray', offset_horz => 0.02, units => 'POINT'); # Creates and returns a new profile object using
the supplied values to override the defaults>
B<NOTE:> This profile is I<not> written to the database until save() is invoked. You have been warned!
=head2 retrieve(profile_id => $profile_id, convert => 1)
Invoking the I<retrieve> method constructs a new profile object containing the current values for profile_id. The method returns a new object upon success and 1 upon failure.
Errors are logged to the syslog. One further option maybe accessed. See the examples below for further description.
examples:
C<my $profile = C4::Labels::Profile->retrieve(profile_id => 1); # Retrieves profile record 1 and returns an object containing the record>
C<my $profile = C4::Labels::Profile->retrieve(profile_id => 1, convert => 1); # Retrieves profile record 1, converts the units to points and returns an object containing the record>
=head2 delete()
Invoking the delete method attempts to delete the profile from the database. The method returns -1 upon failure. Errors are logged to the syslog.
NOTE: This method may also be called as a function and passed a key/value pair simply deleteing that profile from the database. See the example below.
examples:
C<my $exitstat = $profile->delete(); # to delete the record behind the $profile object>
C<my $exitstat = C4::Labels::Profile::delete(profile_id => 1); # to delete profile record 1>
=head2 save()
Invoking the I<save> method attempts to insert the profile into the database if the profile is new and update the existing profile record if the profile exists. The method returns
the new record profile_id upon success and -1 upon failure (This avoids conflicting with a record profile_id of 1). Errors are logged to the syslog.
example:
C<my $exitstat = $profile->save(); # to save the record behind the $profile object>
=head2 get_attr($attribute)
Invoking the I<get_attr> method will return the value of the requested attribute or -1 on errors.
example:
C<my $value = $profile->get_attr($attribute);>
=head2 set_attr(attribute => value, attribute_2 => value)
Invoking the I<set_attr> method will set the value of the supplied attributes to the supplied values. The method accepts key/value pairs separated by commas.
example:
$profile->set_attr(attribute => value);
=head1 AUTHOR =head1 AUTHOR
Chris Nighswonger <cnighswonger AT foundations DOT edu> Chris Nighswonger <cnighswonger AT foundations DOT edu>
=cut =head1 COPYRIGHT
Copyright 2009 Foundations Bible College.
=head1 =head1 LICENSE
drawbox( ($left_margin), ($top_margin), ($page_width-(2*$left_margin)), ($page_height-(2*$top_margin)) ); # FIXME: Breakout code to print alignment page for printer profile setup
ead2 draw_boundaries 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.
sub draw_boundaries ($llx_spine, $llx_circ1, $llx_circ2, 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,
$lly, $spine_width, $label_height, $circ_width) Suite 330, Boston, MA 02111-1307 USA
This sub draws boundary lines where the label outlines are, to aid in printer testing, and debugging. =head1 DISCLAIMER OF WARRANTY
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.
=cut =cut
# FIXME: Template use for profile adjustment... #=head1
#sub draw_boundaries { #drawbox( ($left_margin), ($top_margin), ($page_width-(2*$left_margin)), ($page_height-(2*$top_margin)) ); # FIXME: Breakout code to print alignment page for printer profile setup
# #
# my ( #=head2 draw_boundaries
# $llx_spine, $llx_circ1, $llx_circ2, $lly,
# $spine_width, $label_height, $circ_width
# ) = @_;
# #
# my $lly_initial = ( ( 792 - 36 ) - 90 ); # sub draw_boundaries ($llx_spine, $llx_circ1, $llx_circ2,
# $lly = $lly_initial; # FIXME - why are we ignoring the y_pos parameter by redefining it? # $lly, $spine_width, $label_height, $circ_width)
# my $i = 1;
# #
# for ( $i = 1 ; $i <= 8 ; $i++ ) { #This sub draws boundary lines where the label outlines are, to aid in printer testing, and debugging.
# #
# _draw_box( $llx_spine, $lly, ($spine_width), ($label_height) ); #=cut
# #
# #warn "OLD BOXES x=$llx_spine, y=$lly, w=$spine_width, h=$label_height"; ## FIXME: Template use for profile adjustment...
# _draw_box( $llx_circ1, $lly, ($circ_width), ($label_height) ); ##sub draw_boundaries {
# _draw_box( $llx_circ2, $lly, ($circ_width), ($label_height) ); ##
## my (
## $llx_spine, $llx_circ1, $llx_circ2, $lly,
## $spine_width, $label_height, $circ_width
## ) = @_;
##
## my $lly_initial = ( ( 792 - 36 ) - 90 );
## $lly = $lly_initial; # FIXME - why are we ignoring the y_pos parameter by redefining it?
## my $i = 1;
##
## for ( $i = 1 ; $i <= 8 ; $i++ ) {
##
## _draw_box( $llx_spine, $lly, ($spine_width), ($label_height) );
##
## #warn "OLD BOXES x=$llx_spine, y=$lly, w=$spine_width, h=$label_height";
## _draw_box( $llx_circ1, $lly, ($circ_width), ($label_height) );
## _draw_box( $llx_circ2, $lly, ($circ_width), ($label_height) );
##
## $lly = ( $lly - $label_height );
##
## }
##}
# #
# $lly = ( $lly - $label_height );
# #
# } #
#} #=cut
=cut

256
C4/Labels/Template.pm
View file

@ -1,26 +1,8 @@
package C4::Labels::Template; package C4::Labels::Template;
# Copyright 2009 Foundations Bible College.
#
# 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 strict;
use warnings; use warnings;
use Sys::Syslog qw(syslog); use Sys::Syslog qw(syslog);
use Data::Dumper;
use PDF::Reuse; use PDF::Reuse;
use POSIX qw(ceil); use POSIX qw(ceil);
@ -99,25 +81,6 @@ sub _apply_profile {
return $self; return $self;
} }
=head1 NAME
C4::Labels::Template - A class for creating and manipulating template objects in Koha
=cut
=head1 METHODS
=head2 C4::Labels::Template->new()
Invoking the I<new> method constructs a new template object containing the default values for a template.
example:
my $template = Template->new(); # Creates and returns a new template object
B<NOTE:> This template is I<not> written to the database untill $template->save() is invoked. You have been warned!
=cut
sub new { sub new {
my $invocant = shift; my $invocant = shift;
if (_check_params(@_) eq 1) { if (_check_params(@_) eq 1) {
@ -141,31 +104,13 @@ sub new {
col_gap => 0, col_gap => 0,
row_gap => 0, row_gap => 0,
units => 'POINT', units => 'POINT',
tmpl_stat => 0, # false if any data has changed and the db has not been updated template_stat => 0, # false if any data has changed and the db has not been updated
@_, @_,
}; };
bless ($self, $type); bless ($self, $type);
return $self; return $self;
} }
=head2 C4::Labels::Template->retrieve(template_id)
Invoking the I<retrieve> method constructs a new template object containing the current values for template_id. The method returns
a new object upon success and 1 upon failure. Errors are logged to the syslog. Two further options may be accessed. See the example
below for further description.
examples:
my $template = C4::Labels::Template->retrieve(template_id => 1); # Retrieves template record 1 and returns an object containing the record
my $template = C4::Labels::Template->retrieve(template_id => 1, convert => 1); # Retrieves template record 1, converts the units to points,
and returns an object containing the record
my $template = C4::Labels::Template->retrieve(template_id => 1, profile_id => profile_id); # Retrieves template record 1, converts the units
to points, applies the given profile id, and returns an object containing the record
=cut
sub retrieve { sub retrieve {
my $invocant = shift; my $invocant = shift;
my %opts = @_; my %opts = @_;
@ -180,22 +125,11 @@ sub retrieve {
my $self = $sth->fetchrow_hashref; my $self = $sth->fetchrow_hashref;
$self = _conv_points($self) if (($opts{convert} && $opts{convert} == 1) || $opts{profile_id}); $self = _conv_points($self) if (($opts{convert} && $opts{convert} == 1) || $opts{profile_id});
$self = _apply_profile($self) if $opts{profile_id}; $self = _apply_profile($self) if $opts{profile_id};
$self->{'tmpl_stat'} = 1; $self->{'template_stat'} = 1;
bless ($self, $type); bless ($self, $type);
return $self; return $self;
} }
=head2 C4::Labels::Template::delete(template_id => template_id) | $template->delete()
Invoking the delete method attempts to delete the template from the database. The method returns 0 upon success
and 1 upon failure. Errors are logged to the syslog.
examples:
my $exitstat = $template->delete(); # to delete the record behind the $template object
my $exitstat = C4::Labels::Template::delete(template_id => 1); # to delete template record 1
=cut
sub delete { sub delete {
my $self = {}; my $self = {};
my %opts = (); my %opts = ();
@ -218,28 +152,16 @@ sub delete {
my $query = "DELETE FROM labels_templates WHERE template_id = ?"; my $query = "DELETE FROM labels_templates WHERE template_id = ?";
my $sth = C4::Context->dbh->prepare($query); my $sth = C4::Context->dbh->prepare($query);
$sth->execute($query_param); $sth->execute($query_param);
$self->{'tmpl_stat'} = 0; $self->{'template_stat'} = 0;
return 0;
} }
=head2 $template->save()
Invoking the I<save> method attempts to insert the template into the database if the template is new and
update the existing template record if the template exists. The method returns the new record template_id upon
success and -1 upon failure (This avotemplate_ids conflicting with a record template_id of 1). Errors are logged to the syslog.
example:
my $exitstat = $template->save(); # to save the record behind the $template object
=cut
sub save { sub save {
my $self = shift; my $self = shift;
if ($self->{'template_id'}) { # if we have an template_id, the record exists and needs UPDATE if ($self->{'template_id'}) { # if we have an template_id, the record exists and needs UPDATE
my @params; my @params;
my $query = "UPDATE labels_templates SET "; my $query = "UPDATE labels_templates SET ";
foreach my $key (keys %{$self}) { foreach my $key (keys %{$self}) {
next if ($key eq 'template_id') || ($key eq 'tmpl_stat'); next if ($key eq 'template_id') || ($key eq 'template_stat');
push (@params, $self->{$key}); push (@params, $self->{$key});
$query .= "$key=?, "; $query .= "$key=?, ";
} }
@ -252,14 +174,14 @@ sub save {
syslog("LOG_ERR", "Database returned the following error: %s", $sth->errstr); syslog("LOG_ERR", "Database returned the following error: %s", $sth->errstr);
return -1; return -1;
} }
$self->{'tmpl_stat'} = 1; $self->{'template_stat'} = 1;
return $self->{'template_id'}; return $self->{'template_id'};
} }
else { # otherwise create a new record else { # otherwise create a new record
my @params; my @params;
my $query = "INSERT INTO labels_templates ("; my $query = "INSERT INTO labels_templates (";
foreach my $key (keys %{$self}) { foreach my $key (keys %{$self}) {
next if $key eq 'tmpl_stat'; next if $key eq 'template_stat';
push (@params, $self->{$key}); push (@params, $self->{$key});
$query .= "$key, "; $query .= "$key, ";
} }
@ -280,20 +202,11 @@ sub save {
$sth1->execute(); $sth1->execute();
my $template_id = $sth1->fetchrow_array; my $template_id = $sth1->fetchrow_array;
$self->{'template_id'} = $template_id; $self->{'template_id'} = $template_id;
$self->{'tmpl_stat'} = 1; $self->{'template_stat'} = 1;
return $template_id; return $template_id;
} }
} }
=head2 $template->get_attr("attr")
Invoking the I<get_attr> method will return the value of the requested attribute or 1 on errors.
example:
my $value = $template->get_attr("attr");
=cut
sub get_attr { sub get_attr {
my $self = shift; my $self = shift;
if (_check_params(@_) eq 1) { if (_check_params(@_) eq 1) {
@ -308,15 +221,6 @@ sub get_attr {
} }
} }
=head2 $template->set_attr(attr, value)
Invoking the I<set_attr> method will set the value of the supplied attribute to the supplied value.
example:
$template->set_attr(attr => value);
=cut
sub set_attr { sub set_attr {
my $self = shift; my $self = shift;
if (_check_params(@_) eq 1) { if (_check_params(@_) eq 1) {
@ -328,16 +232,6 @@ sub set_attr {
}; };
} }
=head2 $template->get_label_position($start_label)
Invoking the I<get_label_position> method will return the row, column coordinates on the starting page
and the lower left x,y coordinates on the starting label for the template object.
examples:
my ($row_count, $col_count, $llx, $lly) = $template->get_label_position($start_label);
=cut
sub get_label_position { sub get_label_position {
my ($self, $start_label) = @_; my ($self, $start_label) = @_;
my ($row_count, $col_count, $llx, $lly) = 0,0,0,0; my ($row_count, $col_count, $llx, $lly) = 0,0,0,0;
@ -360,8 +254,144 @@ sub get_label_position {
1; 1;
__END__ __END__
=head1 NAME
C4::Labels::Template - A class for creating and manipulating template objects in Koha
=head1 ABSTRACT
This module provides methods for creating, retrieving, and otherwise manipulating label template objects used by Koha to create and export labels.
=head1 METHODS
=head2 new()
Invoking the I<new> method constructs a new template object containing the default values for a template.
The following parameters are optionally accepted as key => value pairs:
C<profile_id> A valid profile id to be assciated with this template. NOTE: The profile must exist in the database and B<not> be assigned to another template.
C<template_code> A template code. ie. 'Avery 5160 | 1 x 2-5/8'
C<template_desc> A readable description of the template. ie. '3 columns, 10 rows of labels'
C<page_width> The width of the page measured in the units supplied by the units parameter in this template.
C<page_height> The height of the page measured in the same units.
C<label_width> The width of a single label on the page this template applies to.
C<label_height> The height of a single label on the page.
C<top_text_margin> The measure of the top margin on a single label on the page.
C<left_text_margin> The measure of the left margin on a single label on the page.
C<top_margin> The measure of the top margin of the page.
C<left_margin> The measure of the left margin of the page.
C<cols> The number of columns of labels on the page.
C<rows> The number of rows of labels on the page.
C<col_gap> The measure of the gap between the columns of labels on the page.
C<row_gap> The measure of the gap between the rows of labels on the page.
C<units> The units of measure used for this template. These B<must> match the measures you supply above or
bad things will happen to your document. NOTE: The only supported units at present are:
=over 9
=item .
POINT = Postscript Points (This is the base unit in the Koha label creator.)
=item .
AGATE = Adobe Agates (5.1428571 points per)
=item .
INCH = US Inches (72 points per)
=item .
MM = SI Millimeters (2.83464567 points per)
=item .
CM = SI Centimeters (28.3464567 points per)
=back
example:
my $template = Template->new(); # Creates and returns a new template object with the defaults
my $template = C4::Labels::Template->new(profile_id => 1, page_width => 8.5, page_height => 11.0, units => 'INCH'); # Creates and returns a new template object using
the supplied values to override the defaults
B<NOTE:> This template is I<not> written to the database untill save() is invoked. You have been warned!
=head2 retrieve(template_id => $template_id)
Invoking the I<retrieve> method constructs a new template object containing the current values for template_id. The method returns
a new object upon success and -1 upon failure. Errors are logged to the syslog. Two further options may be accessed. See the example
below for further description.
examples:
C<my $template = C4::Labels::Template->retrieve(template_id => 1); # Retrieves template record 1 and returns an object containing the record>
C<my $template = C4::Labels::Template->retrieve(template_id => 1, convert => 1); # Retrieves template record 1, converts the units to points,
and returns an object containing the record>
C<my $template = C4::Labels::Template->retrieve(template_id => 1, profile_id => 1); # Retrieves template record 1, converts the units
to points, applies the currently associated profile id, and returns an object containing the record.>
=head2 delete()
Invoking the delete method attempts to delete the template from the database. The method returns -1 upon failure. Errors are logged to the syslog.
NOTE: This method may also be called as a function and passed a key/value pair simply deleteing that template from the database. See the example below.
examples:
C<my $exitstat = $template->delete(); # to delete the record behind the $template object>
C<my $exitstat = C4::Labels::Template::delete(template_id => 1); # to delete template record 1>
=head2 save()
Invoking the I<save> method attempts to insert the template into the database if the template is new and update the existing template record if
the template exists. The method returns the new record template_id upon success and -1 upon failure (This avoids template_ids conflicting with a
record template_id of 1). Errors are logged to the syslog.
example:
C<my $template_id = $template->save(); # to save the record behind the $template object>
=head2 get_attr($attribute)
Invoking the I<get_attr> method will return the value of the requested attribute or -1 on errors.
example:
C<my $value = $template->get_attr($attribute);>
=head2 set_attr(attribute => value, attribute_2 => value)
Invoking the I<set_attr> method will set the value of the supplied attributes to the supplied values. The method accepts key/value pairs separated by
commas.
example:
C<$template->set_attr(attribute => value);>
=head2 get_label_position($start_label)
Invoking the I<get_label_position> method will return the row, column coordinates on the starting page and the lower left x,y coordinates on the starting
label for the template object.
examples:
C<my ($row_count, $col_count, $llx, $lly) = $template->get_label_position($start_label);>
=head1 AUTHOR =head1 AUTHOR
Chris Nighswonger <cnighswonger AT foundations DOT edu> Chris Nighswonger <cnighswonger AT foundations DOT edu>
=head1 COPYRIGHT
Copyright 2009 Foundations Bible College.
=head1 LICENSE
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.
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
=head1 DISCLAIMER OF WARRANTY
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.
=cut =cut

48
labels/label-create-csv.pl
View file

@ -1,20 +1,4 @@
#!/usr/bin/perl #!/usr/bin/perl
# Copyright 2009 Foundations Bible College.
#
# 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 strict;
use warnings; use warnings;
@ -93,3 +77,35 @@ foreach my $item (@$items) {
} }
exit(1); exit(1);
=head1 NAME
labels/label-create-csv.pl - A script for creating a csv export of labels and label batches in Koha
=head1 ABSTRACT
This script provides the means of producing a csv of labels for items either individually, in groups, or in batches from within Koha.
=head1 AUTHOR
Chris Nighswonger <cnighswonger AT foundations DOT edu>
=head1 COPYRIGHT
Copyright 2009 Foundations Bible College.
=head1 LICENSE
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.
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
=head1 DISCLAIMER OF WARRANTY
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.

204
labels/label-create-pdf.pl
View file

@ -1,29 +1,10 @@
#!/usr/bin/perl #!/usr/bin/perl
# Copyright 2006 Katipo Communications.
# Some parts Copyright 2009 Foundations Bible College.
#
# 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 strict;
use warnings; use warnings;
use CGI; use CGI;
use Sys::Syslog qw(syslog); use Sys::Syslog qw(syslog);
use Data::Dumper;
use C4::Debug; use C4::Debug;
use C4::Labels::Batch 1.000000; use C4::Labels::Batch 1.000000;
@ -32,10 +13,6 @@ use C4::Labels::Layout 1.000000;
use C4::Labels::PDF 1.000000; use C4::Labels::PDF 1.000000;
use C4::Labels::Label 1.000000; use C4::Labels::Label 1.000000;
=head
=cut
my $cgi = new CGI; my $cgi = new CGI;
my $batch_id = $cgi->param('batch_id') if $cgi->param('batch_id'); my $batch_id = $cgi->param('batch_id') if $cgi->param('batch_id');
@ -121,78 +98,129 @@ else {
LABEL_ITEMS: LABEL_ITEMS:
foreach my $item (@{$items}) { foreach my $item (@{$items}) {
my ($barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor) = 0,0,0,0; my ($barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor) = 0,0,0,0;
my $label = C4::Labels::Label->new( if ($layout->get_attr('printing_type') eq 'ALT') { # we process the ALT style printing type here because it is not an atomic printing type
batch_id => $batch_id, my $label_a = C4::Labels::Label->new(
item_number => $item->{'item_number'}, batch_id => $batch_id,
width => $template->get_attr('label_width'), item_number => $item->{'item_number'},
height => $template->get_attr('label_height'), llx => $llx,
top_text_margin => $template->get_attr('top_text_margin'), lly => $lly,
left_text_margin => $template->get_attr('left_text_margin'), width => $template->get_attr('label_width'),
barcode_type => $layout->get_attr('barcode_type'), height => $template->get_attr('label_height'),
printing_type => $layout->get_attr('printing_type'), top_text_margin => $template->get_attr('top_text_margin'),
guidebox => $layout->get_attr('guidebox'), left_text_margin => $template->get_attr('left_text_margin'),
font => $layout->get_attr('font'), barcode_type => $layout->get_attr('barcode_type'),
font_size => $layout->get_attr('font_size'), printing_type => 'BIB',
callnum_split => $layout->get_attr('callnum_split'), guidebox => $layout->get_attr('guidebox'),
justify => $layout->get_attr('text_justify'), font => $layout->get_attr('font'),
format_string => $layout->get_attr('format_string'), font_size => $layout->get_attr('font_size'),
text_wrap_cols => $layout->get_text_wrap_cols(label_width => $template->get_attr('label_width'), left_text_margin => $template->get_attr('left_text_margin')), callnum_split => $layout->get_attr('callnum_split'),
); justify => $layout->get_attr('text_justify'),
my $label_type = $label->get_label_type; format_string => $layout->get_attr('format_string'),
if ($label_type eq 'BIB') { text_wrap_cols => $layout->get_text_wrap_cols(label_width => $template->get_attr('label_width'), left_text_margin => $template->get_attr('left_text_margin')),
my $line_spacer = ($label->get_attr('font_size') * 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 $text_lly = ($lly + ($template->get_attr('label_height') - $template->get_attr('top_text_margin'))); my $label_a_text = $label_a->create_label();
my $label_text = $label->draw_label_text( _print_text($label_a_text);
llx => $llx, ($row_count, $col_count, $llx, $lly) = _calc_next_label_pos($row_count, $col_count, $llx, $lly);
lly => $text_lly, my $label_b = C4::Labels::Label->new(
line_spacer => $line_spacer, batch_id => $batch_id,
); item_number => $item->{'item_number'},
_print_text($label_text); llx => $llx,
lly => $lly,
width => $template->get_attr('label_width'),
height => $template->get_attr('label_height'),
top_text_margin => $template->get_attr('top_text_margin'),
left_text_margin => $template->get_attr('left_text_margin'),
barcode_type => $layout->get_attr('barcode_type'),
printing_type => 'BAR',
guidebox => $layout->get_attr('guidebox'),
font => $layout->get_attr('font'),
font_size => $layout->get_attr('font_size'),
callnum_split => $layout->get_attr('callnum_split'),
justify => $layout->get_attr('text_justify'),
format_string => $layout->get_attr('format_string'),
text_wrap_cols => $layout->get_text_wrap_cols(label_width => $template->get_attr('label_width'), left_text_margin => $template->get_attr('left_text_margin')),
);
my $label_b_text = $label_b->create_label();
($row_count, $col_count, $llx, $lly) = _calc_next_label_pos($row_count, $col_count, $llx, $lly); ($row_count, $col_count, $llx, $lly) = _calc_next_label_pos($row_count, $col_count, $llx, $lly);
next LABEL_ITEMS; next LABEL_ITEMS;
} }
elsif ($label_type eq 'BARBIB') {
$barcode_llx = $llx + $template->get_attr('left_text_margin'); # this places the bottom left of the barcode the left text margin distance to right of the the left edge of the label ($llx)
$barcode_lly = ($lly + $template->get_attr('label_height')) - $template->get_attr('top_text_margin'); # this places the bottom left of the barcode the top text margin distance below the top of the label ($lly)
$barcode_width = 0.8 * $template->get_attr('label_width'); # this scales the barcode width to 80% of the label width
$barcode_y_scale_factor = 0.01 * $template->get_attr('label_height'); # this scales the barcode height to 10% of the label height
my $line_spacer = ($label->get_attr('font_size') * 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 $text_lly = ($lly + ($template->get_attr('label_height') - $template->get_attr('top_text_margin')));
my $label_text = $label->draw_label_text(
llx => $llx,
lly => $text_lly,
line_spacer => $line_spacer,
);
_print_text($label_text);
}
else { else {
$barcode_llx = $llx + $template->get_attr('left_text_margin'); # this places the bottom left of the barcode the left text margin distance to right of the the left edge of the label ($llx)
$barcode_lly = $lly + $template->get_attr('top_text_margin'); # this places the bottom left of the barcode the top text margin distance above the bottom of the label ($lly)
$barcode_width = 0.8 * $template->get_attr('label_width'); # this scales the barcode width to 80% of the label width
$barcode_y_scale_factor = 0.01 * $template->get_attr('label_height'); # this scales the barcode height to 10% of the label height
if ($label_type eq 'BIBBAR' || $label_type eq 'ALT') {
my $line_spacer = ($label->get_attr('font_size') * 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 $text_lly = ($lly + ($template->get_attr('label_height') - $template->get_attr('top_text_margin')));
my $label_text = $label->draw_label_text(
llx => $llx,
lly => $text_lly,
line_spacer => $line_spacer,
);
_print_text($label_text);
}
if ($label_type eq 'ALT') {
($row_count, $col_count, $llx, $lly) = _calc_next_label_pos($row_count, $col_count, $llx, $lly);
}
} }
$label->barcode( my $label = C4::Labels::Label->new(
llx => $barcode_llx, batch_id => $batch_id,
lly => $barcode_lly, item_number => $item->{'item_number'},
width => $barcode_width, llx => $llx,
y_scale_factor => $barcode_y_scale_factor, lly => $lly,
); width => $template->get_attr('label_width'),
($row_count, $col_count, $llx, $lly) = _calc_next_label_pos($row_count, $col_count, $llx, $lly); height => $template->get_attr('label_height'),
top_text_margin => $template->get_attr('top_text_margin'),
left_text_margin => $template->get_attr('left_text_margin'),
barcode_type => $layout->get_attr('barcode_type'),
printing_type => $layout->get_attr('printing_type'),
guidebox => $layout->get_attr('guidebox'),
font => $layout->get_attr('font'),
font_size => $layout->get_attr('font_size'),
callnum_split => $layout->get_attr('callnum_split'),
justify => $layout->get_attr('text_justify'),
format_string => $layout->get_attr('format_string'),
text_wrap_cols => $layout->get_text_wrap_cols(label_width => $template->get_attr('label_width'), left_text_margin => $template->get_attr('left_text_margin')),
);
my $label_text = $label->create_label();
_print_text($label_text) if $label_text;
($row_count, $col_count, $llx, $lly) = _calc_next_label_pos($row_count, $col_count, $llx, $lly);
next LABEL_ITEMS;
} }
$pdf->End(); $pdf->End();
exit(1); exit(1);
=head1 NAME
labels/label-create-pdf.pl - A script for creating a pdf export of labels and label batches in Koha
=head1 ABSTRACT
This script provides the means of producing a pdf of labels for items either individually, in groups, or in batches from within Koha.
=head1 USAGE
This script is intended to be called as a cgi script although it could be easily modified to accept command line parameters. The script accepts four single
parameters and two "multiple" parameters as follows:
C<batch_id> A single valid batch id to export.
C<template_id> A single valid template id to be applied to the current export. This parameter is manditory.
C<layout_id> A single valid layout id to be applied to the current export. This parameter is manditory.
C<start_label> The number of the label on which to begin the export. This parameter is optional.
C<lable_ids> A single valid label id to export. Multiple label ids may be submitted to export multiple labels.
C<item_numbers> A single valid item number to export. Multiple item numbers may be submitted to export multiple items.
B<NOTE:> One of the C<batch_id>, C<label_ids>, or C<item_number> parameters is manditory. However, do not pass a combination of them or bad things might result.
example:
http://staff-client.kohadev.org/cgi-bin/koha/labels/label-create-pdf.pl?batch_id=1&template_id=1&layout_id=5&start_label=1
=head1 AUTHOR
Chris Nighswonger <cnighswonger AT foundations DOT edu>
=head1 COPYRIGHT
Copyright 2009 Foundations Bible College.
=head1 LICENSE
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.
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
=head1 DISCLAIMER OF WARRANTY
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.
=cut

49
labels/label-create-xml.pl
View file

@ -1,20 +1,4 @@
#!/usr/bin/perl #!/usr/bin/perl
# Copyright 2009 Foundations Bible College.
#
# 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 strict;
use warnings; use warnings;
@ -105,3 +89,36 @@ my $xml_out = $xml->XMLout($xml_data);
print $xml_out; print $xml_out;
exit(1); exit(1);
=head1 NAME
labels/label-create-xml.pl - A script for creating a xml export of labels and label batches in Koha
=head1 ABSTRACT
This script provides the means of producing a xml of labels for items either individually, in groups, or in batches from within Koha. This particular script is provided more as
a demonstration of the multitude of formats Koha labels could be exported in based on the current Label Creator API.
=head1 AUTHOR
Chris Nighswonger <cnighswonger AT foundations DOT edu>
=head1 COPYRIGHT
Copyright 2009 Foundations Bible College.
=head1 LICENSE
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.
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
=head1 DISCLAIMER OF WARRANTY
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.

82
t/db_dependent/Labels/t_Batch.t Normal file
View file

@ -0,0 +1,82 @@
#!/usr/bin/perl
#
# Copyright 2007 Foundations Bible College.
#
# 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 warnings;
use Test::More tests => 22;
use C4::Context;
use Data::Dumper;
BEGIN {
use_ok('C4::Labels::Batch');
}
my $sth = C4::Context->dbh->prepare('SELECT branchcode FROM branches b LIMIT 0,1');
$sth->execute();
my $branch_code = $sth->fetchrow_hashref()->{'branchcode'};
syslog("LOG_ERR", "t/db_dependent/Labels/t_Batch.t : Database returned the following error: %s", $sth->errstr) if $sth->errstr;
my $expected_batch = {
items => [],
branch_code => $branch_code,
batch_stat => 0, # False if any data has changed and the db has not been updated
};
my $batch = 0;
my $item_number = 0;
diag "Testing Batch->new() method.";
ok($batch = C4::Labels::Batch->new(branch_code => $branch_code)) || diag "Batch->new() FAILED. Check syslog for details.";
my $batch_id = $batch->get_attr('batch_id');
$expected_batch->{'batch_id'} = $batch_id;
is_deeply($batch, $expected_batch) || diag "New batch object FAILED to verify.";
diag "Testing Batch->get_attr() method.";
foreach my $key (keys %{$expected_batch}) {
if (ref($expected_batch->{$key}) eq 'ARRAY') {
ok(ref($expected_batch->{$key}) eq ref($batch->get_attr($key))) || diag "Batch->get_attr() FAILED on attribute $key.";
}
else {
ok($expected_batch->{$key} eq $batch->get_attr($key)) || diag "Batch->get_attr() FAILED on attribute $key.";
}
}
diag "Testing Batch->add_item() method.";
my $sth1 = C4::Context->dbh->prepare('SELECT itemnumber FROM items LIMIT 0,10');
$sth1->execute();
while (my $row = $sth1->fetchrow_hashref()) {
syslog("LOG_ERR", "t/db_dependent/Labels/t_Batch.t : Database returned the following error: %s", $sth1->errstr) if $sth1->errstr;
ok($batch->add_item($row->{'itemnumber'}) eq 0 ) || diag "Batch->add_item() FAILED. Check syslog for details.";
$item_number = $row->{'itemnumber'};
}
diag "Testing Batch->retrieve() method.";
ok(my $saved_batch = C4::Labels::Batch->retrieve(batch_id => $batch_id)) || diag "Batch->retrieve() FAILED. Check syslog for details.";
is_deeply($saved_batch, $batch) || diag "Retrieved batch object FAILED to verify.";
diag "Testing Batch->remove_item() method.";
ok($batch->remove_item($item_number) eq 0) || diag "Batch->remove_item() FAILED. See syslog for details.";
my $updated_batch = C4::Labels::Batch->retrieve(batch_id => $batch_id);
is_deeply($updated_batch, $batch) || diag "Updated batch object FAILED to verify.";
diag "Testing Batch->delete() method.";
my $del_results = $batch->delete();
ok($del_results eq 0) || diag "Batch->delete() FAILED. See syslog for details.";

100
t/db_dependent/Labels/t_Layout.t Normal file
View file

@ -0,0 +1,100 @@
#!/usr/bin/perl
#
# Copyright 2007 Foundations Bible College.
#
# 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 warnings;
use Test::More tests => 28;
use C4::Context;
use Data::Dumper;
BEGIN {
use_ok('C4::Labels::Layout');
}
my $default_layout = {
barcode_type => 'CODE39',
printing_type => 'BAR',
layout_name => 'TEST',
guidebox => 0,
font => 'TR',
font_size => 3,
callnum_split => 0,
text_justify => 'L',
format_string => 'title, author, isbn, issn, itemtype, barcode, callnumber',
};
my $layout;
diag "Testing Layout->new() method.";
ok($layout = C4::Labels::Layout->new(layout_name => 'TEST')) || diag "Layout->new() FAILED. Check syslog for details.";
is_deeply($layout, $default_layout) || diag "New layout object FAILED to verify.";
diag "Testing Layout->get_attr() method.";
foreach my $key (keys %{$default_layout}) {
ok($default_layout->{$key} eq $layout->get_attr($key)) || diag "Layout->get_attr() FAILED on attribute $key.";
}
diag "Testing Layout->set_attr() method.";
my $new_attr = {
barcode_type => 'CODE39',
printing_type => 'BIBBAR',
layout_name => 'TEST',
guidebox => 1,
font => 'TR',
font_size => 10,
callnum_split => 1,
text_justify => 'L',
format_string => 'callnumber, title, author, barcode',
};
foreach my $key (keys %{$new_attr}) {
$layout->set_attr($key => $new_attr->{$key});
ok($new_attr->{$key} eq $layout->get_attr($key)) || diag "Layout->set_attr() FAILED on attribute $key.";
}
diag "Testing Layout->save() method with a new object.";
my $sav_results = $layout->save();
ok($sav_results ne -1) || diag "Layout->save() FAILED. See syslog for details.";
my $saved_layout;
if ($sav_results ne -1) {
diag "Testing Layout->retrieve() method.";
$new_attr->{'layout_id'} = $sav_results;
ok($saved_layout = C4::Labels::Layout->retrieve(layout_id => $sav_results)) || diag "Layout->retrieve() FAILED. Check syslog for details.";
is_deeply($saved_layout, $new_attr) || diag "Retrieved layout object FAILED to verify.";
}
diag "Testing Layout->save() method with an updated object.";
$saved_layout->set_attr(font => 'C');
my $upd_results = $saved_layout->save();
ok($upd_results ne -1) || diag "Layout->save() FAILED. See syslog for details.";
my $updated_layout = C4::Labels::Layout->retrieve(layout_id => $sav_results);
is_deeply($updated_layout, $saved_layout) || diag "Updated layout object FAILED to verify.";
diag "Testing Layout->get_text_wrap_cols() method.";
ok($updated_layout->get_text_wrap_cols(label_width => 180, left_text_margin => 18) eq 21) || diag "Layout->get_text_wrap_cols() FAILED.";
diag "Testing Layout->delete() method.";
my $del_results = $updated_layout->delete();
ok($del_results eq 0) || diag "Layout->delete() FAILED. See syslog for details.";

95
t/db_dependent/Labels/t_Profile.t Normal file
View file

@ -0,0 +1,95 @@
#!/usr/bin/perl
#
# Copyright 2007 Foundations Bible College.
#
# 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 warnings;
use Test::More tests => 25;
use C4::Context;
use Data::Dumper;
BEGIN {
use_ok('C4::Labels::Profile');
}
my $expected_profile = {
printer_name => 'Circulation Desk',
template_id => '',
paper_bin => 'bypass',
offset_horz => 0,
offset_vert => 0,
creep_horz => 0,
creep_vert => 0,
units => 'POINT',
};
my $err = 0;
diag "Testing Profile->new() method.";
ok(my $profile = C4::Labels::Profile->new(printer_name => 'Circulation Desk',paper_bin => 'bypass')) || diag"Profile->new() FAILED. Check syslog for details.";
is_deeply($profile, $expected_profile) || diag "New profile object FAILED to verify.";
diag "Testing Profile->get_attr() method.";
foreach my $key (keys %{$expected_profile}) {
ok($expected_profile->{$key} eq $profile->get_attr($key)) || diag "Profile->get_attr() FAILED on attribute $key. Check syslog for details.";
}
diag "Testing Profile->set_attr() method.";
my $new_attr = {
printer_name => 'Cataloging Desk',
template_id => '1',
paper_bin => 'tray 1',
offset_horz => 0.3,
offset_vert => 0.85,
creep_horz => 0.156,
creep_vert => 0.67,
units => 'INCH',
};
foreach my $key (keys %{$new_attr}) {
$err = $profile->set_attr($key, $new_attr->{$key});
ok(($new_attr->{$key} eq $profile->get_attr($key)) && ($err lt 1)) || diag "Profile->set_attr() FAILED on attribute $key.";
}
diag "Testing Profile->save() method with a new object.";
my $sav_results = $profile->save();
ok($sav_results ne -1) || diag "Profile->save() FAILED. See syslog for details.";
my $saved_profile;
if ($sav_results ne -1) {
diag "Testing Profile->retrieve() method.";
$new_attr->{'profile_id'} = $sav_results;
ok($saved_profile = C4::Labels::Profile->retrieve(profile_id => $sav_results)) || diag "Profile->retrieve() FAILED. Check syslog for details.";
is_deeply($saved_profile, $new_attr) || diag "Retrieved profile object FAILED to verify.";
}
diag "Testing Profile->save() method with an updated object.";
$err = 0; # Reset error code
$err = $saved_profile->set_attr(units => 'CM');
my $upd_results = $saved_profile->save();
ok(($upd_results ne -1) && ($err lt 1)) || diag "Profile->save() FAILED. See syslog for details.";
my $updated_profile = C4::Labels::Profile->retrieve(profile_id => $sav_results);
is_deeply($updated_profile, $saved_profile) || diag "Updated layout object FAILED to verify.";
diag "Testing Profile->delete() method.";
my $del_results = $updated_profile->delete();
ok($del_results eq 0) || diag "Profile->delete() FAILED. See syslog for details.";

133
t/db_dependent/Labels/t_Template.t Normal file
View file

@ -0,0 +1,133 @@
#!/usr/bin/perl
#
# Copyright 2007 Foundations Bible College.
#
# 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 warnings;
use Test::More tests => 52;
use C4::Context;
use Data::Dumper;
BEGIN {
use_ok('C4::Labels::Template');
}
my $expect_template = {
profile_id => 0,
template_code => 'DEFAULT TEMPLATE',
template_desc => 'Default description',
page_width => 8.5,
page_height => 0,
label_width => 0,
label_height => 0,
top_text_margin => 0,
left_text_margin => 0,
top_margin => 0,
left_margin => 0,
cols => 3,
rows => 0,
col_gap => 0,
row_gap => 0,
units => 'POINT',
template_stat => 0,
};
my $template;
diag "Testing Template->new() method.";
ok($template = C4::Labels::Template->new(page_width => 8.5,cols => 3)) || diag "Template->new() FAILED. Check syslog for details.";
is_deeply($template, $expect_template) || diag "New template object FAILED to verify.";
diag "Testing Template->get_attr() method.";
foreach my $key (keys %{$expect_template}) {
ok($expect_template->{$key} eq $template->get_attr($key)) || diag "Template->get_attr() FAILED on attribute $key.";
}
diag "Testing Template->set_attr() method.";
my $new_attr = {
profile_id => 0,
template_code => 'Avery 5160 | 1 x 2-5/8',
template_desc => '3 columns, 10 rows of labels',
page_width => 8.5,
page_height => 11,
label_width => 2.63,
label_height => 1,
top_text_margin => 0.139,
left_text_margin => 0.0417,
top_margin => 0.35,
left_margin => 0.23,
cols => 3,
rows => 10,
col_gap => 0.13,
row_gap => 0,
units => 'INCH',
template_stat => 1,
};
foreach my $key (keys %{$new_attr}) {
next if ($key eq 'template_stat');
$template->set_attr($key, $new_attr->{$key});
ok($new_attr->{$key} eq $template->get_attr($key)) || diag "Template->set_attr() FAILED on attribute $key.";
}
diag "Testing Template->save() method with a new object.";
my $sav_results = $template->save();
ok($sav_results ne -1) || diag "Template->save() FAILED. See syslog for details.";
my $saved_template;
if ($sav_results ne -1) {
diag "Testing Template->retrieve() method.";
$new_attr->{'template_id'} = $sav_results;
ok($saved_template = C4::Labels::Template->retrieve(template_id => $sav_results)) || diag "Template->retrieve() FAILED. Check syslog for details.";
is_deeply($saved_template, $new_attr) || diag "Retrieved template object FAILED to verify.";
}
diag "Testing Template->save method with an updated object.";
$saved_template->set_attr(template_desc => 'A test template');
my $upd_results = $saved_template->save();
ok($upd_results ne -1) || diag "Template->save() FAILED. See syslog for details.";
my $updated_template = C4::Labels::Template->retrieve(template_id => $sav_results);
is_deeply($updated_template, $saved_template) || diag "Updated template object FAILED to verify.";
diag "Testing Template->retrieve() convert points option.";
my $conv_template = C4::Labels::Template->retrieve(template_id => $sav_results, convert => 1);
my $expect_conv = {
page_width => 612,
page_height => 792,
label_width => 189.36,
label_height => 72,
top_text_margin => 10.008,
left_text_margin => 3.0024,
top_margin => 25.2,
left_margin => 16.56,
col_gap => 9.36,
row_gap => 0,
};
foreach my $key (keys %{$expect_conv}) {
ok($expect_conv->{$key} eq $conv_template->get_attr($key)) || diag "Template->retrieve() convert points option FAILED. Expected " . $expect_conv->{$key} . " but got " . $conv_template->get_attr($key) . ".";
}
diag "Testing Template->delete() method.";
my $del_results = $updated_template->delete();
ok($del_results ne -1) || diag "Template->delete() FAILED. See syslog for details.";

99
t/db_dependent/t_Layout.t
View file

@ -1,99 +0,0 @@
#!/usr/bin/perl
#
# Copyright 2007 Foundations Bible College.
#
# 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 warnings;
use Test::More tests => 28;
use C4::Context;
use Data::Dumper;
BEGIN {
use_ok('C4::Labels::Layout');
}
my $default_layout = {
barcode_type => '',
start_label => 2,
printing_type => '',
layout_name => 'TEST',
guidebox => 0,
font_type => '',
ccode => '',
callnum_split => 0,
text_justify => '',
format_string => '',
};
my $layout;
diag "Testing new layout object creation.";
ok($layout = C4::Labels::Layout->new(start_label => 2,layout_name => 'TEST'), "Object created");
is_deeply($layout, $default_layout, "Object verified");
diag "Testing get_attr method.";
foreach my $key (keys %{$default_layout}) {
ok($default_layout->{$key} eq $layout->get_attr($key), "Got $key attribute.");
}
diag "Testing set_attr method.";
my $new_attr = {
barcode_type => 'CODE39',
start_label => 1,
printing_type => 'BIBBAR',
layout_name => 'TEST',
guidebox => 1,
font_type => 'TR',
ccode => 'BOOK',
callnum_split => 1,
text_justify => 'L',
format_string => 'callnumber, title, author, barcode',
};
foreach my $key (keys %{$new_attr}) {
$layout->set_attr($key, $new_attr->{$key});
ok($new_attr->{$key} eq $layout->get_attr($key), "$key attribute is now set to " . $new_attr->{$key});
}
diag "Testing save method by saving a new record.";
my $sav_results = $layout->save();
ok($sav_results ne -1, "Record number $sav_results saved.") || diag "Error encountered during save. See syslog for details.";
my $saved_layout;
if ($sav_results ne -1) {
diag "Testing get method.";
$new_attr->{'layout_id'} = $sav_results;
diag "\$sav_results = $sav_results";
$saved_layout = C4::Labels::Layout->retrieve(layout_id => $sav_results);
is_deeply($saved_layout, $new_attr, "Get method verified.");
}
diag "Testing save method by updating a record.";
$saved_layout->set_attr("start_label",5);
my $upd_results = $saved_layout->save();
ok($upd_results ne -1, "Record number $upd_results updated.") || diag "Error encountered during update. See syslog for details.";
my $updated_layout = C4::Labels::Layout->retrieve(layout_id => $sav_results);
is_deeply($updated_layout, $saved_layout, "Update verified.");
diag "Testing delete method.";
my $del_results = $updated_layout->delete();
ok($del_results eq 0, "Layout deleted.") || diag "Incorrect or non-existent record id. See syslog for details.";

112
t/db_dependent/t_Profile.t
View file

@ -1,112 +0,0 @@
#!/usr/bin/perl
#
# Copyright 2007 Foundations Bible College.
#
# 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 warnings;
use Test::More tests => 28;
use C4::Context;
use Data::Dumper;
BEGIN {
use_ok('C4::Labels::Profile');
}
my $default_profile = {
printer_name => 'Circulation Desk',
tmpl_id => '',
paper_bin => 'bypass',
offset_horz => 0,
offset_vert => 0,
creep_horz => 0,
creep_vert => 0,
unit => 'POINT',
};
my $err = 0;
diag "Testing new template object creation.";
ok(my $profile = C4::Labels::Profile->new(printer_name => 'Circulation Desk',paper_bin => 'bypass'), "Object created");
is_deeply($profile, $default_profile, "Object verified");
diag "Testing get_attr method.";
foreach my $key (keys %{$default_profile}) {
ok($default_profile->{$key} eq $profile->get_attr($key), "Got $key attribute.");
}
diag "Testing set_attr method.";
my $new_attr = {
printer_name => 'Cataloging Desk',
tmpl_id => '1',
paper_bin => 'tray 1',
offset_horz => 0.3,
offset_vert => 0.85,
creep_horz => 0.156,
creep_vert => 0.67,
unit => 'INCH',
};
foreach my $key (keys %{$new_attr}) {
$err = $profile->set_attr($key, $new_attr->{$key});
ok(($new_attr->{$key} eq $profile->get_attr($key)) && ($err lt 1), "$key attribute is now set to " . $new_attr->{$key});
}
diag "Testing save method by saving a new record.";
my $sav_results = $profile->save();
ok($sav_results ne -1, "Record number $sav_results saved.") || diag "Error encountered during save. See syslog for details.";
my $saved_profile;
if ($sav_results ne -1) {
diag "Testing get method.";
$new_attr->{'prof_id'} = $sav_results;
$saved_profile = C4::Labels::Profile->retrieve($sav_results);
is_deeply($saved_profile, $new_attr, "Get method verified.");
}
diag "Testing conv_points method.";
$saved_profile->conv_points();
my $expect_conv = {
offset_horz => 21.6,
offset_vert => 61.2,
creep_horz => 11.232,
creep_vert => 48.24,
};
foreach my $key (keys %{$expect_conv}) {
ok($expect_conv->{$key} eq $saved_profile->get_attr($key), "$key converted correctly.") || diag "Expected " . $expect_conv->{$key} . " but got " . $saved_profile->get_attr($key) . ".";
}
diag "Testing save method by updating a record.";
$err = 0; # Reset error code
$err = $saved_profile->set_attr(unit => 'CM');
my $upd_results = $saved_profile->save();
ok(($upd_results ne -1) && ($err lt 1), "Record number $upd_results updated.") || diag "Error encountered during update. See syslog for details.";
my $updated_profile = C4::Labels::Profile->retrieve($sav_results);
is_deeply($updated_profile, $saved_profile, "Update verified.");
#diag "Testing conv_points method.";
diag "Testing delete method.";
my $del_results = $updated_profile->delete();
ok($del_results eq 0, "Profile deleted.") || diag "Incorrect or non-existent record id. See syslog for details.";

138
t/db_dependent/t_Template.t
View file

@ -1,138 +0,0 @@
#!/usr/bin/perl
#
# Copyright 2007 Foundations Bible College.
#
# 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 warnings;
use Test::More tests => 54;
use C4::Context;
use Data::Dumper;
BEGIN {
use_ok('C4::Labels::Template');
}
my $expect_template = {
tmpl_code => '',
tmpl_desc => '',
page_width => 8.5,
page_height => 0,
label_width => 0,
label_height => 0,
top_text_margin => 0,
left_text_margin => 0,
top_margin => 0,
left_margin => 0,
cols => 3,
rows => 0,
col_gap => 0,
row_gap => 0,
units => 'POINT',
font_size => 3,
font => 'TR',
tmpl_stat => 0,
};
my $template;
diag "Testing new template object creation.";
ok($template = C4::Labels::Template->new(page_width => 8.5,cols => 3), "Object created");
is_deeply($template, $expect_template, "Object verified");
diag "Testing get_attr method.";
foreach my $key (keys %{$expect_template}) {
ok($expect_template->{$key} eq $template->get_attr($key), "Got $key attribute.");
}
diag "Testing set_attr method.";
my $new_attr = {
tmpl_code => 'Avery 5160 | 1 x 2-5/8',
tmpl_desc => '3 columns, 10 rows of labels',
page_width => 8.5,
page_height => 11,
label_width => 2.63,
label_height => 1,
top_text_margin => 0.139,
left_text_margin => 0.0417,
top_margin => 0.35,
left_margin => 0.23,
cols => 3,
rows => 10,
col_gap => 0.13,
row_gap => 0,
units => 'INCH',
font_size => 7,
font => 'C',
tmpl_stat => 1,
};
foreach my $key (keys %{$new_attr}) {
next if ($key eq 'tmpl_stat');
$template->set_attr($key, $new_attr->{$key});
ok($new_attr->{$key} eq $template->get_attr($key), "$key attribute is now set to " . $new_attr->{$key});
}
diag "Testing save method by saving a new record.";
my $sav_results = $template->save();
ok($sav_results ne -1, "Record number $sav_results saved.") || diag "Error encountered during save. See syslog for details.";
my $saved_template;
if ($sav_results ne -1) {
diag "Testing retrieve method.";
$new_attr->{'tmpl_id'} = $sav_results;
$saved_template = C4::Labels::Template->retrieve(template_id => $sav_results);
is_deeply($saved_template, $new_attr, "Retrieve method verified.");
}
diag "Testing save method by updating a record.";
$saved_template->set_attr(start_label => 5);
my $upd_results = $saved_template->save();
ok($upd_results ne -1, "Record number $upd_results updated.") || diag "Error encountered during update. See syslog for details.";
my $updated_template = C4::Labels::Template->retrieve(template_id => $sav_results);
is_deeply($updated_template, $saved_template, "Update verified.");
diag "Testing conv_points method.";
my $conv_template = C4::Labels::Template->retrieve(template_id => $sav_results, convert => 1);
my $expect_conv = {
page_width => 612,
page_height => 792,
label_width => 189.36,
label_height => 72,
top_text_margin => 10.008,
left_text_margin => 3.0024,
top_margin => 25.2,
left_margin => 16.56,
col_gap => 9.36,
row_gap => 0,
};
foreach my $key (keys %{$expect_conv}) {
ok($expect_conv->{$key} eq $conv_template->get_attr($key), "$key converted correctly.") || diag "Expected " . $expect_conv->{$key} . " but got " . $conv_template->get_attr($key) . ".";
}
diag "Testing get_text_wrap_cols method.";
ok ($conv_template->get_text_wrap_cols eq 43, "Get_text_wrap_cols verified.");
diag "Testing delete method.";
my $del_results = $updated_template->delete();
ok($del_results eq 0, "Template deleted.") || diag "Incorrect or non-existent record id. See syslog for details.";