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 with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 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('1.0.0_1');
  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