C4/Patroncards/Patroncard.pm

   1 package 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
   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.
  11 #
  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.
  16 #
  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>.
  19
  20 use strict;
  21 use warnings;
  22
  23 use autouse 'Data::Dumper' => qw(Dumper);
  24 #use Font::TTFMetrics;
  25
  26 use C4::Creators::Lib qw( get_unit_values );
  27 use C4::Creators::PDF qw(StrWidth);
  28 use C4::Patroncards::Lib qw(
  29     box
  30     get_borrower_attributes
  31     leading
  32     text_alignment
  33 );
  34
  35 =head1 NAME
  36
  37 C4::Patroncards::Patroncard
  38
  39 =head1 SYNOPSIS
  40
  41     use C4::Patroncards::Patroncard;
  42
  43     # Please extend
  44
  45
  46 =head1 DESCRIPTION
  47
  48    This module allows you to ...
  49
  50 =head1 FUNCTIONS
  51
  52 =head2 new
  53
  54 =cut
  55
  56 sub new {
  57     my ($invocant, %params) = @_;
  58     my $type = ref($invocant) || $invocant;
  59
  60     my $units = get_unit_values();
  61     my $unitvalue = 1;
  62     my $unitdesc = '';
  63     foreach my $un (@$units){
  64         if ($un->{'type'} eq $params{'layout'}->{'units'}) {
  65             $unitvalue = $un->{'value'};
  66             $unitdesc = $un->{'desc'};
  67         }
  68     }
  69
  70     my $self = {
  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,
  84     };
  85     bless ($self, $type);
  86     return $self;
  87 }
  88
  89 =head2 draw_barcode
  90
  91 =cut
  92
  93 sub draw_barcode {
  94     my ( $self, $pdf ) = @_;
  95
  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;
 103     _draw_barcode(
 104         $self,
 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'},
 112     );
 113 }
 114
 115 =head2 draw_guide_box
 116
 117 =cut
 118
 119 sub draw_guide_box {
 120     my ($self, $pdf) = @_;
 121     warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
 122
 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);
 131 }
 132
 133 =head2 draw_guide_grid
 134
 135     $patron_card->draw_guide_grid($pdf)
 136
 137 Adds a grid to the PDF output ($pdf) to support layout design
 138
 139 =cut
 140
 141 sub draw_guide_grid {
 142     my ($self, $pdf) = @_;
 143     warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
 144
 145     # Set up the grid in user defined units.
 146     # Each 5th and 10th line get separate values
 147
 148     my $obj_stream = "q\n";   # save the graphic state
 149     my $x = $self->{'llx'};
 150     my $y = $self->{'lly'};
 151
 152     my $cnt = 0;
 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";
 162         } else {
 163             $obj_stream .= "0.0 0.0 1.0  RG\n";
 164             $obj_stream .= "0 w\n";
 165         }
 166         $cnt ++;
 167
 168         $obj_stream .= "$xx $y m\n";
 169         $obj_stream .= "$xx $yy l\n";
 170
 171         $obj_stream .= "s\n";
 172     }
 173
 174     $x = $self->{'llx'};
 175     $y = $self->{'lly'};
 176     $cnt = 0;
 177     for ( $y = $self->{'lly'}/$self->{'unitvalue'}; $y <= ($self->{'lly'} + $self->{'height'})/$self->{'unitvalue'}; $y++) {
 178
 179         my $xx = $x + $self->{'width'};
 180         my $yy = $y*$self->{'unitvalue'};
 181
 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";
 188         } else {
 189             $obj_stream .= "0.0 0.0 1.0  RG\n";
 190             $obj_stream .= "0 w\n";
 191         }
 192         $cnt ++;
 193
 194         $obj_stream .= "$x $yy m\n";
 195         $obj_stream .= "$xx $yy l\n";
 196         $obj_stream .= "s\n";
 197     }
 198
 199     $obj_stream .= "Q\n"; # restore the graphic state
 200     $pdf->Add($obj_stream);
 201
 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'});
 205     my $font_size = 6;
 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 );
 211 }
 212
 213 =head2 draw_text
 214
 215     $patron_card->draw_text($pdf)
 216
 217 Draws text to PDF output ($pdf)
 218
 219 =cut
 220
 221 sub draw_text {
 222     my ($self, $pdf, %params) = @_;
 223     warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
 224     my @card_text = ();
 225     return unless (ref($self->{'layout'}->{'text'}) eq 'ARRAY'); # just in case there is not text
 226
 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...
 233             my @fields = ();
 234             while ($parse_line =~ m/<([A-Za-z0-9_]+)>(.*$)/) {
 235                 push (@fields, $1);
 236                 $parse_line = $2;
 237             }
 238             my $borrower_attributes = get_borrower_attributes($self->{'borrower_number'},@fields);
 239             @orig_line = map { # substitute data for db fields
 240                 my $l = $_;
 241                 if ($l =~ m/<([A-Za-z0-9_]+)>/) {
 242                     my $field = $1;
 243                     $l =~ s/$l/$borrower_attributes->{$field}/;
 244                 }
 245                 $l;
 246             } @orig_line;
 247             $line = join(' ',@orig_line);
 248         }
 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;
 254
 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
 261         my $trim = '';
 262         my @lines = ();
 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
 266 #
 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'} ) {
 274             my $cur_line = "";
 275         WRAP_LINES:
 276             while (1) {
 277
 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&|\<.*\>)$/;
 280                 $trim = $1 . $trim;
 281
 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$//;
 284                 $string_width =
 285                     C4::Creators::PDF->StrWidth( $line, $text_attribs->{'font'}, $text_attribs->{'font_size'} );
 286
 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'}
 293                     );
 294                     push @lines, { line => $line, Tx => $Tx, Ty => $Ty, Tw => $Tw };
 295                     $line = undef;
 296                     last WRAP_LINES if $trim eq '';
 297                     $Ty -= leading( $text_attribs->{'font_size'} );
 298                     $line = $trim;
 299                     $trim = '';
 300                     $string_width =
 301                         C4::Creators::PDF->StrWidth( $line, $text_attribs->{'font'}, $text_attribs->{'font_size'} );
 302
 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'}
 310                         );
 311                         $line =~ s/^\s+//g;     # strip naughty leading spaces
 312                         push @lines, {line=> $line, Tx => $Tx, Ty => $Ty, Tw => $Tw};
 313                         last WRAP_LINES;
 314                     }
 315                 } else {
 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;
 320                     $cur_line = $line;
 321                 }
 322             }
 323         }
 324         else {
 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};
 328         }
 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.
 332         if (0) {
 333             my $box_height = 0;
 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);
 338             }
 339             else {
 340                 $box_height += $text_attribs->{'font_size'};
 341             }
 342             box ($origin_llx, $box_lly, $self->{'width'} - ( $text_attribs->{'llx'} * $self->{'unitvalue'} ), $box_height, $pdf);
 343         }
 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'});
 348         }
 349     }
 350 }
 351
 352 =head2 draw_image
 353
 354     $patron_card->draw_image($pdf)
 355
 356 Draws images to PDF output ($pdf)
 357
 358 =cut
 359
 360 sub draw_image {
 361     my ($self, $pdf) = @_;
 362     warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
 363     my $images = $self->{'layout'}->{'images'};
 364
 365     PROCESS_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);
 378     }
 379 }
 380
 381 =head2 draw_barcode
 382
 383     $patron_card->draw_barcode($pdf)
 384
 385 Draws a barcode to PDF output ($pdf)
 386
 387 =cut
 388
 389 sub _draw_barcode {   # this is cut-and-paste from Label.pm because there is no common place for it atm...
 390     my $self = shift;
 391     my %params = @_;
 392
 393     my $x_scale_factor = 1;
 394     my $num_of_chars = length($params{'barcode_data'});
 395     my $tot_bar_length = 0;
 396     my $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'});
 405         }
 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'});
 409         }
 410         eval {
 411             PDF::Reuse::Barcode::Code39(
 412                 x                   => $params{'llx'},
 413                 y                   => $params{'lly'},
 414                 value               => "*$params{barcode_data}*",
 415                 xSize               => $x_scale_factor,
 416                 ySize               => $params{'y_scale_factor'},
 417                 hide_asterisk       => 1,
 418                 text                => $params{'text'},
 419                 mode                => 'graphic',
 420             );
 421         };
 422         if ($@) {
 423             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
 424         }
 425     }
 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;
 430         eval {
 431             PDF::Reuse::Barcode::COOP2of5(
 432                 x                   => $params{'llx'},
 433                 y                   => $params{'lly'},
 434                 value               => $params{barcode_data},
 435                 xSize               => $x_scale_factor,
 436                 ySize               => $params{'y_scale_factor'},
 437                 mode                    => 'graphic',
 438             );
 439         };
 440         if ($@) {
 441             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
 442         }
 443     }
 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;
 448         eval {
 449             PDF::Reuse::Barcode::Industrial2of5(
 450                 x                   => $params{'llx'},
 451                 y                   => $params{'lly'},
 452                 value               => $params{barcode_data},
 453                 xSize               => $x_scale_factor,
 454                 ySize               => $params{'y_scale_factor'},
 455                 mode                    => 'graphic',
 456             );
 457         };
 458         if ($@) {
 459             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
 460         }
 461     }
 462 }
 463
 464 1;
 465 __END__
 466
 467 =head1 AUTHOR
 468
 469 Chris Nighswonger <cnighswonger AT foundations DOT edu>
 470
 471 =cut