bug 8215: (followup) make sure C4::CourseReserves doesn't export anything
[koha.git] / C4 / Patroncards / Lib.pm
1 package C4::Patroncards::Lib;
2
3 # Copyright 2009 Foundations Bible College.
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20 use strict;
21 use warnings;
22
23 use autouse 'Data::Dumper' => qw(Dumper);
24
25 use C4::Context;
26 use C4::Debug;
27
28 BEGIN {
29     use version; our $VERSION = qv('3.07.00.049');
30     use base qw(Exporter);
31     our @EXPORT = qw(unpack_UTF8
32                      text_alignment
33                      leading
34                      box
35                      get_borrower_attributes
36                      put_image
37                      get_image
38                      rm_image
39     );
40 }
41
42 sub unpack_UTF8 {
43     my ($str) = @_;
44     my @UTF8 =  (unpack("U0U*", $str));
45     my @HEX = map { sprintf '%2.2x', $_ } @UTF8;
46     return \@HEX;
47 }
48
49 sub text_alignment {
50     my ($origin_llx, $text_box_width, $text_llx, $string_width, $line, $alignment) = @_;
51     my $Tw = 0;
52     my $Tx = 0;
53     if ($alignment eq 'J') {
54         my $UTF82HEX = unpack_UTF8($line);
55         my $space_count = 0;
56         grep {$space_count++ if $_ eq '20'} @$UTF82HEX;
57         $Tw = (($text_box_width - $text_llx) - $string_width) / $space_count;
58         return $origin_llx, $Tw;
59     }
60     elsif ($alignment eq 'C') {
61         my $center_margin = ($text_box_width / 2) + ($origin_llx - $text_llx);
62         $Tx = $center_margin - ($string_width / 2);
63         return $Tx, $Tw;
64     }
65     elsif ($alignment eq 'R') {
66         $Tx = ($text_box_width - $string_width) + (($origin_llx - $text_llx) / 2);
67         return $Tx, $Tw;
68     }
69     elsif ($alignment eq 'L') {
70         return $origin_llx, $Tw;
71     }
72     else {      # if we are not handed an alignment default to left align text...
73         return $origin_llx, $Tw;
74     }
75 }
76
77 sub leading {
78     return $_[0] + ($_[0] * 0.20);      # recommended starting point for leading is 20% of the font point size  (See http://www.bastoky.com/KeyRelations.htm)
79 }
80
81 sub box {
82     my ($llx, $lly, $width, $height, $pdf) = @_;
83     my $obj_stream = "q\n";                            # save the graphic state
84     $obj_stream .= "0.5 w\n";                          # border line width
85     $obj_stream .= "1.0 0.0 0.0  RG\n";                # border color red
86     $obj_stream .= "1.0 1.0 1.0  rg\n";                # fill color white
87     $obj_stream .= "$llx $lly $width $height re\n";    # a rectangle
88     $obj_stream .= "B\n";                              # fill (and a little more)
89     $obj_stream .= "Q\n";                              # restore the graphic state
90     $pdf->Add($obj_stream);
91 }
92
93 sub get_borrower_attributes {
94     my ($borrower_number, @fields) = @_;
95     my $get_branch = 0;
96     $get_branch = 1 if grep{$_ eq 'branchcode'} @fields;
97     my $attrib_count = scalar(@fields);
98     my $query = "SELECT ";
99     while (scalar(@fields)) {
100         $query .= shift(@fields);
101         $query .= ', ' if scalar(@fields);
102     }
103     $query .= " FROM borrowers WHERE borrowernumber = ?";
104     my $sth = C4::Context->dbh->prepare($query);
105 #    $sth->{'TraceLevel'} = 3;
106     $sth->execute($borrower_number);
107     if ($sth->err) {
108         warn sprintf('Database returned the following error: %s', $sth->errstr);
109         return 1;
110     }
111     my $borrower_attributes = $sth->fetchrow_hashref();
112     if ($get_branch) {
113         $query = "SELECT branchname FROM branches WHERE branchcode = ?";
114         $sth = C4::Context->dbh->prepare($query);
115         $sth->execute($borrower_attributes->{'branchcode'});
116         if ($sth->err) {
117             warn sprintf('Database returned the following error: %s', $sth->errstr);
118             return 1;
119         }
120         $borrower_attributes->{'branchcode'} = $sth->fetchrow_hashref()->{'branchname'};
121     }
122     return $borrower_attributes;
123 }
124
125 sub put_image {
126     my ($image_name, $image_file) = @_;
127     if (my $image_limit = C4::Context->preference('ImageLimit')) { # enforce quota if set
128         my $query = "SELECT count(*) FROM creator_images;";
129         my $sth = C4::Context->dbh->prepare($query);
130         $sth->execute();
131         if ($sth->err) {
132             warn sprintf('Database returned the following error: %s', $sth->errstr);
133             return 1;
134         }
135         return 202 if $sth->fetchrow_array >= $image_limit;
136     }
137     my$query = "INSERT INTO creator_images (imagefile, image_name) VALUES (?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
138     my $sth = C4::Context->dbh->prepare($query);
139     $sth->execute($image_file, $image_name, $image_file);
140     if ($sth->err) {
141         warn sprintf('Database returned the following error: %s', $sth->errstr);
142         return 1;
143     }
144     return;
145 }
146
147 sub get_image {
148     my ($image_name, $fields) = @_;
149     $fields = '*' unless $fields;
150     my $query = "SELECT $fields FROM creator_images";
151     $query .= " WHERE image_name = ?" if $image_name;
152     my $sth = C4::Context->dbh->prepare($query);
153     if ($image_name) {
154         $sth->execute($image_name);
155     }
156     else {
157         $sth->execute();
158     }
159     if ($sth->err) {
160         warn sprintf('Database returned the following error: %s', $sth->errstr);
161         return 1;
162     }
163     return $sth->fetchall_arrayref({});
164 }
165
166 sub rm_image {
167     my $image_ids = shift;
168     my $errstr = ();
169     foreach my $image_id (@$image_ids) {
170         my $query = "DELETE FROM creator_images WHERE image_id = ?";
171         my $sth = C4::Context->dbh->prepare($query);
172         $sth->execute($image_id);
173         if ($sth->err) {
174             warn sprintf('Database returned the following error: %s', $sth->errstr);
175             push (@$errstr, $image_id);
176         }
177     }
178     if ($errstr) {
179         return $errstr;
180     }
181     else {
182         return;
183     }
184 }
185
186 1;
187 __END__
188
189 =head1 NAME
190
191 C4::Patroncards::Lib - A shared library of linear functions used in the Patroncard Creator module in Koha
192
193 =head1 ABSTRACT
194
195 This library provides functions used by various sections of the Patroncard Creator module.
196
197 =head1 FUNCTIONS
198
199 =head2 C4::Patroncards::Lib::unpack_UTF8()
200
201     This function returns a reference to an array of hex values equivelant to the utf8 values of the string passed in. This assumes, of course, that the string is
202     indeed utf8.
203
204     example:
205
206         my $hex = unpack_UTF8($str);
207
208 =cut
209
210 =head2 C4::Patroncards::Lib::text_alignment()
211
212     This function returns $Tx and $Tw values for the supplied text alignment. It accepts six parameters:
213
214     C<origin_llx>       = the x value for the origin of the text box to align text in
215     C<text_box_width>   = the width in postscript points of the text box
216     C<text_llx>         = the x value for the lower left point of the text to align
217     C<string_width>     = the width in postscript points of the string of text to align
218     C<line>             = the line of text to align (this may be set to 'undef' for all alignment types except 'Justify')
219     C<alignment>        = the type of text alignment desired:
220
221     =item .
222     B<L>        Left align
223     =item .
224     B<C>        Center align
225     =item .
226     B<R>        Right align
227     =item .
228     B<J>        Justify
229
230     example:
231
232         my ($Tx, $Tw)  = text_alignment($origin_llx, $text_box_width, $text_llx, $string_width, $line, $alignment);
233
234 =cut
235
236 =head2 C4::Patroncards::Lib::leading()
237
238     This function accepts a single parameter, font postscript point size, and returns the ammount of leading to be added.
239
240     example:
241
242         my $leading = leading($font_size);
243
244 =cut
245
246 =head2 C4::Patroncards::Lib::box()
247
248     This function will create and insert a "guide box" into the supplied pdf object. It accepts five arguments:
249
250     C<llx>      = the x value of the lower left coordinate of the guide box
251     C<lly>      = the y value of the lower left coordinate of the guide box
252     C<width>    = the width of the guide box
253     C<height>   = the height of the guide box
254     C<pdf>      = the pdf object into which to insert the guide box
255
256
257     example:
258
259         box($llx, $lly, $width, $height, $pdf);
260
261 =cut
262
263 =head1 AUTHOR
264
265 Chris Nighswonger <cnighswonger AT foundations DOT edu>
266
267 =head1 COPYRIGHT
268
269 Copyright 2009 Foundations Bible College.
270
271 =head1 LICENSE
272
273 This file is part of Koha.
274
275 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
276 Foundation; either version 2 of the License, or (at your option) any later version.
277
278 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,
279 Suite 330, Boston, MA  02111-1307 USA
280
281 =head1 DISCLAIMER OF WARRANTY
282
283 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
284 A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
285
286 =cut