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 Text
::Wrap
qw(wrap);
25 #use Font::TTFMetrics;
27 use C4
::Creators
::Lib
qw(get_font_types get_unit_values);
28 use C4
::Creators
::PDF
qw(StrWidth);
29 use C4
::Patroncards
::Lib
qw(unpack_UTF8 text_alignment leading box get_borrower_attributes);
33 C4::Patroncards::Patroncard
37 use C4::Patroncards::Patroncard;
44 This module allows you to ...
53 my ($invocant, %params) = @_;
54 my $type = ref($invocant) || $invocant;
56 my $units = get_unit_values
();
59 foreach my $un (@
$units){
60 if ($un->{'type'} eq $params{'layout'}->{'units'}) {
61 $unitvalue = $un->{'value'};
62 $unitdesc = $un->{'desc'};
67 batch_id
=> $params{'batch_id'},
68 #card_number => $params{'card_number'},
69 borrower_number
=> $params{'borrower_number'},
70 llx
=> $params{'llx'},
71 lly
=> $params{'lly'},
72 height
=> $params{'height'},
73 width
=> $params{'width'},
74 layout
=> $params{'layout'},
75 unitvalue
=> $unitvalue,
76 unitdesc
=> $unitdesc,
77 text_wrap_cols
=> $params{'text_wrap_cols'},
78 barcode_height_scale
=> $params{'layout'}->{'barcode'}[0]->{'height_scale'} || 0.01,
79 barcode_width_scale
=> $params{'layout'}->{'barcode'}[0]->{'width_scale'} || 0.8,
90 my ($self, $pdf) = @_;
91 # Default values for barcode scaling are set in constructor to work with pre-existing installations
92 my $barcode_height_scale = $self->{'barcode_height_scale'};
93 my $barcode_width_scale = $self->{'barcode_width_scale'};
96 llx
=> $self->{'llx'} + $self->{'layout'}->{'barcode'}->[0]->{'llx'},
97 lly
=> $self->{'lly'} + $self->{'layout'}->{'barcode'}->[0]->{'lly'},
98 width
=> $self->{'width'} * $barcode_width_scale,
99 y_scale_factor
=> $self->{'height'} * $barcode_height_scale,
100 barcode_type
=> $self->{'layout'}->{'barcode'}->[0]->{'type'},
101 barcode_data
=> $self->{'layout'}->{'barcode'}->[0]->{'data'},
102 text
=> $self->{'layout'}->{'barcode'}->[0]->{'text_print'},
106 =head2 draw_guide_box
111 my ($self, $pdf) = @_;
112 warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
114 my $obj_stream = "q\n"; # save the graphic state
115 $obj_stream .= "0.5 w\n"; # border line width
116 $obj_stream .= "1.0 0.0 0.0 RG\n"; # border color red
117 $obj_stream .= "1.0 1.0 1.0 rg\n"; # fill color white
118 $obj_stream .= "$self->{'llx'} $self->{'lly'} $self->{'width'} $self->{'height'} re\n"; # a rectangle
119 $obj_stream .= "B\n"; # fill (and a little more)
120 $obj_stream .= "Q\n"; # restore the graphic state
121 $pdf->Add($obj_stream);
124 =head2 draw_guide_grid
126 $patron_card->draw_guide_grid($pdf)
128 Adds a grid to the PDF output ($pdf) to support layout design
132 sub draw_guide_grid
{
133 my ($self, $pdf) = @_;
134 warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
136 # Set up the grid in user defined units.
137 # Each 5th and 10th line get separate values
139 my $obj_stream = "q\n"; # save the graphic state
140 my $x = $self->{'llx'};
141 my $y = $self->{'lly'};
144 for ( $x = $self->{'llx'}/$self->{'unitvalue'}; $x <= ($self->{'llx'} + $self->{'width'})/$self->{'unitvalue'}; $x++) {
145 my $xx = $x*$self->{'unitvalue'};
146 my $yy = $y + $self->{'height'};
147 if ( ($cnt % 10) && ! ($cnt % 5) ) {
148 $obj_stream .= "0.0 1.0 0.0 RG\n";
149 $obj_stream .= "0 w\n";
150 } elsif ( $cnt % 5 ) {
151 $obj_stream .= "0.0 1.0 1.0 RG\n";
152 $obj_stream .= "0 w\n";
154 $obj_stream .= "0.0 0.0 1.0 RG\n";
155 $obj_stream .= "0 w\n";
159 $obj_stream .= "$xx $y m\n";
160 $obj_stream .= "$xx $yy l\n";
162 $obj_stream .= "s\n";
168 for ( $y = $self->{'lly'}/$self->{'unitvalue'}; $y <= ($self->{'lly'} + $self->{'height'})/$self->{'unitvalue'}; $y++) {
170 my $xx = $x + $self->{'width'};
171 my $yy = $y*$self->{'unitvalue'};
173 if ( ($cnt % 10) && ! ($cnt % 5) ) {
174 $obj_stream .= "0.0 1.0 0.0 RG\n";
175 $obj_stream .= "0 w\n";
176 } elsif ( $cnt % 5 ) {
177 $obj_stream .= "0.0 1.0 1.0 RG\n";
178 $obj_stream .= "0 w\n";
180 $obj_stream .= "0.0 0.0 1.0 RG\n";
181 $obj_stream .= "0 w\n";
185 $obj_stream .= "$x $yy m\n";
186 $obj_stream .= "$xx $yy l\n";
187 $obj_stream .= "s\n";
190 $obj_stream .= "Q\n"; # restore the graphic state
191 $pdf->Add($obj_stream);
193 # Add info about units
194 my $strbottom = "0/0 $self->{'unitdesc'}";
195 my $strtop = sprintf('%.2f', $self->{'width'}/$self->{'unitvalue'}) .'/'. sprintf('%.2f
', $self->{'height
'}/$self->{'unitvalue
'});
197 $pdf->Font( 'Courier
' );
198 $pdf->FontSize( $font_size );
199 my $strtop_len = $pdf->StrWidth($strtop) * 1.5;
200 $pdf->Text( $self->{'llx
'} + 2, $self->{'lly
'} + 2, $strbottom );
201 $pdf->Text( $self->{'llx
'} + $self->{'width
'} - $strtop_len , $self->{'lly
'} + $self->{'height
'} - $font_size , $strtop );
206 $patron_card->draw_text($pdf)
208 Draws text to PDF output ($pdf)
213 my ($self, $pdf, %params) = @_;
214 warn sprintf('No pdf object passed
in.') and return -1 if !$pdf;
216 return unless (ref($self->{'layout
'}->{'text
'}) eq 'ARRAY
'); # just in case there is not text
218 my $text = [@{$self->{'layout
'}->{'text
'}}]; # make a copy of the arrayref *not* simply a pointer
219 while (scalar @$text) {
220 my $line = shift @$text;
221 my $parse_line = $line;
222 my @orig_line = split(/ /,$line);
223 if ($parse_line =~ m/<[A-Za-z0-9_]+>/) { # test to see if the line has db fields embedded...
225 while ($parse_line =~ m/<([A-Za-z0-9_]+)>(.*$)/) {
229 my $borrower_attributes = get_borrower_attributes($self->{'borrower_number
'},@fields);
230 grep{ # substitute data for db fields
231 if ($_ =~ m/<([A-Za-z0-9_]+)>/) {
233 $_ =~ s/$_/$borrower_attributes->{$field}/;
236 $line = join(' ',@orig_line);
238 my $text_attribs = shift @$text;
239 my $origin_llx = $self->{'llx
'} + $text_attribs->{'llx
'} * $self->{'unitvalue
'};
240 my $origin_lly = $self->{'lly
'} + $text_attribs->{'lly
'} * $self->{'unitvalue
'};
241 my $Tx = 0; # final text llx
242 my $Ty = $origin_lly; # final text lly
243 my $Tw = 0; # final text word spacing. See http://www.adobe.com/devnet/pdf/pdf_reference.html ISO 32000-1
244 #FIXME: Move line wrapping code to its own sub if possible
247 #FIXME: Using embedded True Type fonts is a far superior way of handing things as well as being much more unicode friendly.
248 # However this will take significant work using better than PDF::Reuse to do it. For the time being, I'm leaving
249 # the basic code here commented out to preserve the basic method of accomplishing this. -chris_n
251 # my $m = Font::TTFMetrics->new("/usr/share/fonts/truetype/msttcorefonts/Times_New_Roman_Bold.ttf");
252 # my $units_per_em = $m->get_units_per_em();
253 # my $font_units_width = $m->string_width($line);
254 # my $string_width = ($font_units_width * $text_attribs->{'font_size'}) / $units_per_em;
255 my $string_width = C4
::Creators
::PDF
->StrWidth($line, $text_attribs->{'font'}, $text_attribs->{'font_size'});
256 if (($string_width + $text_attribs->{'llx'}) > $self->{'width'}) {
259 # $line =~ m/^.*(\s\b.*\b\s*|\s&|\<\b.*\b\>)$/; # original regexp... can be removed after dev stage is over
260 $line =~ m/^.*(\s.*\s*|\s&|\<.*\>)$/;
261 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;
264 $string_width = C4
::Creators
::PDF
->StrWidth($line, $text_attribs->{'font'}, $text_attribs->{'font_size'});
265 # $font_units_width = $m->string_width($line);
266 # $string_width = ($font_units_width * $text_attribs->{'font_size'}) / $units_per_em;
267 if (($string_width + $text_attribs->{'llx'}) < $self->{'width'}) {
268 ($Tx, $Tw) = text_alignment
($origin_llx, $self->{'width'}, $text_attribs->{'llx'}, $string_width, $line, $text_attribs->{'text_alignment'});
269 push @lines, {line
=> $line, Tx
=> $Tx, Ty
=> $Ty, Tw
=> $Tw};
271 last WRAP_LINES
if $trim eq '';
272 $Ty -= leading
($text_attribs->{'font_size'});
275 $string_width = C4
::Creators
::PDF
->StrWidth($line, $text_attribs->{'font'}, $text_attribs->{'font_size'});
276 #$font_units_width = $m->string_width($line);
277 #$string_width = ($font_units_width * $text_attribs->{'font_size'}) / $units_per_em;
278 if ( $string_width + ( $text_attribs->{'llx'} * $self->{'unitvalue'} ) < $self->{'width'}) {
279 ($Tx, $Tw) = text_alignment
($origin_llx, $self->{'width'}, $text_attribs->{'llx'} * $self->{'unitvalue'}, $string_width, $line, $text_attribs->{'text_alignment'});
280 $line =~ s/^\s+//g; # strip naughty leading spaces
281 push @lines, {line
=> $line, Tx
=> $Tx, Ty
=> $Ty, Tw
=> $Tw};
288 ($Tx, $Tw) = text_alignment
($origin_llx, $self->{'width'}, $text_attribs->{'llx'} * $self->{'unitvalue'}, $string_width, $line, $text_attribs->{'text_alignment'});
289 $line =~ s/^\s+//g; # strip naughty leading spaces
290 push @lines, {line
=> $line, Tx
=> $Tx, Ty
=> $Ty, Tw
=> $Tw};
292 # Draw boxes around text box areas
293 # 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.
294 # 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.
297 my $box_lly = $origin_lly;
298 if (scalar(@lines) > 1) {
299 $box_height += scalar(@lines) * ($text_attribs->{'font_size'} * 1.2);
300 $box_lly -= ($text_attribs->{'font_size'} * 0.2);
303 $box_height += $text_attribs->{'font_size'};
305 box
($origin_llx, $box_lly, $self->{'width'} - ( $text_attribs->{'llx'} * $self->{'unitvalue'} ), $box_height, $pdf);
307 $pdf->Font($text_attribs->{'font'});
308 $pdf->FontSize($text_attribs->{'font_size'});
309 foreach my $line (@lines) {
310 $pdf->Text($line->{'Tx'}, $line->{'Ty'}, $line->{'line'});
317 $patron_card->draw_image($pdf)
319 Draws images to PDF output ($pdf)
324 my ($self, $pdf) = @_;
325 warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
326 my $images = $self->{'layout'}->{'images'};
329 foreach my $image (keys %$images) {
330 next PROCESS_IMAGES
if $images->{$image}->{'data_source'}->[0]->{'image_source'} eq 'none';
331 my $Tx = $self->{'llx'} + $images->{$image}->{'Tx'} * $self->{'unitvalue'};
332 my $Ty = $self->{'lly'} + $images->{$image}->{'Ty'} * $self->{'unitvalue'};
333 warn sprintf('No image passed in.') and next if !$images->{$image}->{'data'};
334 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);
335 my $obj_stream = "q\n";
336 $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
337 $obj_stream .= "$images->{$image}->{'scale'} 0 0 $images->{$image}->{'scale'} 0 0 cm\n"; #scale to 20%
338 $obj_stream .= "/$intName Do\n";
339 $obj_stream .= "Q\n";
340 $pdf->Add($obj_stream);
346 $patron_card->draw_barcode($pdf)
348 Draws a barcode to PDF output ($pdf)
352 sub _draw_barcode
{ # this is cut-and-paste from Label.pm because there is no common place for it atm...
356 my $x_scale_factor = 1;
357 my $num_of_chars = length($params{'barcode_data'});
358 my $tot_bar_length = 0;
360 my $guard_length = 10;
361 if ($params{'barcode_type'} =~ m/CODE39/) {
362 $bar_length = '17.5';
363 $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
364 $x_scale_factor = ($params{'width'} / $tot_bar_length);
365 if ($params{'barcode_type'} eq 'CODE39MOD') {
366 my $c39 = CheckDigits
('code_39'); # get modulo 43 checksum
367 $params{'barcode_data'} = $c39->complete($params{'barcode_data'});
369 elsif ($params{'barcode_type'} eq 'CODE39MOD10') {
370 my $c39_10 = CheckDigits
('siret'); # get modulo 10 checksum
371 $params{'barcode_data'} = $c39_10->complete($params{'barcode_data'});
374 PDF
::Reuse
::Barcode
::Code39
(
375 x
=> $params{'llx'} * $self->{'unitvalue'},
376 y
=> $params{'lly'} * $self->{'unitvalue'},
377 value
=> "*$params{barcode_data}*",
378 xSize
=> $x_scale_factor,
379 ySize
=> $params{'y_scale_factor'},
381 text
=> $params{'text'},
386 warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@
);
389 elsif ($params{'barcode_type'} eq 'COOP2OF5') {
390 $bar_length = '9.43333333333333';
391 $tot_bar_length = ($bar_length * $num_of_chars) + ($guard_length * 2);
392 $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
394 PDF
::Reuse
::Barcode
::COOP2of5
(
395 x
=> $params{'llx'}* $self->{'unitvalue'},
396 y
=> $params{'lly'}* $self->{'unitvalue'},
397 value
=> $params{barcode_data
},
398 xSize
=> $x_scale_factor,
399 ySize
=> $params{'y_scale_factor'},
404 warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@
);
407 elsif ( $params{'barcode_type'} eq 'INDUSTRIAL2OF5' ) {
408 $bar_length = '13.1333333333333';
409 $tot_bar_length = ($bar_length * $num_of_chars) + ($guard_length * 2);
410 $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
412 PDF
::Reuse
::Barcode
::Industrial2of5
(
413 x
=> $params{'llx'}* $self->{'unitvalue'} ,
414 y
=> $params{'lly'}* $self->{'unitvalue'},
415 value
=> $params{barcode_data
},
416 xSize
=> $x_scale_factor,
417 ySize
=> $params{'y_scale_factor'},
422 warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@
);
432 Chris Nighswonger <cnighswonger AT foundations DOT edu>