1 package C4::Patroncards::Patroncard;
3 # Copyright 2009 Foundations Bible College.
5 # This file is part of Koha.
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.
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.
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>.
23 use autouse 'Data::Dumper' => qw(Dumper);
24 #use Font::TTFMetrics;
26 use C4::Creators::Lib qw( get_unit_values );
27 use C4::Creators::PDF qw(StrWidth);
28 use C4::Patroncards::Lib qw(
30 get_borrower_attributes
37 C4::Patroncards::Patroncard
41 use C4::Patroncards::Patroncard;
48 This module allows you to ...
57 my ($invocant, %params) = @_;
58 my $type = ref($invocant) || $invocant;
60 my $units = get_unit_values();
63 foreach my $un (@$units){
64 if ($un->{'type'} eq $params{'layout'}->{'units'}) {
65 $unitvalue = $un->{'value'};
66 $unitdesc = $un->{'desc'};
71 batch_id => $params{'batch_id'},
72 #card_number => $params{'card_number'},
73 borrower_number => $params{'borrower_number'},
74 llx => $params{'llx'},
75 lly => $params{'lly'},
76 height => $params{'height'},
77 width => $params{'width'},
78 layout => $params{'layout'},
79 unitvalue => $unitvalue,
80 unitdesc => $unitdesc,
81 text_wrap_cols => $params{'text_wrap_cols'},
82 barcode_height_scale => $params{'layout'}->{'barcode'}[0]->{'height_scale'} || 0.01,
83 barcode_width_scale => $params{'layout'}->{'barcode'}[0]->{'width_scale'} || 0.8,
94 my ( $self, $pdf ) = @_;
96 # Default values for barcode scaling are set in constructor to work with pre-existing installations
97 my $barcode_height_scale = $self->{'barcode_height_scale'};
98 my $barcode_width_scale = $self->{'barcode_width_scale'};
99 my $llx = $self->{'llx'} || 0;
100 my $llx_layout = $self->{'layout'}->{'barcode'}->[0]->{'llx'} || 0;
101 my $lly = $self->{'lly'} || 0;
102 my $lly_layout = $self->{'layout'}->{'barcode'}->[0]->{'lly'} || 0;
105 llx => $llx + $llx_layout * $self->{'unitvalue'},
106 lly => $lly + $lly_layout * $self->{'unitvalue'},
107 width => $self->{'width'} * $barcode_width_scale,
108 y_scale_factor => $self->{'height'} * $barcode_height_scale,
109 barcode_type => $self->{'layout'}->{'barcode'}->[0]->{'type'},
110 barcode_data => $self->{'layout'}->{'barcode'}->[0]->{'data'},
111 text => $self->{'layout'}->{'barcode'}->[0]->{'text_print'},
115 =head2 draw_guide_box
120 my ($self, $pdf) = @_;
121 warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
123 my $obj_stream = "q\n"; # save the graphic state
124 $obj_stream .= "0.5 w\n"; # border line width
125 $obj_stream .= "1.0 0.0 0.0 RG\n"; # border color red
126 $obj_stream .= "1.0 1.0 1.0 rg\n"; # fill color white
127 $obj_stream .= "$self->{'llx'} $self->{'lly'} $self->{'width'} $self->{'height'} re\n"; # a rectangle
128 $obj_stream .= "B\n"; # fill (and a little more)
129 $obj_stream .= "Q\n"; # restore the graphic state
130 $pdf->Add($obj_stream);
133 =head2 draw_guide_grid
135 $patron_card->draw_guide_grid($pdf)
137 Adds a grid to the PDF output ($pdf) to support layout design
141 sub draw_guide_grid {
142 my ($self, $pdf) = @_;
143 warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
145 # Set up the grid in user defined units.
146 # Each 5th and 10th line get separate values
148 my $obj_stream = "q\n"; # save the graphic state
149 my $x = $self->{'llx'};
150 my $y = $self->{'lly'};
153 for ( $x = $self->{'llx'}/$self->{'unitvalue'}; $x <= ($self->{'llx'} + $self->{'width'})/$self->{'unitvalue'}; $x++) {
154 my $xx = $x*$self->{'unitvalue'};
155 my $yy = $y + $self->{'height'};
156 if ( ($cnt % 10) && ! ($cnt % 5) ) {
157 $obj_stream .= "0.0 1.0 0.0 RG\n";
158 $obj_stream .= "0 w\n";
159 } elsif ( $cnt % 5 ) {
160 $obj_stream .= "0.0 1.0 1.0 RG\n";
161 $obj_stream .= "0 w\n";
163 $obj_stream .= "0.0 0.0 1.0 RG\n";
164 $obj_stream .= "0 w\n";
168 $obj_stream .= "$xx $y m\n";
169 $obj_stream .= "$xx $yy l\n";
171 $obj_stream .= "s\n";
177 for ( $y = $self->{'lly'}/$self->{'unitvalue'}; $y <= ($self->{'lly'} + $self->{'height'})/$self->{'unitvalue'}; $y++) {
179 my $xx = $x + $self->{'width'};
180 my $yy = $y*$self->{'unitvalue'};
182 if ( ($cnt % 10) && ! ($cnt % 5) ) {
183 $obj_stream .= "0.0 1.0 0.0 RG\n";
184 $obj_stream .= "0 w\n";
185 } elsif ( $cnt % 5 ) {
186 $obj_stream .= "0.0 1.0 1.0 RG\n";
187 $obj_stream .= "0 w\n";
189 $obj_stream .= "0.0 0.0 1.0 RG\n";
190 $obj_stream .= "0 w\n";
194 $obj_stream .= "$x $yy m\n";
195 $obj_stream .= "$xx $yy l\n";
196 $obj_stream .= "s\n";
199 $obj_stream .= "Q\n"; # restore the graphic state
200 $pdf->Add($obj_stream);
202 # Add info about units
203 my $strbottom = "0/0 $self->{'unitdesc'}";
204 my $strtop = sprintf('%.2f', $self->{'width'}/$self->{'unitvalue'}) .'/'. sprintf('%.2f', $self->{'height'}/$self->{'unitvalue'});
206 $pdf->Font( 'Courier' );
207 $pdf->FontSize( $font_size );
208 my $strtop_len = $pdf->StrWidth($strtop) * 1.5;
209 $pdf->Text( $self->{'llx'} + 2, $self->{'lly'} + 2, $strbottom );
210 $pdf->Text( $self->{'llx'} + $self->{'width'} - $strtop_len , $self->{'lly'} + $self->{'height'} - $font_size , $strtop );
215 $patron_card->draw_text($pdf)
217 Draws text to PDF output ($pdf)
222 my ($self, $pdf, %params) = @_;
223 warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
225 return unless (ref($self->{'layout'}->{'text'}) eq 'ARRAY'); # just in case there is not text
227 my $text = [@{$self->{'layout'}->{'text'}}]; # make a copy of the arrayref *not* simply a pointer
228 while (scalar @$text) {
229 my $line = shift @$text;
230 my $parse_line = $line;
231 my @orig_line = split(/ /,$line);
232 if ($parse_line =~ m/<[A-Za-z0-9_]+>/) { # test to see if the line has db fields embedded...
234 while ($parse_line =~ m/<([A-Za-z0-9_]+)>(.*$)/) {
238 my $borrower_attributes = get_borrower_attributes($self->{'borrower_number'},@fields);
239 @orig_line = map { # substitute data for db fields
241 if ($l =~ m/<([A-Za-z0-9_]+)>/) {
243 $l =~ s/$l/$borrower_attributes->{$field}/;
247 $line = join(' ',@orig_line);
249 my $text_attribs = shift @$text;
250 my $llx = $self->{'llx'} || 0;
251 my $llx_text_attr = $text_attribs->{'llx'} || 0;
252 my $lly = $self->{'lly'} || 0;
253 my $lly_text_attr = $text_attribs->{'lly'} || 0;
255 my $origin_llx = $llx + $llx_text_attr * $self->{'unitvalue'};
256 my $origin_lly = $lly + $lly_text_attr * $self->{'unitvalue'};
257 my $Tx = 0; # final text llx
258 my $Ty = $origin_lly; # final text lly
259 my $Tw = 0; # final text word spacing. See http://www.adobe.com/devnet/pdf/pdf_reference.html ISO 32000-1
260 #FIXME: Move line wrapping code to its own sub if possible
263 #FIXME: Using embedded True Type fonts is a far superior way of handing things as well as being much more unicode friendly.
264 # However this will take significant work using better than PDF::Reuse to do it. For the time being, I'm leaving
265 # the basic code here commented out to preserve the basic method of accomplishing this. -chris_n
267 # my $m = Font::TTFMetrics->new("/usr/share/fonts/truetype/msttcorefonts/Times_New_Roman_Bold.ttf");
268 # my $units_per_em = $m->get_units_per_em();
269 # my $font_units_width = $m->string_width($line);
270 # my $string_width = ($font_units_width * $text_attribs->{'font_size'}) / $units_per_em;
271 ## Please see file perltidy.ERR
272 my $string_width = C4::Creators::PDF->StrWidth( $line, $text_attribs->{'font'}, $text_attribs->{'font_size'} );
273 if ( ( $string_width + $llx_text_attr ) > $self->{'width'} ) {
278 # $line =~ m/^.*(\s\b.*\b\s*|\s&|\<\b.*\b\>)$/; # original regexp... can be removed after dev stage is over
279 $line =~ m/^.*(\s.*\s*|\s&|\<.*\>)$/;
282 #Sanitize the input into this regular expression so regex metacharacters are escaped as literal values (https://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=22429)
283 $line =~ s/\Q$1\E$//;
285 C4::Creators::PDF->StrWidth( $line, $text_attribs->{'font'}, $text_attribs->{'font_size'} );
287 # $font_units_width = $m->string_width($line);
288 # $string_width = ($font_units_width * $text_attribs->{'font_size'}) / $units_per_em;
289 if ( ( $string_width + $text_attribs->{'llx'} ) < $self->{'width'} ) {
290 ( $Tx, $Tw ) = text_alignment(
291 $origin_llx, $self->{'width'}, $text_attribs->{'llx'}, $string_width, $line,
292 $text_attribs->{'text_alignment'}
294 push @lines, { line => $line, Tx => $Tx, Ty => $Ty, Tw => $Tw };
296 last WRAP_LINES if $trim eq '';
297 $Ty -= leading( $text_attribs->{'font_size'} );
301 C4::Creators::PDF->StrWidth( $line, $text_attribs->{'font'}, $text_attribs->{'font_size'} );
303 #$font_units_width = $m->string_width($line);
304 #$string_width = ($font_units_width * $text_attribs->{'font_size'}) / $units_per_em;
305 if ( $string_width + ( $text_attribs->{'llx'} * $self->{'unitvalue'} ) < $self->{'width'} ) {
306 ( $Tx, $Tw ) = text_alignment(
307 $origin_llx, $self->{'width'},
308 $text_attribs->{'llx'} * $self->{'unitvalue'}, $string_width, $line,
309 $text_attribs->{'text_alignment'}
311 $line =~ s/^\s+//g; # strip naughty leading spaces
312 push @lines, {line=> $line, Tx => $Tx, Ty => $Ty, Tw => $Tw};
316 # We only split lines on spaces - it seems if we push a line too far, it can end
317 # never getting short enough in which case we need to escape and the malformed PDF
318 # will indicate the layout problem
319 last WRAP_LINES if $cur_line eq $line;
325 ($Tx, $Tw) = text_alignment($origin_llx, $self->{'width'}, $lly_text_attr * $self->{'unitvalue'}, $string_width, $line, $text_attribs->{'text_alignment'});
326 $line =~ s/^\s+//g; # strip naughty leading spaces
327 push @lines, {line=> $line, Tx => $Tx, Ty => $Ty, Tw => $Tw};
329 # Draw boxes around text box areas
330 # 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.
331 # 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.
334 my $box_lly = $origin_lly;
335 if (scalar(@lines) > 1) {
336 $box_height += scalar(@lines) * ($text_attribs->{'font_size'} * 1.2);
337 $box_lly -= ($text_attribs->{'font_size'} * 0.2);
340 $box_height += $text_attribs->{'font_size'};
342 box ($origin_llx, $box_lly, $self->{'width'} - ( $text_attribs->{'llx'} * $self->{'unitvalue'} ), $box_height, $pdf);
344 $pdf->Font($text_attribs->{'font'});
345 $pdf->FontSize($text_attribs->{'font_size'});
346 foreach my $line (@lines) {
347 $pdf->Text($line->{'Tx'}, $line->{'Ty'}, $line->{'line'});
354 $patron_card->draw_image($pdf)
356 Draws images to PDF output ($pdf)
361 my ($self, $pdf) = @_;
362 warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
363 my $images = $self->{'layout'}->{'images'};
366 foreach my $image (keys %$images) {
367 next PROCESS_IMAGES if $images->{$image}->{'data_source'}->[0]->{'image_source'} eq 'none';
368 my $Tx = $self->{'llx'} + $images->{$image}->{'Tx'} * $self->{'unitvalue'};
369 my $Ty = $self->{'lly'} + $images->{$image}->{'Ty'} * $self->{'unitvalue'};
370 warn sprintf('No image passed in.') and next if !$images->{$image}->{'data'};
371 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);
372 my $obj_stream = "q\n";
373 $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
374 $obj_stream .= "$images->{$image}->{'scale'} 0 0 $images->{$image}->{'scale'} 0 0 cm\n"; #scale to 20%
375 $obj_stream .= "/$intName Do\n";
376 $obj_stream .= "Q\n";
377 $pdf->Add($obj_stream);
383 $patron_card->draw_barcode($pdf)
385 Draws a barcode to PDF output ($pdf)
389 sub _draw_barcode { # this is cut-and-paste from Label.pm because there is no common place for it atm...
393 my $x_scale_factor = 1;
394 my $num_of_chars = length($params{'barcode_data'});
395 my $tot_bar_length = 0;
397 my $guard_length = 10;
398 if ($params{'barcode_type'} =~ m/CODE39/) {
399 $bar_length = '17.5';
400 $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
401 $x_scale_factor = ($params{'width'} / $tot_bar_length);
402 if ($params{'barcode_type'} eq 'CODE39MOD') {
403 my $c39 = CheckDigits('code_39'); # get modulo 43 checksum
404 $params{'barcode_data'} = $c39->complete($params{'barcode_data'});
406 elsif ($params{'barcode_type'} eq 'CODE39MOD10') {
407 my $c39_10 = CheckDigits('siret'); # get modulo 10 checksum
408 $params{'barcode_data'} = $c39_10->complete($params{'barcode_data'});
411 PDF::Reuse::Barcode::Code39(
414 value => "*$params{barcode_data}*",
415 xSize => $x_scale_factor,
416 ySize => $params{'y_scale_factor'},
418 text => $params{'text'},
423 warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
426 elsif ($params{'barcode_type'} eq 'COOP2OF5') {
427 $bar_length = '9.43333333333333';
428 $tot_bar_length = ($bar_length * $num_of_chars) + ($guard_length * 2);
429 $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
431 PDF::Reuse::Barcode::COOP2of5(
434 value => $params{barcode_data},
435 xSize => $x_scale_factor,
436 ySize => $params{'y_scale_factor'},
441 warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
444 elsif ( $params{'barcode_type'} eq 'INDUSTRIAL2OF5' ) {
445 $bar_length = '13.1333333333333';
446 $tot_bar_length = ($bar_length * $num_of_chars) + ($guard_length * 2);
447 $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
449 PDF::Reuse::Barcode::Industrial2of5(
452 value => $params{barcode_data},
453 xSize => $x_scale_factor,
454 ySize => $params{'y_scale_factor'},
459 warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
469 Chris Nighswonger <cnighswonger AT foundations DOT edu>