[6/30] C4::Creators module

Here we consolidate all code common to both Label and Patron Card Creators.
This commit is contained in:
Chris Nighswonger 2010-01-11 11:00:25 -05:00
parent 4a675bcaad
commit ff9b43e386
6 changed files with 2447 additions and 0 deletions

316
C4/Creators/Batch.pm Normal file
View File

@ -0,0 +1,316 @@
package C4::Creators::Batch;
use strict;
use warnings;
use autouse 'Data::Dumper' => qw(Dumper);
use C4::Context;
use C4::Debug;
BEGIN {
use version; our $VERSION = qv('1.0.0_1');
}
sub _check_params {
my $given_params = {};
my $exit_code = 0;
my @valid_template_params = (
'label_id',
'batch_id',
'item_number',
'card_number',
'branch_code',
'creator',
);
if (scalar(@_) >1) {
$given_params = {@_};
foreach my $key (keys %{$given_params}) {
if (!(grep m/$key/, @valid_template_params)) {
warn sprintf('Unrecognized parameter type of "%s".', $key);
$exit_code = 1;
}
}
}
else {
if (!(grep m/$_/, @valid_template_params)) {
warn sprintf('Unrecognized parameter type of %s', $_);
$exit_code = 1;
}
}
return $exit_code;
}
sub new {
my ($invocant) = shift;
my $type = ref($invocant) || $invocant;
my $self = {
batch_id => 0,
items => [],
branch_code => 'NB',
batch_stat => 0, # False if any data has changed and the db has not been updated
@_,
};
my $sth = C4::Context->dbh->prepare("SELECT MAX(batch_id) FROM creator_batches;");
$sth->execute();
my $batch_id = $sth->fetchrow_array;
$self->{'batch_id'} = ++$batch_id unless $self->{'batch_id'} != 0; # this allows batch_id to be passed in for individual label printing
bless ($self, $type);
return $self;
}
sub add_item {
my $self = shift;
my $number = shift;
ref($self) =~ m/C4::(.+)::.+$/;
my $number_type = ($1 eq 'Patroncards' ? 'borrower_number' : 'item_number');
my $query = "INSERT INTO creator_batches (batch_id, $number_type, branch_code, creator) VALUES (?,?,?,?);";
my $sth = C4::Context->dbh->prepare($query);
# $sth->{'TraceLevel'} = 3;
$sth->execute($self->{'batch_id'}, $number, $self->{'branch_code'}, $1);
if ($sth->err) {
warn sprintf('Database returned the following error on attempted INSERT: %s', $sth->errstr);
return -1;
}
$query = "SELECT max(label_id) FROM creator_batches WHERE batch_id=? AND $number_type=? AND branch_code=?;";
my $sth1 = C4::Context->dbh->prepare($query);
$sth1->execute($self->{'batch_id'}, $number, $self->{'branch_code'});
my $label_id = $sth1->fetchrow_array;
push (@{$self->{'items'}}, {$number_type => $number, label_id => $label_id});
$self->{'batch_stat'} = 1;
return 0;
}
sub get_attr {
my $self = shift;
return $self->{$_[0]};
}
sub remove_item {
my $self = shift;
my $label_id = shift;
my $query = "DELETE FROM creator_batches WHERE label_id=? AND batch_id=?;";
my $sth = C4::Context->dbh->prepare($query);
# $sth->{'TraceLevel'} = 3;
$sth->execute($label_id, $self->{'batch_id'});
if ($sth->err) {
warn sprintf('Database returned the following error on attempted DELETE: %s', $sth->errstr);
return -1;
}
@{$self->{'items'}} = grep{$_->{'label_id'} != $label_id} @{$self->{'items'}};
$self->{'batch_stat'} = 1;
return 0;
}
# 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.
# I'm leaving it here because it should be here and for consistency's sake and once memcached support is fully implimented this should be as well. -cnighswonger
#
#=head2 $batch->save()
#
# Invoking the I<save> method attempts to insert the batch into the database. The method returns
# 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 Apache log.
#
# example:
# my $exitstat = $batch->save(); # to save the record behind the $batch object
#
#=cut
#
#sub save {
# my $self = shift;
# foreach my $item_number (@{$self->{'items'}}) {
# my $query = "INSERT INTO creator_batches (batch_id, item_number, branch_code) VALUES (?,?,?);";
# my $sth1 = C4::Context->dbh->prepare($query);
# $sth1->execute($self->{'batch_id'}, $item_number->{'item_number'}, $self->{'branch_code'});
# if ($sth1->err) {
# warn sprintf('Database returned the following error on attempted INSERT: %s', $sth1->errstr);
# return -1;
# }
# $self->{'batch_stat'} = 1;
# return $self->{'batch_id'};
# }
#}
sub retrieve {
my $invocant = shift;
my %opts = @_;
my $type = ref($invocant) || $invocant;
$type =~ m/C4::(.+)::.+$/;
my $number_type = ($1 eq 'Patroncards' ? 'borrower_number' : 'item_number');
my $record_flag = 0;
my $query = "SELECT * FROM creator_batches WHERE batch_id = ? ORDER BY label_id";
my $sth = C4::Context->dbh->prepare($query);
# $sth->{'TraceLevel'} = 3;
$sth->execute($opts{'batch_id'});
my $self = {
batch_id => $opts{'batch_id'},
items => [],
};
while (my $record = $sth->fetchrow_hashref) {
$self->{'branch_code'} = $record->{'branch_code'};
push (@{$self->{'items'}}, {$number_type => $record->{$number_type}, label_id => $record->{'label_id'}});
$record_flag = 1; # true if one or more rows were retrieved
}
return -2 if $record_flag == 0; # a hackish sort of way of indicating no such record exists
if ($sth->err) {
warn sprintf('Database returned the following error on attempted SELECT: %s', $sth->errstr);
return -1;
}
$self->{'batch_stat'} = 1;
bless ($self, $type);
return $self;
}
sub delete {
my $self = {};
my %opts = ();
my $call_type = '';
my @query_params = ();
if (ref($_[0])) {
$self = shift; # check to see if this is a method call
$call_type = 'C4::Labels::Batch->delete'; # seems hackish
@query_params = ($self->{'batch_id'}, $self->{'branch_code'});
}
else {
shift @_;
%opts = @_;
$call_type = 'C4::Labels::Batch::delete';
@query_params = ($opts{'batch_id'}, $opts{'branch_code'});
}
if ($query_params[0] eq '') { # If there is no template id then we cannot delete it
warn sprintf('%s : Cannot delete batch as the batch id is invalid or non-existent.', $call_type);
return -1;
}
my $query = "DELETE FROM creator_batches WHERE batch_id = ? AND branch_code =?";
my $sth = C4::Context->dbh->prepare($query);
# $sth->{'TraceLevel'} = 3;
$sth->execute(@query_params);
if ($sth->err) {
warn sprintf('%s : Database returned the following error on attempted INSERT: %s', $call_type, $sth->errstr);
return -1;
}
return 0;
}
sub remove_duplicates {
my $self = shift;
my %seen=();
my $query = "DELETE FROM creator_batches WHERE label_id = ?;"; # ORDER BY timestamp ASC LIMIT ?;";
my $sth = C4::Context->dbh->prepare($query);
my @duplicate_items = grep{$seen{$_->{'item_number'}}++} @{$self->{'items'}};
foreach my $item (@duplicate_items) {
$sth->execute($item->{'label_id'});
if ($sth->err) {
warn sprintf('Database returned the following error on attempted DELETE for label_id %s: %s', $item->{'label_id'}, $sth->errstr);
return -1;
}
$sth->finish(); # Per DBI.pm docs: "If execute() is called on a statement handle that's still active ($sth->{Active} is true) then it should effectively call finish() to tidy up the previous execution results before starting this new execution."
@{$self->{'items'}} = grep{$_->{'label_id'} != $item->{'label_id'}} @{$self->{'items'}}; # the correct label/item must be removed from the current batch object as well; this should be done *after* each sql DELETE in case the DELETE fails
}
return scalar(@duplicate_items);
}
1;
__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 Apache log.
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 Apache log.
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 Apache log.
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
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

435
C4/Creators/Layout.pm Normal file
View File

@ -0,0 +1,435 @@
package C4::Creators::Layout;
use strict;
use warnings;
use autouse 'Data::Dumper' => qw(Dumper);
use C4::Context;
use C4::Debug;
use C4::Creators::PDF;
BEGIN {
use version; our $VERSION = qv('1.0.0_1');
}
# FIXME: Consider this style parameter verification instead...
# my %param = @_;
# for (keys %param)
# { my $lc = lc($_);
# if (exists $default{$lc})
# { $default{$lc} = $param{$_};
# }
# else
# { print STDERR "Unknown parameter $_ , not used \n";
# }
# }
sub _check_params {
my $exit_code = 0;
my @valtmpl_id_params = (
'layout_id',
'barcode_type',
'printing_type',
'layout_name',
'guidebox',
'font',
'font_size',
'callnum_split',
'text_justify',
'format_string',
'layout_xml', # FIXME: all layouts should be stored in xml format to greatly simplify handling -chris_n
'creator',
);
if (scalar(@_) >1) {
my %given_params = @_;
foreach my $key (keys %given_params) {
if (!(grep m/$key/, @valtmpl_id_params)) {
warn sprintf('(Multiple parameters) Unrecognized parameter type of "%s".', $key);
$exit_code = 1;
}
}
}
else {
if (!(grep m/$_/, @valtmpl_id_params)) {
warn sprintf('(Single parameter) Unrecognized parameter type of "%s".', $_);
$exit_code = 1;
}
}
return $exit_code;
}
sub new {
my $invocant = shift;
my $self = '';
if (_check_params(@_) eq 1) {
return -1;
}
my $type = ref($invocant) || $invocant;
if (grep {$_ eq 'Labels'} @_) {
$self = {
barcode_type => 'CODE39',
printing_type => 'BAR',
layout_name => 'DEFAULT',
guidebox => 0,
font => 'TR',
font_size => 3,
callnum_split => 0,
text_justify => 'L',
format_string => 'title, author, isbn, issn, itemtype, barcode, callnumber',
@_,
};
}
elsif (grep {$_ eq 'Patroncards'} @_) {
$self = {
layout_xml => '<opt>Default Layout</opt>',
@_,
}
}
bless ($self, $type);
return $self;
}
sub retrieve {
my $invocant = shift;
my %opts = @_;
my $type = ref($invocant) || $invocant;
my $query = "SELECT * FROM creator_layouts WHERE layout_id = ? AND creator = ?";
#warn "QUERY: $query\n"; #XXX Remove
#warn "PARAMS: layout_id=" . $opts{'layout_id'} . " creator=" . $opts{'creator'} . "\n"; #XXX Remove
my $sth = C4::Context->dbh->prepare($query);
$sth->execute($opts{'layout_id'}, $opts{'creator'});
if ($sth->err) {
warn sprintf('Database returned the following error: %s', $sth->errstr);
return -1;
}
my $self = $sth->fetchrow_hashref;
bless ($self, $type);
return $self;
}
sub delete {
my $self = {};
my %opts = ();
my $call_type = '';
my @params = ();
if (ref($_[0])) {
$self = shift; # check to see if this is a method call
$call_type = 'C4::Labels::Layout->delete';
push @params, $self->{'layout_id'}, $self->{'creator'};
}
else {
my $class = shift;
%opts = @_;
$call_type = $class . '::delete';
push @params, $opts{'layout_id'}, $opts{'creator'};
}
if (scalar(@params) < 2) { # If there is no layout id or creator type then we cannot delete it
warn sprintf('%s : Cannot delete layout as the profile id is invalid or non-existant.', $call_type) if !$params[0];
warn sprintf('%s : Cannot delete layout as the creator type is invalid or non-existant.', $call_type) if !$params[1];
return -1;
}
my $query = "DELETE FROM creator_layouts WHERE layout_id = ? AND creator = ?";
my $sth = C4::Context->dbh->prepare($query);
$sth->execute(@params);
if ($sth->err) {
warn sprintf('Database returned the following error on attempted DELETE: %s', $sth->errstr);
return -1;
}
}
sub save {
my $self = shift;
if ($self->{'layout_id'}) { # if we have an id, the record exists and needs UPDATE
my @params;
my $query = "UPDATE creator_layouts SET ";
foreach my $key (keys %{$self}) {
next if ($key eq 'layout_id') || ($key eq 'creator');
push (@params, $self->{$key});
$query .= "$key=?, ";
}
$query = substr($query, 0, (length($query)-2));
$query .= " WHERE layout_id=? AND creator = ?;";
push (@params, $self->{'layout_id'}, $self->{'creator'});
my $sth = C4::Context->dbh->prepare($query);
#local $sth->{TraceLevel} = "3"; # enable DBI trace and set level; outputs to STDERR
$sth->execute(@params);
if ($sth->err) {
warn sprintf('Database returned the following error: %s', $sth->errstr);
return -1;
}
return $self->{'layout_id'};
}
else { # otherwise create a new record
my @params;
my $query = "INSERT INTO creator_layouts (";
foreach my $key (keys %{$self}) {
push (@params, $self->{$key});
$query .= "$key, ";
}
$query = substr($query, 0, (length($query)-2));
$query .= ") VALUES (";
for (my $i=1; $i<=(scalar keys %$self); $i++) {
$query .= "?,";
}
$query = substr($query, 0, (length($query)-1));
$query .= ");";
my $sth = C4::Context->dbh->prepare($query);
$sth->execute(@params);
if ($sth->err) {
warn sprintf('Database returned the following error: %s', $sth->errstr);
return -1;
}
my $sth1 = C4::Context->dbh->prepare("SELECT MAX(layout_id) FROM creator_layouts;");
$sth1->execute();
my $id = $sth1->fetchrow_array;
$self->{'layout_id'} = $id;
return $id;
}
}
sub get_attr {
my $self = shift;
if (_check_params(@_) eq 1) {
return -1;
}
my ($attr) = @_;
if (exists($self->{$attr})) {
return $self->{$attr};
}
else {
return -1;
}
return;
}
sub set_attr {
my $self = shift;
if (_check_params(@_) eq 1) {
return -1;
}
my %attrs = @_;
foreach my $attrib (keys(%attrs)) {
$self->{$attrib} = $attrs{$attrib};
};
return 0;
}
sub get_text_wrap_cols {
my $self = shift;
my %params = @_;
my $string = '';
my $strwidth = 0;
my $col_count = 0;
my $textlimit = $params{'label_width'} - ( 3 * $params{'left_text_margin'});
while ($strwidth < $textlimit) {
$string .= '0';
$col_count++;
$strwidth = C4::Creators::PDF->StrWidth( $string, $self->{'font'}, $self->{'font_size'} );
}
return $col_count;
}
1;
__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 Apache log.
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 Apache log.
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 Apache log.
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
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

605
C4/Creators/Lib.pm Normal file
View File

@ -0,0 +1,605 @@
package C4::Creators::Lib;
# 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 warnings;
use autouse 'Data::Dumper' => qw(Dumper);
use C4::Context;
use C4::Debug;
BEGIN {
use version; our $VERSION = qv('1.0.0_1');
use base qw(Exporter);
our @EXPORT_OK = qw(get_all_templates
get_all_layouts
get_all_profiles
get_all_image_names
get_batch_summary
get_label_summary
get_card_summary
get_barcode_types
get_label_types
get_font_types
get_text_justification_types
get_output_formats
get_column_names
get_table_names
get_unit_values
html_table
);
}
#=head2 C4::Creators::Lib::_SELECT()
#
# This function returns a recordset upon success and 1 upon failure. Errors are logged to the Apache log.
#
# examples:
#
# my $field_value = _SELECT(field_name, table_name, condition);
#
#=cut
sub _SELECT {
my @params = @_;
my $query = "SELECT $params[0] FROM $params[1]";
$params[2] ? $query .= " WHERE $params[2];" : $query .= ';';
my $sth = C4::Context->dbh->prepare($query);
# $sth->{'TraceLevel'} = 3;
$sth->execute();
if ($sth->err) {
warn sprintf('Database returned the following error: %s', $sth->errstr);
return 1;
}
my $record_set = [];
while (my $row = $sth->fetchrow_hashref()) {
push(@$record_set, $row);
}
return $record_set;
}
my $barcode_types = [
{type => 'CODE39', name => 'Code 39', desc => 'Translates the characters 0-9, A-Z, \'-\', \'*\', \'+\', \'$\', \'%\', \'/\', \'.\' and \' \' to a barcode pattern.', selected => 0},
{type => 'CODE39MOD', name => 'Code 39 + Modulo43', desc => 'Translates the characters 0-9, A-Z, \'-\', \'*\', \'+\', \'$\', \'%\', \'/\', \'.\' and \' \' to a barcode pattern. Encodes Mod 43 checksum.', selected => 0},
{type => 'CODE39MOD10', name => 'Code 39 + Modulo10', desc => 'Translates the characters 0-9, A-Z, \'-\', \'*\', \'+\', \'$\', \'%\', \'/\', \'.\' and \' \' to a barcode pattern. Encodes Mod 10 checksum.', selected => 0},
{type => 'COOP2OF5', name => 'COOP2of5', desc => 'Creates COOP2of5 barcodes from a string consisting of the numeric characters 0-9', selected => 0},
# {type => 'EAN13', name => 'EAN13', desc => 'Creates EAN13 barcodes from a string of 12 or 13 digits. The check number (the 13:th digit) is calculated if not supplied.', selected => 0},
# {type => 'EAN8', name => 'EAN8', desc => 'Translates a string of 7 or 8 digits to EAN8 barcodes. The check number (the 8:th digit) is calculated if not supplied.', selected => 0},
# {type => 'IATA2of5', name => 'IATA2of5', desc => 'Creates IATA2of5 barcodes from a string consisting of the numeric characters 0-9', selected => 0},
{type => 'INDUSTRIAL2OF5', name => 'Industrial2of5', desc => 'Creates Industrial2of5 barcodes from a string consisting of the numeric characters 0-9', selected => 0},
# {type => 'ITF', name => 'Interleaved2of5', desc => 'Translates the characters 0-9 to a barcodes. These barcodes could also be called 'Interleaved2of5'.', selected => 0},
# {type => 'MATRIX2OF5', name => 'Matrix2of5', desc => 'Creates Matrix2of5 barcodes from a string consisting of the numeric characters 0-9', selected => 0},
# {type => 'NW7', name => 'NW7', desc => 'Creates a NW7 barcodes from a string consisting of the numeric characters 0-9', selected => 0},
# {type => 'UPCA', name => 'UPCA', desc => 'Translates a string of 11 or 12 digits to UPCA barcodes. The check number (the 12:th digit) is calculated if not supplied.', selected => 0},
# {type => 'UPCE', name => 'UPCE', desc => 'Translates a string of 6, 7 or 8 digits to UPCE barcodes. If the string is 6 digits long, '0' is added first in the string. The check number (the 8:th digit) is calculated if not supplied.', selected => 0},
];
my $label_types = [
{type => 'BIB', name => 'Biblio', desc => 'Only the bibliographic data is printed.', selected => 0},
{type => 'BARBIB', name => 'Barcode/Biblio', desc => 'Barcode proceeds bibliographic data.', selected => 0},
{type => 'BIBBAR', name => 'Biblio/Barcode', desc => 'Bibliographic data proceeds barcode.', selected => 0},
{type => 'ALT', name => 'Alternating', desc => 'Barcode and bibliographic data are printed on alternating labels.', selected => 0},
{type => 'BAR', name => 'Barcode', desc => 'Only the barcode is printed.', selected => 0},
];
my $font_types = [
{type => 'TR', name => 'Times-Roman', selected => 0},
{type => 'TB', name => 'Times-Bold', selected => 0},
{type => 'TI', name => 'Times-Italic', selected => 0},
{type => 'TBI', name => 'Times-Bold-Italic', selected => 0},
{type => 'C', name => 'Courier', selected => 0},
{type => 'CB', name => 'Courier-Bold', selected => 0},
{type => 'CO', name => 'Courier-Oblique', selected => 0},
{type => 'CBO', name => 'Courier-Bold-Oblique', selected => 0},
{type => 'H', name => 'Helvetica', selected => 0},
{type => 'HB', name => 'Helvetica-Bold', selected => 0},
{type => 'HBO', name => 'Helvetica-Bold-Oblique', selected => 0},
];
my $text_justification_types = [
{type => 'L', name => 'Left', selected => 0},
{type => 'C', name => 'Center', selected => 0},
{type => 'R', name => 'Right', selected => 0},
# {type => 'F', name => 'Full', selected => 0},
];
my $unit_values = [
{type => 'POINT', desc => 'PostScript Points', value => 1, selected => 0},
{type => 'AGATE', desc => 'Adobe Agates', value => 5.1428571, selected => 0},
{type => 'INCH', desc => 'US Inches', value => 72, selected => 0},
{type => 'MM', desc => 'SI Millimeters', value => 2.83464567, selected => 0},
{type => 'CM', desc => 'SI Centimeters', value => 28.3464567, selected => 0},
];
my $output_formats = [
{type => 'pdf', desc => 'PDF File'},
{type => 'csv', desc => 'CSV File'},
];
=head2 C4::Creators::Lib::get_all_templates()
This function returns a reference to a hash containing all templates upon success and 1 upon failure. Errors are logged to the Apache log.
examples:
my $templates = get_all_templates();
=cut
sub get_all_templates {
my %params = @_;
my @templates = ();
my $query = "SELECT " . ($params{'field_list'} ? $params{'field_list'} : '*') . " FROM creator_templates";
$query .= ($params{'filter'} ? " WHERE $params{'filter'};" : ';');
my $sth = C4::Context->dbh->prepare($query);
$sth->execute();
if ($sth->err) {
warn sprintf('Database returned the following error: %s', $sth->errstr);
return -1;
}
ADD_TEMPLATES:
while (my $template = $sth->fetchrow_hashref) {
push(@templates, $template);
}
return \@templates;
}
=head2 C4::Creators::Lib::get_all_layouts()
This function returns a reference to a hash containing all layouts upon success and 1 upon failure. Errors are logged to the Apache log.
examples:
my $layouts = get_all_layouts();
=cut
sub get_all_layouts {
my %params = @_;
my @layouts = ();
my $query = "SELECT " . ($params{'field_list'} ? $params{'field_list'} : '*') . " FROM creator_layouts";
$query .= ($params{'filter'} ? " WHERE $params{'filter'};" : ';');
my $sth = C4::Context->dbh->prepare($query);
$sth->execute();
if ($sth->err) {
warn sprintf('Database returned the following error: %s', $sth->errstr);
return -1;
}
ADD_LAYOUTS:
while (my $layout = $sth->fetchrow_hashref) {
push(@layouts, $layout);
}
return \@layouts;
}
=head2 C4::Creators::Lib::get_all_profiles()
This function returns an arrayref whose elements are hashes containing all profiles upon success and 1 upon failure. Errors are logged
to the Apache log. Two parameters are accepted. The first limits the field(s) returned. This parameter should be string of comma separted
fields. ie. "field_1, field_2, ...field_n" The second limits the records returned based on a string containing a valud SQL 'WHERE' filter.
NOTE: Do not pass in the keyword 'WHERE.'
examples:
my $profiles = get_all_profiles();
my $profiles = get_all_profiles(field_list => field_list, filter => filter_string);
=cut
sub get_all_profiles {
my %params = @_;
my @profiles = ();
my $query = "SELECT " . ($params{'field_list'} ? $params{'field_list'} : '*') . " FROM printers_profile";
$query .= ($params{'filter'} ? " WHERE $params{'filter'};" : ';');
my $sth = C4::Context->dbh->prepare($query);
# $sth->{'TraceLevel'} = 3 if $debug;
$sth->execute();
if ($sth->err) {
warn sprintf('Database returned the following error: %s', $sth->errstr);
return -1;
}
ADD_PROFILES:
while (my $profile = $sth->fetchrow_hashref) {
push(@profiles, $profile);
}
return \@profiles;
}
=head2 C4::Creators::Lib::get_all_image_names()
=cut
sub get_all_image_names {
my $image_names = [];
my $query = "SELECT image_name FROM creator_images";
my $sth = C4::Context->dbh->prepare($query);
# $sth->{'TraceLevel'} = 3 if $debug;
$sth->execute();
if ($sth->err) {
warn sprintf('Database returned the following error: %s', $sth->errstr);
return -1;
}
grep {push @$image_names, {type => $$_[0], name => $$_[0], selected => 0}} @{$sth->fetchall_arrayref([0])};
return $image_names;
}
=head2 C4::Creators::Lib::get_batch_summary()
This function returns an arrayref whose elements are hashes containing the batch_ids of current batches along with the item count
for each batch upon success and 1 upon failure. Item counts are stored under the key '_item_count' Errors are logged to the Apache log.
One parameter is accepted which limits the records returned based on a string containing a valud SQL 'WHERE' filter.
NOTE: Do not pass in the keyword 'WHERE.'
examples:
my $batches = get_batch_summary();
my $batches = get_batch_summary(filter => filter_string);
=cut
sub get_batch_summary {
my %params = @_;
my @batches = ();
my $query = "SELECT DISTINCT batch_id FROM creator_batches WHERE creator=?";
$query .= ($params{'filter'} ? " AND $params{'filter'};" : ';');
my $sth = C4::Context->dbh->prepare($query);
# $sth->{'TraceLevel'} = 3;
$sth->execute($params{'creator'});
if ($sth->err) {
warn sprintf('Database returned the following error on attempted SELECT: %s', $sth->errstr);
return -1;
}
ADD_BATCHES:
while (my $batch = $sth->fetchrow_hashref) {
my $query = "SELECT count(batch_id) FROM creator_batches WHERE batch_id=? AND creator=?;";
my $sth1 = C4::Context->dbh->prepare($query);
$sth1->execute($batch->{'batch_id'}, $params{'creator'});
if ($sth1->err) {
warn sprintf('Database returned the following error on attempted SELECT count: %s', $sth1->errstr);
return -1;
}
my $count = $sth1->fetchrow_arrayref;
$batch->{'_item_count'} = @$count[0];
push(@batches, $batch);
}
return \@batches;
}
=head2 C4::Creators::Lib::get_label_summary()
This function returns an arrayref whose elements are hashes containing the label_ids of current labels along with the item count
for each label upon success and 1 upon failure. Item counts are stored under the key '_item_count' Errors are logged to the Apache log.
One parameter is accepted which limits the records returned based on a string containing a valud SQL 'WHERE' filter.
NOTE: Do not pass in the keyword 'WHERE.'
examples:
my $labels = get_label_summary();
my $labels = get_label_summary(items => @item_list);
=cut
sub get_label_summary {
my %params = @_;
my $label_number = 0;
my @label_summaries = ();
my $query = " SELECT b.title, b.author, bi.itemtype, i.barcode, i.biblionumber
FROM creator_batches AS c LEFT JOIN items AS i ON (c.item_number=i.itemnumber)
LEFT JOIN biblioitems AS bi ON (i.biblioitemnumber=bi.biblioitemnumber)
LEFT JOIN biblio AS b ON (bi.biblionumber=b.biblionumber)
WHERE itemnumber=? AND batch_id=?;
";
my $sth = C4::Context->dbh->prepare($query);
foreach my $item (@{$params{'items'}}) {
$label_number++;
$sth->execute($item->{'item_number'}, $params{'batch_id'});
if ($sth->err) {
warn sprintf('Database returned the following error on attempted SELECT: %s', $sth->errstr);
return -1;
}
my $record = $sth->fetchrow_hashref;
my $label_summary->{'_label_number'} = $label_number;
$record->{'author'} =~ s/[^\.|\w]$// if $record->{'author'}; # strip off ugly trailing chars... but not periods or word chars
$record->{'title'} =~ s/\W*$//; # strip off ugly trailing chars
# FIXME contructing staff interface URLs should be done *much* higher up the stack - for the most part, C4 module code
# should not know that it's part of a web app
$record->{'title'} = '<a href="/cgi-bin/koha/catalogue/detail.pl?biblionumber=' . $record->{'biblionumber'} . '"> ' . $record->{'title'} . '</a>';
$label_summary->{'_summary'} = $record->{'title'} . " | " . ($record->{'author'} ? $record->{'author'} : 'N/A');
$label_summary->{'_item_type'} = $record->{'itemtype'};
$label_summary->{'_barcode'} = $record->{'barcode'};
$label_summary->{'_item_number'} = $item->{'item_number'};
$label_summary->{'_label_id'} = $item->{'label_id'};
push (@label_summaries, $label_summary);
}
return \@label_summaries;
}
=head2 C4::Creators::Lib::get_card_summary()
This function returns an arrayref whose elements are hashes containing the label_ids of current cards along with the item count
for each card upon success and 1 upon failure. Item counts are stored under the key '_item_count' Errors are logged to the Apache log.
One parameter is accepted which limits the records returned based on a string containing a valud SQL 'WHERE' filter.
NOTE: Do not pass in the keyword 'WHERE.'
examples:
my $cards = get_card_summary();
my $cards = get_card_summary(items => @item_list);
=cut
sub get_card_summary {
my %params = @_;
my $card_number = 0;
my @card_summaries = ();
my $query = "SELECT CONCAT_WS(', ', surname, firstname) AS name, cardnumber FROM borrowers WHERE borrowernumber=?;";
my $sth = C4::Context->dbh->prepare($query);
foreach my $item (@{$params{'items'}}) {
$card_number++;
$sth->execute($item->{'borrower_number'});
if ($sth->err) {
warn sprintf('Database returned the following error on attempted SELECT: %s', $sth->errstr);
return -1;
}
my $record = $sth->fetchrow_hashref;
my $card_summary->{'_card_number'} = $card_number;
$card_summary->{'_summary'} = $record->{'name'};
$card_summary->{'borrowernumber'} = $item->{'borrower_number'};
$card_summary->{'_label_id'} = $item->{'label_id'};
push (@card_summaries, $card_summary);
}
return \@card_summaries;
}
=head2 C4::Creators::Lib::get_barcode_types()
This function returns a reference to an array of hashes containing all barcode types along with their name and description.
examples:
my $barcode_types = get_barcode_types();
=cut
sub get_barcode_types {
return $barcode_types;
}
=head2 C4::Creators::Lib::get_label_types()
This function returns a reference to an array of hashes containing all label types along with their name and description.
examples:
my $label_types = get_label_types();
=cut
sub get_label_types {
return $label_types;
}
=head2 C4::Creators::Lib::get_font_types()
This function returns a reference to an array of hashes containing all font types along with their name and description.
examples:
my $font_types = get_font_types();
=cut
sub get_font_types {
return $font_types;
}
=head2 C4::Creators::Lib::get_text_justification_types()
This function returns a reference to an array of hashes containing all text justification types along with their name and description.
examples:
my $text_justification_types = get_text_justification_types();
=cut
sub get_text_justification_types {
return $text_justification_types;
}
=head2 C4::Creators::Lib::get_unit_values()
This function returns a reference to an array of hashes containing all unit types along with their description and multiplier. NOTE: All units are relative to a PostScript Point.
There are 72 PS points to the inch.
examples:
my $unit_values = get_unit_values();
=cut
sub get_unit_values {
return $unit_values;
}
=head2 C4::Creators::Lib::get_output_formats()
This function returns a reference to an array of hashes containing all label output formats along with their description.
examples:
my $label_output_formats = get_output_formats();
=cut
sub get_output_formats {
return $output_formats;
}
=head2 C4::Creators::Lib::get_column_names($table_name)
Return an arrayref of an array containing the column names of the supplied table.
=cut
sub get_column_names {
my $table = shift;
my $dbh = C4::Context->dbh();
my $column_names = [];
my $sth = $dbh->column_info(undef,undef,$table,'%');
while (my $info = $sth->fetchrow_hashref()){
$$column_names[$info->{'ORDINAL_POSITION'}] = $info->{'COLUMN_NAME'};
}
return $column_names;
}
=head2 C4::Creators::Lib::get_table_names($search_term)
Return an arrayref of an array containing the table names which contain the supplied search term.
=cut
sub get_table_names {
my $search_term = shift;
my $dbh = C4::Context->dbh();
my $table_names = [];
my $sth = $dbh->table_info(undef,undef,"%$search_term%");
while (my $info = $sth->fetchrow_hashref()){
push (@$table_names, $info->{'TABLE_NAME'});
}
return $table_names;
}
=head2 C4::Creators::Lib::html_table()
This function returns an arrayref of an array of hashes contianing the supplied data formatted suitably to
be passed off as a T::P template parameter and used to build an html table.
examples:
my $table = html_table(header_fields, array_of_row_data);
$template->param(
TABLE => $table,
);
html example:
<table>
<!-- TMPL_LOOP NAME="TABLE" -->
<!-- TMPL_IF NAME="header_fields" -->
<tr>
<!-- TMPL_LOOP NAME="header_fields" -->
<th><!-- TMPL_VAR NAME="field_label" --></th>
<!-- /TMPL_LOOP -->
</tr>
<!-- TMPL_ELSE -->
<tr>
<!-- TMPL_LOOP NAME="text_fields" -->
<!-- TMPL_IF NAME="select_field" -->
<td align="center"><input type="checkbox" name="action" value="<!-- TMPL_VAR NAME="field_value" -->" /></td>
<!-- TMPL_ELSIF NAME="field_value" -->
<td><!-- TMPL_VAR NAME="field_value" --></td>
<!-- TMPL_ELSE -->
<td>&nbsp;</td>
<!-- /TMPL_IF -->
<!-- /TMPL_LOOP -->
</tr>
<!-- /TMPL_IF -->
<!-- /TMPL_LOOP -->
</table>
=cut
sub html_table {
my $headers = shift;
my $data = shift;
return undef if scalar(@$data) == 0; # no need to generate a table if there is not data to display
my $table = [];
my $fields = [];
my @table_columns = ();
my ($row_index, $col_index) = (0,0);
my $cols = 0; # number of columns to wrap on
my $field_count = 0;
my $select_value = undef;
my $link_field = undef;
POPULATE_HEADER:
foreach my $header (@$headers) {
my @key = keys %$header;
if ($key[0] eq 'select' ) {
push (@table_columns, $key[0]);
$$fields[$col_index] = {hidden => 0, select_field => 0, field_name => ($key[0]), field_label => $header->{$key[0]}{'label'}};
# do special formatting stuff....
$select_value = $header->{$key[0]}{'value'};
}
else {
# do special formatting stuff....
$link_field->{$key[0]} = ($header->{$key[0]}{'link_field'} == 1 ? 1 : 0);
push (@table_columns, $key[0]);
$$fields[$col_index] = {hidden => 0, select_field => 0, field_name => ($key[0]), field_label => $header->{$key[0]}{'label'}};
}
$field_count++;
$col_index++;
}
$$table[$row_index] = {header_fields => $fields};
$cols = $col_index;
$field_count *= scalar(@$data); # total fields to be displayed in the table
$col_index = 0;
$row_index++;
$fields = [];
POPULATE_TABLE:
foreach my $db_row (@$data) {
POPULATE_ROW:
foreach my $table_column (@table_columns) {
if (grep {$table_column eq $_} keys %$db_row) {
$$fields[$col_index] = {hidden => 0, link_field => $link_field->{$table_column}, select_field => 0, field_name => ($table_column . "_tbl"), field_value => $db_row->{$table_column}};
$col_index++;
next POPULATE_ROW;
}
elsif ($table_column =~ m/^_((.*)_(.*$))/) { # this a special case
my $table_name = get_table_names($2);
my $record_set = _SELECT($1, @$table_name[0], $2 . "_id = " . $db_row->{$2 . "_id"});
$$fields[$col_index] = {hidden => 0, link_field => $link_field->{$table_column}, select_field => 0, field_name => ($table_column . "_tbl"), field_value => $$record_set[0]{$1}};
$col_index++;
next POPULATE_ROW;
}
elsif ($table_column eq 'select' ) {
$$fields[$col_index] = {hidden => 0, select_field => 1, field_name => 'select', field_value => $db_row->{$select_value}};
}
}
$$table[$row_index] = {text_fields => $fields};
$col_index = 0;
$row_index++;
$fields = [];
}
return $table;
}
1;
__END__
=head1 AUTHOR
Chris Nighswonger <cnighswonger AT foundations DOT edu>
=cut

297
C4/Creators/PDF.pm Normal file
View File

@ -0,0 +1,297 @@
package C4::Creators::PDF;
# 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 warnings;
use PDF::Reuse;
use PDF::Reuse::Barcode;
BEGIN {
use version; our $VERSION = qv('1.0.0_1');
}
sub _InitVars {
my $self = shift;
my $param = shift;
prInitVars($param);
}
sub new {
my $invocant = shift;
my $type = ref($invocant) || $invocant;
my %opts = @_;
my $self = {};
_InitVars() if ($opts{InitVars} == 0);
_InitVars($opts{InitVars}) if ($opts{InitVars} > 0);
delete($opts{InitVars});
prDocDir($opts{'DocDir'}) if $opts{'DocDir'};
delete($opts{'DocDir'});
prFile(%opts);
bless ($self, $type);
return $self;
}
sub End {
my $self = shift;
prEnd();
}
sub Add {
my $self = shift;
my $string = shift;
prAdd($string);
}
sub Bookmark {
my $self = shift;
my $reference = shift;
prBookmark($reference);
}
sub Compress {
my $self = shift;
my $directive = shift;
prCompress($directive);
}
sub Doc {
my $self = shift;
my %params = @_;
prDoc(%params);
}
sub DocForm {
my $self = shift;
my %params = @_;
return prDocForm(%params);
}
sub Extract {
my $self = shift;
my ($pdfFile, $pageNo, $oldInternalName) = @_;
return prExtract($pdfFile, $pageNo, $oldInternalName);
}
sub Field {
my $self = shift;
my ($fieldName, $value) = @_;
prField($fieldName, $value);
}
sub Font {
my $self = shift;
my $fontName = shift;
return prFont($fontName);
}
sub FontSize {
my $self = shift;
my $size = shift;
return prFontSize($size);
}
sub Form {
my $self = shift;
my %params = @_;
return prForm(%params);
}
sub GetLogBuffer {
my $self = shift;
return prGetLogBuffer();
}
sub GraphState {
my $self = shift;
my $string = shift;
prGraphState($string);
}
sub Image {
my $self = shift;
my %params = @_;
return prImage(%params);
}
sub Init {
my $self = shift;
my ($string, $duplicateCode) = @_;
prInit($string, $duplicateCode);
}
sub AltJpeg {
my $self = shift;
my ($imageData, $width, $height, $imageFormat, $altImageData, $altImageWidth, $altImageHeight, $altImageFormat) = @_;
return prAltJpeg($imageData, $width, $height, $imageFormat, $altImageData, $altImageWidth, $altImageHeight, $altImageFormat);
}
sub Jpeg {
my $self = shift;
my ($imageData, $width, $height, $imageFormat) = @_;
return prJpeg($imageData, $width, $height, $imageFormat);
}
sub Js {
my $self = shift;
my $string_or_fileName = shift;
prJs($string_or_fileName);
}
sub Link {
my $self = shift;
my %params = @_;
prLink(%params);
}
sub Log {
my $self = shift;
my $string = shift;
prLog($string);
}
sub LogDir {
my $self = shift;
my $directory = shift;
prLogDir($directory);
}
sub Mbox {
my $self = shift;
my ($lowerLeftX, $lowerLeftY, $upperRightX, $upperRightY) = @_;
prMbox($lowerLeftX, $lowerLeftY, $upperRightX, $upperRightY);
}
sub Page {
my $self = shift;
my $noLog = shift;
prPage($noLog);
}
sub SinglePage {
my $self = shift;
my ($file, $pageNumber) = @_;
return prSinglePage($file, $pageNumber);
}
sub StrWidth {
my $self = shift;
my ($string, $font, $fontSize) = @_;
return prStrWidth($string, $font, $fontSize);
}
sub Text {
my $self = shift;
my ($x, $y, $string, $align, $rotation) = @_;
return prText($x, $y, $string, $align, $rotation);
}
sub TTFont {
my $self = shift;
my $path = shift;
return prTTFont($path);
}
sub Code128 {
my $self = shift;
my %opts = @_;
PDF::Reuse::Barcode::Code128(%opts);
}
sub Code39 {
my $self = shift;
my %opts = @_;
PDF::Reuse::Barcode::Code39(%opts);
}
sub COOP2of5 {
my $self = shift;
my %opts = @_;
PDF::Reuse::Barcode::COOP2of5(%opts);
}
sub EAN13 {
my $self = shift;
my %opts = @_;
PDF::Reuse::Barcode::EAN13(%opts);
}
sub EAN8 {
my $self = shift;
my %opts = @_;
PDF::Reuse::Barcode::EAN8(%opts);
}
sub IATA2of5 {
my $self = shift;
my %opts = @_;
PDF::Reuse::Barcode::IATA2of5(%opts);
}
sub Industrial2of5 {
my $self = shift;
my %opts = @_;
PDF::Reuse::Barcode::Industrial2of5(%opts);
}
sub ITF {
my $self = shift;
my %opts = @_;
PDF::Reuse::Barcode::ITF(%opts);
}
sub Matrix2of5 {
my $self = shift;
my %opts = @_;
PDF::Reuse::Barcode::Matrix2of5(%opts);
}
sub NW7 {
my $self = shift;
my %opts = @_;
PDF::Reuse::Barcode::NW7(%opts);
}
sub UPCA {
my $self = shift;
my %opts = @_;
PDF::Reuse::Barcode::UPCA(%opts);
}
sub UPCE {
my $self = shift;
my %opts = @_;
PDF::Reuse::Barcode::UPCE(%opts);
}
1;
__END__
=head1 NAME
C4::Creators::PDF - A class wrapper for PDF::Reuse and PDF::Reuse::Barcode to allow usage as a psuedo-object. For usage see
PDF::Reuse documentation and C4::Creators::PDF code.
=cut
=head1 AUTHOR
Chris Nighswonger <cnighswonger AT foundations DOT edu>
=cut

364
C4/Creators/Profile.pm Normal file
View File

@ -0,0 +1,364 @@
package C4::Creators::Profile;
use strict;
use warnings;
use autouse 'Data::Dumper' => qw(Dumper);
use C4::Context;
use C4::Debug;
use C4::Creators::Lib 1.000000 qw(get_unit_values);
BEGIN {
use version; our $VERSION = qv('1.0.0_1');
}
sub _check_params {
my $given_params = {};
my $exit_code = 0;
my @valid_profile_params = (
'printer_name',
'template_id',
'paper_bin',
'offset_horz',
'offset_vert',
'creep_horz',
'creep_vert',
'units',
'creator',
);
if (scalar(@_) >1) {
$given_params = {@_};
foreach my $key (keys %{$given_params}) {
if (!(grep m/$key/, @valid_profile_params)) {
warn sprintf('Unrecognized parameter type of "%s".', $key);
$exit_code = 1;
}
}
}
else {
if (!(grep m/$_/, @valid_profile_params)) {
warn sprintf('Unrecognized parameter type of "%s".', $_);
$exit_code = 1;
}
}
return $exit_code;
}
sub _conv_points {
my $self = shift;
my @unit_value = grep {$_->{'type'} eq $self->{units}} @{get_unit_values()};
$self->{offset_horz} = $self->{offset_horz} * $unit_value[0]->{'value'};
$self->{offset_vert} = $self->{offset_vert} * $unit_value[0]->{'value'};
$self->{creep_horz} = $self->{creep_horz} * $unit_value[0]->{'value'};
$self->{creep_vert} = $self->{creep_vert} * $unit_value[0]->{'value'};
return $self;
}
sub new {
my $invocant = shift;
if (_check_params(@_) eq 1) {
return -1;
}
my $type = ref($invocant) || $invocant;
my $self = {
printer_name => 'Default Printer',
template_id => '',
paper_bin => 'Tray 1',
offset_horz => 0,
offset_vert => 0,
creep_horz => 0,
creep_vert => 0,
units => 'POINT',
@_,
};
bless ($self, $type);
return $self;
}
sub retrieve {
my $invocant = shift;
my %opts = @_;
my $type = ref($invocant) || $invocant;
my $query = "SELECT * FROM printers_profile WHERE profile_id = ? AND creator = ?";
my $sth = C4::Context->dbh->prepare($query);
$sth->execute($opts{'profile_id'}, $opts{'creator'});
if ($sth->err) {
warn sprintf('Database returned the following error: %s', $sth->errstr);
return -1;
}
my $self = $sth->fetchrow_hashref;
$self = _conv_points($self) if ($opts{convert} && $opts{convert} == 1);
bless ($self, $type);
return $self;
}
sub delete {
my $self = {};
my %opts = ();
my $call_type = '';
my @params = ();
if (ref($_[0])) {
$self = shift; # check to see if this is a method call
$call_type = 'C4::'. $self->{'creator'} .'::Profile->delete';
push @params, $self->{'profile_id'}, $self->{'creator'};
}
else {
my $class = shift; #XXX: is this too hackish?
%opts = @_;
$call_type = $class . "::delete";
push @params, $opts{'profile_id'}, $opts{'creator'};
}
if (scalar(@params) < 2) { # If there is no profile id or creator type then we cannot delete it
warn sprintf('%s : Cannot delete profile as the profile id is invalid or non-existant.', $call_type) if !$params[0];
warn sprintf('%s : Cannot delete profile as the creator type is invalid or non-existant.', $call_type) if !$params[1];
return -1;
}
my $query = "DELETE FROM printers_profile WHERE profile_id = ? AND creator = ?";
my $sth = C4::Context->dbh->prepare($query);
# $sth->{'TraceLevel'} = 3;
$sth->execute(@params);
if ($sth->err) {
warn sprintf('Database returned the following error on attempted DELETE: %s', $sth->errstr);
return -1;
}
}
sub save {
my $self = shift;
if ($self->{'profile_id'}) { # if we have an profile_id, the record exists and needs UPDATE
my @params;
my $query = "UPDATE printers_profile SET ";
foreach my $key (keys %{$self}) {
next if ($key eq 'profile_id') || ($key eq 'creator');
push (@params, $self->{$key});
$query .= "$key=?, ";
}
$query = substr($query, 0, (length($query)-2));
push (@params, $self->{'profile_id'}, $self->{'creator'});
$query .= " WHERE profile_id=? AND creator=?;";
my $sth = C4::Context->dbh->prepare($query);
# $sth->{'TraceLevel'} = 3;
$sth->execute(@params);
if ($sth->err) {
warn sprintf('Database returned the following error on attempted UPDATE: %s', $sth->errstr);
return -1;
}
return $self->{'profile_id'};
}
else { # otherwise create a new record
my @params;
my $query = "INSERT INTO printers_profile (";
foreach my $key (keys %{$self}) {
push (@params, $self->{$key});
$query .= "$key, ";
}
$query = substr($query, 0, (length($query)-2));
$query .= ") VALUES (";
for (my $i=1; $i<=(scalar keys %$self); $i++) {
$query .= "?,";
}
$query = substr($query, 0, (length($query)-1));
$query .= ");";
my $sth = C4::Context->dbh->prepare($query);
$sth->execute(@params);
if ($sth->err) {
warn sprintf('Database returned the following error on attempted INSERT: %s', $sth->errstr);
return -1;
}
my $sth1 = C4::Context->dbh->prepare("SELECT MAX(profile_id) FROM printers_profile;");
$sth1->execute();
my $tmpl_id = $sth1->fetchrow_array;
return $tmpl_id;
}
}
sub get_attr {
my $self = shift;
if (_check_params(@_) eq 1) {
return -1;
}
my ($attr) = @_;
if (exists($self->{$attr})) {
return $self->{$attr};
}
else {
warn sprintf('%s is currently undefined.', $attr);
return -1;
}
}
sub set_attr {
my $self = shift;
if (_check_params(@_) eq 1) {
return -1;
}
my %attrs = @_;
foreach my $attrib (keys(%attrs)) {
$self->{$attrib} = $attrs{$attrib};
};
return 0;
}
1;
__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 Apache log. 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 Apache log.
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 Apache log.
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
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
#=head1
#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
#
#=head2 draw_boundaries
#
# sub draw_boundaries ($llx_spine, $llx_circ1, $llx_circ2,
# $lly, $spine_width, $label_height, $circ_width)
#
#This sub draws boundary lines where the label outlines are, to aid in printer testing, and debugging.
#
#=cut
#
## FIXME: Template use for profile adjustment...
##sub draw_boundaries {
##
## 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 );
##
## }
##}
#
#
#
#=cut

430
C4/Creators/Template.pm Normal file
View File

@ -0,0 +1,430 @@
package C4::Creators::Template;
use strict;
use warnings;
use POSIX qw(ceil);
use autouse 'Data::Dumper' => qw(Dumper);
use C4::Context;
use C4::Debug;
use C4::Creators::Profile 1.000000;
use C4::Creators::Lib 1.000000 qw(get_unit_values);
BEGIN {
use version; our $VERSION = qv('1.0.0_1');
}
sub _check_params {
shift if $_[0] =~ m/::/; # this seems a bit hackish
my $given_params = {};
my $exit_code = 0;
my @valid_template_params = (
'profile_id',
'template_code',
'template_desc',
'page_width',
'page_height',
'label_width',
'label_height',
'card_width',
'card_height',
'top_text_margin',
'left_text_margin',
'top_margin',
'left_margin',
'cols',
'rows',
'col_gap',
'row_gap',
'units',
'creator',
'current_label',
);
if (scalar(@_) >1) {
$given_params = {@_};
foreach my $key (keys %{$given_params}) {
if (!(grep m/$key/, @valid_template_params)) {
warn sprintf('Unrecognized parameter type of "%s".', $key);
$exit_code = 1;
}
}
}
else {
if (!(grep m/$_/, @valid_template_params)) {
warn sprintf('Unrecognized parameter type of "%s".', $_);
$exit_code = 1;
}
}
return $exit_code;
}
sub _conv_points {
my $self = shift;
my @unit_value = grep {$_->{'type'} eq $self->{'units'}} @{get_unit_values()};
$self->{'page_width'} = $self->{'page_width'} * $unit_value[0]->{'value'};
$self->{'page_height'} = $self->{'page_height'} * $unit_value[0]->{'value'};
$self->{'label_width'} = $self->{'label_width'} * $unit_value[0]->{'value'};
$self->{'label_height'} = $self->{'label_height'} * $unit_value[0]->{'value'};
$self->{'top_text_margin'} = $self->{'top_text_margin'} * $unit_value[0]->{'value'};
$self->{'left_text_margin'} = $self->{'left_text_margin'} * $unit_value[0]->{'value'};
$self->{'top_margin'} = $self->{'top_margin'} * $unit_value[0]->{'value'};
$self->{'left_margin'} = $self->{'left_margin'} * $unit_value[0]->{'value'};
$self->{'col_gap'} = $self->{'col_gap'} * $unit_value[0]->{'value'};
$self->{'row_gap'} = $self->{'row_gap'} * $unit_value[0]->{'value'};
return $self;
}
sub _apply_profile {
my $self = shift;
my $creator = shift;
my $profile = C4::Creators::Profile->retrieve(profile_id => $self->{'profile_id'}, creator => $creator, convert => 1);
$self->{'top_margin'} = $self->{'top_margin'} + $profile->get_attr('offset_vert'); # controls vertical offset
$self->{'left_margin'} = $self->{'left_margin'} + $profile->get_attr('offset_horz'); # controls horizontal offset
$self->{'label_height'} = $self->{'label_height'} + $profile->get_attr('creep_vert'); # controls vertical creep
$self->{'label_width'} = $self->{'label_width'} + $profile->get_attr('creep_horz'); # controls horizontal creep
return $self;
}
sub new {
my $invocant = shift;
my $type = ref($invocant) || $invocant;
if (_check_params(@_) eq 1) {
return -1;
}
my $self = {
profile_id => 0,
template_code => 'DEFAULT TEMPLATE',
template_desc => 'Default description',
page_width => 0,
page_height => 0,
label_width => 0,
label_height => 0,
top_text_margin => 0,
left_text_margin => 0,
top_margin => 0,
left_margin => 0,
cols => 0,
rows => 0,
col_gap => 0,
row_gap => 0,
units => 'POINT',
template_stat => 0, # false if any data has changed and the db has not been updated
@_,
};
bless ($self, $type);
return $self;
}
sub retrieve {
my $invocant = shift;
my %opts = @_;
my $type = ref($invocant) || $invocant;
my $query = "SELECT * FROM " . $opts{'table_name'} . " WHERE template_id = ? AND creator = ?";
my $sth = C4::Context->dbh->prepare($query);
$sth->execute($opts{'template_id'}, $opts{'creator'});
if ($sth->err) {
warn sprintf('Database returned the following error: %s', $sth->errstr);
return -1;
}
my $self = $sth->fetchrow_hashref;
$self = _conv_points($self) if (($opts{convert} && $opts{convert} == 1) || $opts{profile_id});
$self = _apply_profile($self, $opts{'creator'}) if $opts{profile_id} && $self->{'profile_id'}; # don't bother if there is no profile_id
$self->{'template_stat'} = 1;
bless ($self, $type);
return $self;
}
sub delete {
my $self = {};
my %opts = ();
my $call_type = '';
my @query_params = ();
if (ref($_[0])) {
$self = shift; # check to see if this is a method call
$call_type = 'C4::Labels::Template->delete';
push @query_params, $self->{'template_id'}, $self->{'creator'};
}
else {
%opts = @_;
$call_type = 'C4::Labels::Template::delete';
push @query_params, $opts{'template_id'}, $opts{'creator'};
}
if (scalar(@query_params) < 2) { # If there is no template id or creator type then we cannot delete it
warn sprintf('%s : Cannot delete template as the template id is invalid or non-existant.', $call_type) if !$query_params[0];
warn sprintf('%s : Cannot delete template as the creator type is invalid or non-existant.', $call_type) if !$query_params[1];
return -1;
}
my $query = "DELETE FROM " . $opts{'table_name'} . " WHERE template_id = ? AND creator = ?";
my $sth = C4::Context->dbh->prepare($query);
$sth->execute(@query_params);
$self->{'template_stat'} = 0;
}
sub save {
my $self = shift;
my %opts = @_;
if ($self->{'template_id'}) { # if we have an template_id, the record exists and needs UPDATE
my @params;
my $query = "UPDATE " . $opts{'table_name'} . " SET ";
foreach my $key (keys %{$self}) {
next if ($key eq 'template_id') || ($key eq 'template_stat') || ($key eq 'creator');
push (@params, $self->{$key});
$query .= "$key=?, ";
}
$query = substr($query, 0, (length($query)-2));
push (@params, $self->{'template_id'}, $self->{'creator'});
$query .= " WHERE template_id=? AND creator=?;";
my $sth = C4::Context->dbh->prepare($query);
$sth->execute(@params);
if ($sth->err) {
warn sprintf('Database returned the following error: %s', $sth->errstr);
return -1;
}
$self->{'template_stat'} = 1;
return $self->{'template_id'};
}
else { # otherwise create a new record
my @params;
my $query = "INSERT INTO " . $opts{'table_name'} ." (";
foreach my $key (keys %{$self}) {
next if $key eq 'template_stat';
push (@params, $self->{$key});
$query .= "$key, ";
}
$query = substr($query, 0, (length($query)-2));
$query .= ") VALUES (";
for (my $i=1; $i<=((scalar keys %$self) - 1); $i++) { # key count less keys not db related...
$query .= "?,";
}
$query = substr($query, 0, (length($query)-1));
$query .= ");";
my $sth = C4::Context->dbh->prepare($query);
$sth->execute(@params);
if ($sth->err) {
warn sprintf('Database returned the following error: %s', $sth->errstr);
return -1;
}
my $sth1 = C4::Context->dbh->prepare("SELECT MAX(template_id) FROM " . $opts{'table_name'} . ";");
$sth1->execute();
my $template_id = $sth1->fetchrow_array;
$self->{'template_id'} = $template_id;
$self->{'template_stat'} = 1;
return $template_id;
}
}
sub get_attr {
my $self = shift;
if (_check_params(@_) eq 1) {
return -1;
}
my ($attr) = @_;
if (exists($self->{$attr})) {
return $self->{$attr};
}
else {
return -1;
}
}
sub set_attr {
my $self = shift;
if (_check_params(@_) eq 1) {
return -1;
}
my %attrs = @_;
foreach my $attrib (keys(%attrs)) {
$self->{$attrib} = $attrs{$attrib};
};
}
sub get_label_position {
my ($self, $start_label) = @_;
my $current_label = $self->{'current_label'};
if ($start_label eq 1) {
$current_label->{'row_count'} = 1;
$current_label->{'col_count'} = 1;
$current_label->{'llx'} = $self->{'left_margin'};
$current_label->{'lly'} = ($self->{'page_height'} - $self->{'top_margin'} - $self->{'label_height'});
$self->{'current_label'} = $current_label;
return ($current_label->{'row_count'}, $current_label->{'col_count'}, $current_label->{'llx'}, $current_label->{'lly'});
}
else {
$current_label->{'row_count'} = ceil($start_label / $self->{'cols'});
$current_label->{'col_count'} = ($start_label - (($current_label->{'row_count'} - 1) * $self->{'cols'}));
$current_label->{'llx'} = $self->{'left_margin'} + ($self->{'label_width'} * ($current_label->{'col_count'} - 1)) + ($self->{'col_gap'} * ($current_label->{'col_count'} - 1));
$current_label->{'lly'} = $self->{'page_height'} - $self->{'top_margin'} - ($self->{'label_height'} * $current_label->{'row_count'}) - ($self->{'row_gap'} * ($current_label->{'row_count'} - 1));
$self->{'current_label'} = $current_label;
return ($current_label->{'row_count'}, $current_label->{'col_count'}, $current_label->{'llx'}, $current_label->{'lly'});
}
}
sub get_next_label_pos {
my $self = shift;
my $current_label = $self->{'current_label'};
my $new_page = 0;
if ($current_label->{'col_count'} lt $self->get_attr('cols')) {
$current_label->{'llx'} = ($current_label->{'llx'} + $self->get_attr('label_width') + $self->get_attr('col_gap'));
$current_label->{'col_count'}++;
}
else {
$current_label->{'llx'} = $self->get_attr('left_margin');
if ($current_label->{'row_count'} eq $self->get_attr('rows')) {
$new_page = 1;
#$pdf->Page(); # after invoking this method, the calling script should check row, col and if they are both one then insert a new pdf page
$current_label->{'lly'} = ($self->get_attr('page_height') - $self->get_attr('top_margin') - $self->get_attr('label_height'));
$current_label->{'row_count'} = 1;
}
else {
$current_label->{'lly'} = ($current_label->{'lly'} - $self->get_attr('row_gap') - $self->get_attr('label_height'));
$current_label->{'row_count'}++;
}
$current_label->{'col_count'} = 1;
}
return ($current_label->{'llx'}, $current_label->{'lly'}, $new_page);
}
1;
__END__
=head1 NAME
C4::Creators::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.
=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 Apache log. 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 Apache log.
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 Apache log.
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
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