File Coverage

File:C4/Patroncards/Lib.pm
Coverage:17.6%

linestmtbrancondsubtimecode
1package 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
8
8
8
8
46668
104
397
use strict;
21
8
8
8
8
131
82
419
use warnings;
22
23
8
8
8
8
550
1816
154
use autouse 'Data::Dumper' => qw(Dumper);
24
25
8
8
8
8
1451
52
187
use C4::Context;
26
8
8
8
8
88
53
1024
use C4::Debug;
27
28BEGIN {
29
8
8
8
8
8
8
280
4219
154
136
    use version; our $VERSION = qv('1.0.0_1');
30
8
8
8
8
943
60
739
    use base qw(Exporter);
31
8
10534
    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
42sub unpack_UTF8 {
43
0
0
    my ($str) = @_;
44
0
    my @UTF8 = (unpack("U0U*", $str));
45
0
0
    my @HEX = map { sprintf '%2.2x', $_ } @UTF8;
46
0
    return \@HEX;
47}
48
49sub text_alignment {
50
0
0
    my ($origin_llx, $text_box_width, $text_llx, $string_width, $line, $alignment) = @_;
51
0
    my $Tw = 0;
52
0
    my $Tx = 0;
53
0
0
0
0
0
    if ($alignment eq 'J') {
54
0
        my $UTF82HEX = unpack_UTF8($line);
55
0
        my $space_count = 0;
56
0
0
0
        grep {$space_count++ if $_ eq '20'} @$UTF82HEX;
57
0
        $Tw = (($text_box_width - $text_llx) - $string_width) / $space_count;
58
0
        return $origin_llx, $Tw;
59    }
60    elsif ($alignment eq 'C') {
61
0
        my $center_margin = ($text_box_width / 2) + ($origin_llx - $text_llx);
62
0
        $Tx = $center_margin - ($string_width / 2);
63
0
        return $Tx, $Tw;
64    }
65    elsif ($alignment eq 'R') {
66
0
        $Tx = ($text_box_width - $string_width) + (($origin_llx - $text_llx) / 2);
67
0
        return $Tx, $Tw;
68    }
69    elsif ($alignment eq 'L') {
70
0
        return $origin_llx, $Tw;
71    }
72    else { # if we are not handed an alignment default to left align text...
73
0
        return $origin_llx, $Tw;
74    }
75}
76
77sub leading {
78
0
0
    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
81sub box {
82
0
0
    my ($llx, $lly, $width, $height, $pdf) = @_;
83
0
    my $obj_stream = "q\n"; # save the graphic state
84
0
    $obj_stream .= "0.5 w\n"; # border line width
85
0
    $obj_stream .= "1.0 0.0 0.0 RG\n"; # border color red
86
0
    $obj_stream .= "1.0 1.0 1.0 rg\n"; # fill color white
87
0
    $obj_stream .= "$llx $lly $width $height re\n"; # a rectangle
88
0
    $obj_stream .= "B\n"; # fill (and a little more)
89
0
    $obj_stream .= "Q\n"; # restore the graphic state
90
0
    $pdf->Add($obj_stream);
91}
92
93sub get_borrower_attributes {
94
0
0
    my ($borrower_number, @fields) = @_;
95
0
    my $get_branch = 0;
96
0
0
0
    $get_branch = 1 if grep{$_ eq 'branchcode'} @fields;
97
0
    my $attrib_count = scalar(@fields);
98
0
    my $query = "SELECT ";
99
0
    while (scalar(@fields)) {
100
0
        $query .= shift(@fields);
101
0
0
        $query .= ', ' if scalar(@fields);
102    }
103
0
    $query .= " FROM borrowers WHERE borrowernumber = ?";
104
0
    my $sth = C4::Context->dbh->prepare($query);
105# $sth->{'TraceLevel'} = 3;
106
0
    $sth->execute($borrower_number);
107
0
0
    if ($sth->err) {
108
0
        warn sprintf('Database returned the following error: %s', $sth->errstr);
109
0
        return 1;
110    }
111
0
    my $borrower_attributes = $sth->fetchrow_hashref();
112
0
0
    if ($get_branch) {
113
0
        $query = "SELECT branchname FROM branches WHERE branchcode = ?";
114
0
        $sth = C4::Context->dbh->prepare($query);
115
0
        $sth->execute($borrower_attributes->{'branchcode'});
116
0
0
        if ($sth->err) {
117
0
            warn sprintf('Database returned the following error: %s', $sth->errstr);
118
0
            return 1;
119        }
120
0
        $borrower_attributes->{'branchcode'} = $sth->fetchrow_hashref()->{'branchname'};
121    }
122
0
    return $borrower_attributes;
123}
124
125sub put_image {
126
0
0
    my ($image_name, $image_file) = @_;
127
0
0
    if (my $image_limit = C4::Context->preference('ImageLimit')) { # enforce quota if set
128
0
        my $query = "SELECT count(*) FROM creator_images;";
129
0
        my $sth = C4::Context->dbh->prepare($query);
130
0
        $sth->execute();
131
0
0
        if ($sth->err) {
132
0
            warn sprintf('Database returned the following error: %s', $sth->errstr);
133
0
            return 1;
134        }
135
0
0
        return 202 if $sth->fetchrow_array >= $image_limit;
136    }
137
0
    my$query = "INSERT INTO creator_images (imagefile, image_name) VALUES (?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
138
0
    my $sth = C4::Context->dbh->prepare($query);
139
0
    $sth->execute($image_file, $image_name, $image_file);
140
0
0
    if ($sth->err) {
141
0
        warn sprintf('Database returned the following error: %s', $sth->errstr);
142
0
        return 1;
143    }
144
0
    return;
145}
146
147sub get_image {
148
0
0
    my ($image_name, $fields) = @_;
149
0
0
    $fields = '*' unless $fields;
150
0
    my $query = "SELECT $fields FROM creator_images";
151
0
0
    $query .= " WHERE image_name = ?" if $image_name;
152
0
    my $sth = C4::Context->dbh->prepare($query);
153
0
0
    if ($image_name) {
154
0
        $sth->execute($image_name);
155    }
156    else {
157
0
        $sth->execute();
158    }
159
0
0
    if ($sth->err) {
160
0
        warn sprintf('Database returned the following error: %s', $sth->errstr);
161
0
        return 1;
162    }
163
0
    return $sth->fetchall_arrayref({});
164}
165
166sub rm_image {
167
0
0
    my $image_ids = shift;
168
0
    my $errstr = ();
169
0
    foreach my $image_id (@$image_ids) {
170
0
        my $query = "DELETE FROM creator_images WHERE image_id = ?";
171
0
        my $sth = C4::Context->dbh->prepare($query);
172
0
        $sth->execute($image_id);
173
0
0
        if ($sth->err) {
174
0
            warn sprintf('Database returned the following error: %s', $sth->errstr);
175
0
            push (@$errstr, $image_id);
176        }
177    }
178
0
0
    if ($errstr) {
179
0
        return $errstr;
180    }
181    else {
182
0
        return;
183    }
184}
185
1861;