1 package C4::Patroncards::Lib;
3 # Copyright 2009 Foundations Bible College.
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
26 use base qw(Exporter);
27 our @EXPORT = qw(unpack_UTF8
31 get_borrower_attributes
40 my @UTF8 = (unpack("U0U*", $str));
41 my @HEX = map { sprintf '%2.2x', $_ } @UTF8;
46 my ($origin_llx, $text_box_width, $text_llx, $string_width, $line, $alignment) = @_;
49 if ($alignment eq 'J') {
50 my $UTF82HEX = unpack_UTF8($line);
52 grep {$space_count++ if $_ eq '20'} @$UTF82HEX;
53 $Tw = (($text_box_width - $text_llx) - $string_width) / $space_count;
54 return $origin_llx, $Tw;
56 elsif ($alignment eq 'C') {
57 my $center_margin = ($text_box_width / 2) + ($origin_llx - $text_llx);
58 $Tx = $center_margin - ($string_width / 2);
61 elsif ($alignment eq 'R') {
62 $Tx = ($text_box_width - $string_width) + (($origin_llx - $text_llx) / 2);
65 elsif ($alignment eq 'L') {
66 return $origin_llx, $Tw;
68 else { # if we are not handed an alignment default to left align text...
69 return $origin_llx, $Tw;
74 return $_[0] + ($_[0] * 0.20); # recommended starting point for leading is 20% of the font point size (See http://www.bastoky.com/KeyRelations.htm)
78 my ($llx, $lly, $width, $height, $pdf) = @_;
79 my $obj_stream = "q\n"; # save the graphic state
80 $obj_stream .= "0.5 w\n"; # border line width
81 $obj_stream .= "1.0 0.0 0.0 RG\n"; # border color red
82 $obj_stream .= "1.0 1.0 1.0 rg\n"; # fill color white
83 $obj_stream .= "$llx $lly $width $height re\n"; # a rectangle
84 $obj_stream .= "B\n"; # fill (and a little more)
85 $obj_stream .= "Q\n"; # restore the graphic state
86 $pdf->Add($obj_stream);
89 sub get_borrower_attributes {
90 my ($borrower_number, @fields) = @_;
92 $get_branch = 1 if grep{$_ eq 'branchcode'} @fields;
93 my $attrib_count = scalar(@fields);
94 my $query = "SELECT ";
95 while (scalar(@fields)) {
96 $query .= shift(@fields);
97 $query .= ', ' if scalar(@fields);
99 $query .= " FROM borrowers WHERE borrowernumber = ?";
100 my $sth = C4::Context->dbh->prepare($query);
101 # $sth->{'TraceLevel'} = 3;
102 $sth->execute($borrower_number);
104 warn sprintf('Database returned the following error: %s', $sth->errstr);
107 my $borrower_attributes = $sth->fetchrow_hashref();
109 $query = "SELECT branchname FROM branches WHERE branchcode = ?";
110 $sth = C4::Context->dbh->prepare($query);
111 $sth->execute($borrower_attributes->{'branchcode'});
113 warn sprintf('Database returned the following error: %s', $sth->errstr);
116 $borrower_attributes->{'branchcode'} = $sth->fetchrow_hashref()->{'branchname'};
118 return $borrower_attributes;
122 my ($image_name, $image_file) = @_;
123 if (my $image_limit = C4::Context->preference('ImageLimit')) { # enforce quota if set
124 my $query = "SELECT count(*) FROM creator_images;";
125 my $sth = C4::Context->dbh->prepare($query);
128 warn sprintf('Database returned the following error: %s', $sth->errstr);
131 return 202 if $sth->fetchrow_array >= $image_limit;
133 my$query = "INSERT INTO creator_images (imagefile, image_name) VALUES (?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
134 my $sth = C4::Context->dbh->prepare($query);
135 $sth->execute($image_file, $image_name, $image_file);
137 warn sprintf('Database returned the following error: %s', $sth->errstr);
144 my ($image_name, $fields) = @_;
145 $fields = '*' unless $fields;
146 my $query = "SELECT $fields FROM creator_images";
147 $query .= " WHERE image_name = ?" if $image_name;
148 my $sth = C4::Context->dbh->prepare($query);
150 $sth->execute($image_name);
156 warn sprintf('Database returned the following error: %s', $sth->errstr);
159 return $sth->fetchall_arrayref({});
163 my $image_ids = shift;
165 foreach my $image_id (@$image_ids) {
166 my $query = "DELETE FROM creator_images WHERE image_id = ?";
167 my $sth = C4::Context->dbh->prepare($query);
168 $sth->execute($image_id);
170 warn sprintf('Database returned the following error: %s', $sth->errstr);
171 push (@$errstr, $image_id);
187 C4::Patroncards::Lib - A shared library of linear functions used in the Patroncard Creator module in Koha
191 This library provides functions used by various sections of the Patroncard Creator module.
195 =head2 C4::Patroncards::Lib::unpack_UTF8()
197 This function returns a reference to an array of hex values equivalent to the utf8 values of the string passed in. This assumes, of course, that the string is
202 my $hex = unpack_UTF8($str);
206 =head2 C4::Patroncards::Lib::text_alignment()
208 This function returns $Tx and $Tw values for the supplied text alignment. It accepts six parameters:
210 C<origin_llx> = the x value for the origin of the text box to align text in
211 C<text_box_width> = the width in postscript points of the text box
212 C<text_llx> = the x value for the lower left point of the text to align
213 C<string_width> = the width in postscript points of the string of text to align
214 C<line> = the line of text to align (this may be set to 'undef' for all alignment types except 'Justify')
215 C<alignment> = the type of text alignment desired:
228 my ($Tx, $Tw) = text_alignment($origin_llx, $text_box_width, $text_llx, $string_width, $line, $alignment);
232 =head2 C4::Patroncards::Lib::leading()
234 This function accepts a single parameter, font postscript point size, and returns the amount of leading to be added.
238 my $leading = leading($font_size);
242 =head2 C4::Patroncards::Lib::box()
244 This function will create and insert a "guide box" into the supplied pdf object. It accepts five arguments:
246 C<llx> = the x value of the lower left coordinate of the guide box
247 C<lly> = the y value of the lower left coordinate of the guide box
248 C<width> = the width of the guide box
249 C<height> = the height of the guide box
250 C<pdf> = the pdf object into which to insert the guide box
255 box($llx, $lly, $width, $height, $pdf);
261 Chris Nighswonger <cnighswonger AT foundations DOT edu>
265 Copyright 2009 Foundations Bible College.
269 This file is part of Koha.
271 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
272 Foundation; either version 2 of the License, or (at your option) any later version.
274 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,
275 Suite 330, Boston, MA 02111-1307 USA
277 =head1 DISCLAIMER OF WARRANTY
279 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
280 A PARTICULAR PURPOSE. See the GNU General Public License for more details.