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 C4::Context;
  24
  25 BEGIN {
  26     use base qw(Exporter);
  27     our @EXPORT = qw(unpack_UTF8
  28                      text_alignment
  29                      leading
  30                      box
  31                      get_borrower_attributes
  32                      put_image
  33                      get_image
  34                      rm_image
  35     );
  36 }
  37
  38 sub unpack_UTF8 {
  39     my ($str) = @_;
  40     my @UTF8 =  (unpack("U0U*", $str));
  41     my @HEX = map { sprintf '%2.2x', $_ } @UTF8;
  42     return \@HEX;
  43 }
  44
  45 sub text_alignment {
  46     my ($origin_llx, $text_box_width, $text_llx, $string_width, $line, $alignment) = @_;
  47     my $Tw = 0;
  48     my $Tx = 0;
  49     if ($alignment eq 'J') {
  50         my $UTF82HEX = unpack_UTF8($line);
  51         my $space_count = 0;
  52         grep {$space_count++ if $_ eq '20'} @$UTF82HEX;
  53         $Tw = (($text_box_width - $text_llx) - $string_width) / $space_count;
  54         return $origin_llx, $Tw;
  55     }
  56     elsif ($alignment eq 'C') {
  57         my $center_margin = ($text_box_width / 2) + ($origin_llx - $text_llx);
  58         $Tx = $center_margin - ($string_width / 2);
  59         return $Tx, $Tw;
  60     }
  61     elsif ($alignment eq 'R') {
  62         $Tx = ($text_box_width - $string_width) + (($origin_llx - $text_llx) / 2);
  63         return $Tx, $Tw;
  64     }
  65     elsif ($alignment eq 'L') {
  66         return $origin_llx, $Tw;
  67     }
  68     else {      # if we are not handed an alignment default to left align text...
  69         return $origin_llx, $Tw;
  70     }
  71 }
  72
  73 sub leading {
  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)
  75 }
  76
  77 sub box {
  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);
  87 }
  88
  89 sub get_borrower_attributes {
  90     my ($borrower_number, @fields) = @_;
  91     my $get_branch = 0;
  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);
  98     }
  99     $query .= " FROM borrowers WHERE borrowernumber = ?";
 100     my $sth = C4::Context->dbh->prepare($query);
 101 #    $sth->{'TraceLevel'} = 3;
 102     $sth->execute($borrower_number);
 103     if ($sth->err) {
 104         warn sprintf('Database returned the following error: %s', $sth->errstr);
 105         return 1;
 106     }
 107     my $borrower_attributes = $sth->fetchrow_hashref();
 108     if ($get_branch) {
 109         $query = "SELECT branchname FROM branches WHERE branchcode = ?";
 110         $sth = C4::Context->dbh->prepare($query);
 111         $sth->execute($borrower_attributes->{'branchcode'});
 112         if ($sth->err) {
 113             warn sprintf('Database returned the following error: %s', $sth->errstr);
 114             return 1;
 115         }
 116         $borrower_attributes->{'branchcode'} = $sth->fetchrow_hashref()->{'branchname'};
 117     }
 118     return $borrower_attributes;
 119 }
 120
 121 sub put_image {
 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);
 126         $sth->execute();
 127         if ($sth->err) {
 128             warn sprintf('Database returned the following error: %s', $sth->errstr);
 129             return 1;
 130         }
 131         return 202 if $sth->fetchrow_array >= $image_limit;
 132     }
 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);
 136     if ($sth->err) {
 137         warn sprintf('Database returned the following error: %s', $sth->errstr);
 138         return 1;
 139     }
 140     return;
 141 }
 142
 143 sub get_image {
 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);
 149     if ($image_name) {
 150         $sth->execute($image_name);
 151     }
 152     else {
 153         $sth->execute();
 154     }
 155     if ($sth->err) {
 156         warn sprintf('Database returned the following error: %s', $sth->errstr);
 157         return 1;
 158     }
 159     return $sth->fetchall_arrayref({});
 160 }
 161
 162 sub rm_image {
 163     my $image_ids = shift;
 164     my $errstr = ();
 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);
 169         if ($sth->err) {
 170             warn sprintf('Database returned the following error: %s', $sth->errstr);
 171             push (@$errstr, $image_id);
 172         }
 173     }
 174     if ($errstr) {
 175         return $errstr;
 176     }
 177     else {
 178         return;
 179     }
 180 }
 181
 182 1;
 183 __END__
 184
 185 =head1 NAME
 186
 187 C4::Patroncards::Lib - A shared library of linear functions used in the Patroncard Creator module in Koha
 188
 189 =head1 ABSTRACT
 190
 191 This library provides functions used by various sections of the Patroncard Creator module.
 192
 193 =head1 FUNCTIONS
 194
 195 =head2 C4::Patroncards::Lib::unpack_UTF8()
 196
 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
 198     indeed utf8.
 199
 200     example:
 201
 202         my $hex = unpack_UTF8($str);
 203
 204 =cut
 205
 206 =head2 C4::Patroncards::Lib::text_alignment()
 207
 208     This function returns $Tx and $Tw values for the supplied text alignment. It accepts six parameters:
 209
 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:
 216
 217     =item .
 218     B<L>        Left align
 219     =item .
 220     B<C>        Center align
 221     =item .
 222     B<R>        Right align
 223     =item .
 224     B<J>        Justify
 225
 226     example:
 227
 228         my ($Tx, $Tw)  = text_alignment($origin_llx, $text_box_width, $text_llx, $string_width, $line, $alignment);
 229
 230 =cut
 231
 232 =head2 C4::Patroncards::Lib::leading()
 233
 234     This function accepts a single parameter, font postscript point size, and returns the amount of leading to be added.
 235
 236     example:
 237
 238         my $leading = leading($font_size);
 239
 240 =cut
 241
 242 =head2 C4::Patroncards::Lib::box()
 243
 244     This function will create and insert a "guide box" into the supplied pdf object. It accepts five arguments:
 245
 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
 251
 252
 253     example:
 254
 255         box($llx, $lly, $width, $height, $pdf);
 256
 257 =cut
 258
 259 =head1 AUTHOR
 260
 261 Chris Nighswonger <cnighswonger AT foundations DOT edu>
 262
 263 =head1 COPYRIGHT
 264
 265 Copyright 2009 Foundations Bible College.
 266
 267 =head1 LICENSE
 268
 269 This file is part of Koha.
 270
 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.
 273
 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
 276
 277 =head1 DISCLAIMER OF WARRANTY
 278
 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.
 281
 282 =cut