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