File Coverage

File:C4/Patroncards/Patroncard.pm
Coverage:15.0%

linestmtbrancondsubtimecode
1package C4::Patroncards::Patroncard;
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
3
3
3
3
227
30
111
use strict;
21
3
3
3
3
13
4
178
use warnings;
22
23
3
3
3
3
210
743
25
use autouse 'Data::Dumper' => qw(Dumper);
24
3
3
3
3
627
4462
245
use Text::Wrap qw(wrap);
25#use Font::TTFMetrics;
26
27
3
3
3
3
340
195
261
use C4::Creators::Lib 1.000000 qw(get_font_types);
28
3
3
3
3
201
134
138
use C4::Creators::PDF 1.000000 qw(StrWidth);
29
3
3
3
3
227
49
229
use C4::Patroncards::Lib 1.000000 qw(unpack_UTF8 text_alignment leading box get_borrower_attributes);
30
31BEGIN {
32
3
3
3
3
3
3
14
4
24
236
    use version; our $VERSION = qv('1.0.0_1');
33}
34
35sub new {
36
0
0
    my ($invocant, %params) = @_;
37
0
0
    my $type = ref($invocant) || $invocant;
38
0
    my $self = {
39        batch_id => $params{'batch_id'},
40        #card_number => $params{'card_number'},
41        borrower_number => $params{'borrower_number'},
42        llx => $params{'llx'},
43        lly => $params{'lly'},
44        height => $params{'height'},
45        width => $params{'width'},
46        layout => $params{'layout'},
47        text_wrap_cols => $params{'text_wrap_cols'},
48    };
49
0
    bless ($self, $type);
50
0
    return $self;
51}
52
53sub draw_barcode {
54
0
0
    my ($self, $pdf) = @_;
55#FIXME: We do some scaling foo on the barcode here which probably should be done by the one invoking draw_barcode
56
0
    my $barcode_width = 0.8 * $self->{'width'}; # this scales the barcode width to 80% of the label width
57
0
    my $barcode_y_scale_factor = 0.01 * $self->{'height'}; # this scales the barcode height to 1% of the label height
58
0
    _draw_barcode( $self,
59                        llx => $self->{'llx'} + $self->{'layout'}->{'barcode'}->[0]->{'llx'},
60                        lly => $self->{'lly'} + $self->{'layout'}->{'barcode'}->[0]->{'lly'},
61                        width => $barcode_width,
62                        y_scale_factor => $barcode_y_scale_factor,
63                        barcode_type => $self->{'layout'}->{'barcode'}->[0]->{'type'},
64                        barcode_data => $self->{'layout'}->{'barcode'}->[0]->{'data'},
65                        text => $self->{'layout'}->{'barcode'}->[0]->{'text_print'},
66    );
67}
68
69sub draw_guide_box {
70
0
0
    my ($self, $pdf) = @_;
71
0
0
0
    warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
72
0
    my $obj_stream = "q\n"; # save the graphic state
73
0
    $obj_stream .= "0.5 w\n"; # border line width
74
0
    $obj_stream .= "1.0 0.0 0.0 RG\n"; # border color red
75
0
    $obj_stream .= "1.0 1.0 1.0 rg\n"; # fill color white
76
0
    $obj_stream .= "$self->{'llx'} $self->{'lly'} $self->{'width'} $self->{'height'} re\n"; # a rectangle
77
0
    $obj_stream .= "B\n"; # fill (and a little more)
78
0
    $obj_stream .= "Q\n"; # restore the graphic state
79
0
    $pdf->Add($obj_stream);
80}
81
82sub draw_text {
83
0
0
    my ($self, $pdf, %params) = @_;
84
0
0
0
    warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
85
0
    my @card_text = ();
86
0
0
    return unless (ref($self->{'layout'}->{'text'}) eq 'ARRAY'); # just in case there is not text
87
0
0
    my $text = [@{$self->{'layout'}->{'text'}}]; # make a copy of the arrayref *not* simply a pointer
88
0
    while (scalar @$text) {
89
0
        my $line = shift @$text;
90
0
        my $parse_line = $line;
91
0
        my @orig_line = split(/ /,$line);
92
0
0
        if ($parse_line =~ m/<[A-Za-z0-9]+>/) { # test to see if the line has db fields embedded...
93
0
            my @fields = ();
94
0
            while ($parse_line =~ m/<([A-Za-z0-9]+)>(.*$)/) {
95
0
                push (@fields, $1);
96
0
                $parse_line = $2;
97            }
98
0
            my $borrower_attributes = get_borrower_attributes($self->{'borrower_number'},@fields);
99            grep{ # substitute data for db fields
100
0
0
0
                if ($_ =~ m/<([A-Za-z0-9]+)>/) {
101
0
                    my $field = $1;
102
0
                    $_ =~ s/$_/$borrower_attributes->{$field}/;
103                }
104            } @orig_line;
105
0
            $line = join(' ',@orig_line);
106        }
107
0
        my $text_attribs = shift @$text;
108
0
        my $origin_llx = $self->{'llx'} + $text_attribs->{'llx'};
109
0
        my $origin_lly = $self->{'lly'} + $text_attribs->{'lly'};
110
0
        my $Tx = 0; # final text llx
111
0
        my $Ty = $origin_lly; # final text lly
112
0
        my $Tw = 0; # final text word spacing. See http://www.adobe.com/devnet/pdf/pdf_reference.html ISO 32000-1
113#FIXME: Move line wrapping code to its own sub if possible
114
0
        my $trim = '';
115
0
        my @lines = ();
116#FIXME: Using embedded True Type fonts is a far superior way of handing things as well as being much more unicode friendly.
117# However this will take significant work using better than PDF::Reuse to do it. For the time being, I'm leaving
118# the basic code here commented out to preserve the basic method of accomplishing this. -chris_n
119#
120# my $m = Font::TTFMetrics->new("/usr/share/fonts/truetype/msttcorefonts/Times_New_Roman_Bold.ttf");
121# my $units_per_em = $m->get_units_per_em();
122# my $font_units_width = $m->string_width($line);
123# my $string_width = ($font_units_width * $text_attribs->{'font_size'}) / $units_per_em;
124
0
        my $string_width = C4::Creators::PDF->StrWidth($line, $text_attribs->{'font'}, $text_attribs->{'font_size'});
125
0
0
        if (($string_width + $text_attribs->{'llx'}) > $self->{'width'}) {
126            WRAP_LINES:
127
0
            while (1) {
128# $line =~ m/^.*(\s\b.*\b\s*|\s&|\<\b.*\b\>)$/; # original regexp... can be removed after dev stage is over
129
0
                $line =~ m/^.*(\s.*\s*|\s&|\<.*\>)$/;
130
0
0
0
                warn sprintf('Line wrap failed. DEBUG INFO: Data: \'%s\'\n Method: C4::Patroncards->draw_text Additional Information: Line wrap regexp failed. (Please file in this information in a bug report at http://bugs.koha-community.org', $line) and last WRAP_LINES if !$1;
131
0
                $trim = $1 . $trim;
132
0
                $line =~ s/$1//;
133
0
                $string_width = C4::Creators::PDF->StrWidth($line, $text_attribs->{'font'}, $text_attribs->{'font_size'});
134# $font_units_width = $m->string_width($line);
135# $string_width = ($font_units_width * $text_attribs->{'font_size'}) / $units_per_em;
136
0
0
                if (($string_width + $text_attribs->{'llx'}) < $self->{'width'}) {
137
0
                    ($Tx, $Tw) = text_alignment($origin_llx, $self->{'width'}, $text_attribs->{'llx'}, $string_width, $line, $text_attribs->{'text_alignment'});
138
0
                    push @lines, {line=> $line, Tx => $Tx, Ty => $Ty, Tw => $Tw};
139
0
                    $line = undef;
140
0
0
                    last WRAP_LINES if $trim eq '';
141
0
                    $Ty -= leading($text_attribs->{'font_size'});
142
0
                    $line = $trim;
143
0
                    $trim = '';
144
0
                    $string_width = C4::Creators::PDF->StrWidth($line, $text_attribs->{'font'}, $text_attribs->{'font_size'});
145                    #$font_units_width = $m->string_width($line);
146                    #$string_width = ($font_units_width * $text_attribs->{'font_size'}) / $units_per_em;
147
0
0
                    if (($string_width + $text_attribs->{'llx'}) < $self->{'width'}) {
148
0
                        ($Tx, $Tw) = text_alignment($origin_llx, $self->{'width'}, $text_attribs->{'llx'}, $string_width, $line, $text_attribs->{'text_alignment'});
149
0
                        $line =~ s/^\s+//g; # strip naughty leading spaces
150
0
                        push @lines, {line=> $line, Tx => $Tx, Ty => $Ty, Tw => $Tw};
151
0
                        last WRAP_LINES;
152                    }
153                }
154            }
155        }
156        else {
157
0
            ($Tx, $Tw) = text_alignment($origin_llx, $self->{'width'}, $text_attribs->{'llx'}, $string_width, $line, $text_attribs->{'text_alignment'});
158
0
            $line =~ s/^\s+//g; # strip naughty leading spaces
159
0
            push @lines, {line=> $line, Tx => $Tx, Ty => $Ty, Tw => $Tw};
160        }
161# Draw boxes around text box areas
162# FIXME: This needs to compensate for the point height of decenders. In its current form it is helpful but not really usable. The boxes are also not transparent atm.
163# If these things were fixed, it may be desirable to give the user control over whether or not to display these boxes for layout design.
164
0
        if (0) {
165            my $box_height = 0;
166            my $box_lly = $origin_lly;
167            if (scalar(@lines) > 1) {
168                $box_height += scalar(@lines) * ($text_attribs->{'font_size'} * 1.2);
169                $box_lly -= ($text_attribs->{'font_size'} * 0.2);
170            }
171            else {
172                $box_height += $text_attribs->{'font_size'};
173            }
174            box ($origin_llx, $box_lly, $self->{'width'} - $text_attribs->{'llx'}, $box_height, $pdf);
175        }
176# my $font_resource = $pdf->TTFont("/usr/share/fonts/truetype/msttcorefonts/Times_New_Roman_Bold.ttf");
177# $pdf->FontSize($text_attribs->{'font_size'});
178
0
        my $font_resource = $pdf->Font($text_attribs->{'font'});
179
0
        foreach my $line (@lines) {
180# $pdf->Text($line->{'Tx'}, $line->{'Ty'}, $line->{'line'});
181
0
            my $text_line = "BT /$font_resource $text_attribs->{'font_size'} Tf $line->{'Tx'} $line->{'Ty'} Td $line->{'Tw'} Tw ($line->{'line'}) Tj ET";
182
0
            $pdf->Add($text_line);
183        }
184    }
185}
186
187sub draw_image {
188
0
0
    my ($self, $pdf) = @_;
189
0
0
0
    warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
190
0
    my $images = $self->{'layout'}->{'images'};
191    PROCESS_IMAGES:
192
0
    foreach my $image (keys %$images) {
193
0
0
        next PROCESS_IMAGES if $images->{$image}->{'data_source'}->[0]->{'image_source'} eq 'none';
194
0
        my $Tx = $self->{'llx'} + $images->{$image}->{'Tx'};
195
0
        my $Ty = $self->{'lly'} + $images->{$image}->{'Ty'};
196
0
0
0
        warn sprintf('No image passed in.') and next if !$images->{$image}->{'data'};
197
0
        my $intName = $pdf->AltJpeg($images->{$image}->{'data'},$images->{$image}->{'Sx'}, $images->{$image}->{'Sy'}, 1, $images->{$image}->{'alt'}->{'data'},$images->{$image}->{'alt'}->{'Sx'}, $images->{$image}->{'alt'}->{'Sy'}, 1);
198
0
        my $obj_stream = "q\n";
199
0
        $obj_stream .= "$images->{$image}->{'Sx'} $images->{$image}->{'Ox'} $images->{$image}->{'Oy'} $images->{$image}->{'Sy'} $Tx $Ty cm\n"; # see http://www.adobe.com/devnet/pdf/pdf_reference.html sec 8.3.3 of ISO 32000-1
200
0
        $obj_stream .= "/$intName Do\n";
201
0
        $obj_stream .= "Q\n";
202
0
        $pdf->Add($obj_stream);
203    }
204}
205
206sub _draw_barcode { # this is cut-and-paste from Label.pm because there is no common place for it atm...
207
0
0
    my $self = shift;
208
0
    my %params = @_;
209
0
    my $x_scale_factor = 1;
210
0
    my $num_of_chars = length($params{'barcode_data'});
211
0
    my $tot_bar_length = 0;
212
0
    my $bar_length = 0;
213
0
    my $guard_length = 10;
214
0
0
0
0
    if ($params{'barcode_type'} =~ m/CODE39/) {
215
0
        $bar_length = '17.5';
216
0
        $tot_bar_length = ($bar_length * $num_of_chars) + ($guard_length * 2); # not sure what all is going on here and on the next line; this is old (very) code
217
0
        $x_scale_factor = ($params{'width'} / $tot_bar_length);
218
0
0
0
        if ($params{'barcode_type'} eq 'CODE39MOD') {
219
0
            my $c39 = CheckDigits('code_39'); # get modulo 43 checksum
220
0
            $params{'barcode_data'} = $c39->complete($params{'barcode_data'});
221        }
222        elsif ($params{'barcode_type'} eq 'CODE39MOD10') {
223
0
            my $c39_10 = CheckDigits('siret'); # get modulo 10 checksum
224
0
            $params{'barcode_data'} = $c39_10->complete($params{'barcode_data'});
225        }
226
0
        eval {
227
0
            PDF::Reuse::Barcode::Code39(
228                x => $params{'llx'},
229                y => $params{'lly'},
230                value => "*$params{barcode_data}*",
231                xSize => $x_scale_factor,
232                ySize => $params{'y_scale_factor'},
233                hide_asterisk => 1,
234                text => $params{'text'},
235                mode => 'graphic',
236            );
237        };
238
0
0
        if ($@) {
239
0
            warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
240        }
241    }
242    elsif ($params{'barcode_type'} eq 'COOP2OF5') {
243
0
        $bar_length = '9.43333333333333';
244
0
        $tot_bar_length = ($bar_length * $num_of_chars) + ($guard_length * 2);
245
0
        $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
246
0
        eval {
247
0
            PDF::Reuse::Barcode::COOP2of5(
248                x => $params{'llx'},
249                y => $params{'lly'},
250                value => "*$params{barcode_data}*",
251                xSize => $x_scale_factor,
252                ySize => $params{'y_scale_factor'},
253                mode => 'graphic',
254            );
255        };
256
0
0
        if ($@) {
257
0
            warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
258        }
259    }
260    elsif ( $params{'barcode_type'} eq 'INDUSTRIAL2OF5' ) {
261
0
        $bar_length = '13.1333333333333';
262
0
        $tot_bar_length = ($bar_length * $num_of_chars) + ($guard_length * 2);
263
0
        $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
264
0
        eval {
265
0
            PDF::Reuse::Barcode::Industrial2of5(
266                x => $params{'llx'},
267                y => $params{'lly'},
268                value => "*$params{barcode_data}*",
269                xSize => $x_scale_factor,
270                ySize => $params{'y_scale_factor'},
271                mode => 'graphic',
272            );
273        };
274
0
0
        if ($@) {
275
0
            warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
276        }
277    }
278}
279
2801;