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 Text::Wrap qw(wrap);
  25 #use Font::TTFMetrics;
  26
  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);
  30
  31 =head1 NAME
  32
  33 C4::Patroncards::Patroncard
  34
  35 =head1 SYNOPSIS
  36
  37     use C4::Patroncards::Patroncard;
  38
  39     # Please extend
  40
  41
  42 =head1 DESCRIPTION
  43
  44    This module allows you to ...
  45
  46 =head1 FUNCTIONS
  47
  48 =head2 new
  49
  50 =cut
  51
  52 sub new {
  53     my ($invocant, %params) = @_;
  54     my $type = ref($invocant) || $invocant;
  55
  56     my $units = get_unit_values();
  57     my $unitvalue = 1;
  58     my $unitdesc = '';
  59     foreach my $un (@$units){
  60         if ($un->{'type'} eq $params{'layout'}->{'units'}) {
  61             $unitvalue = $un->{'value'};
  62             $unitdesc = $un->{'desc'};
  63         }
  64     }
  65
  66     my $self = {
  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,
  80     };
  81     bless ($self, $type);
  82     return $self;
  83 }
  84
  85 =head2 draw_barcode
  86
  87 =cut
  88
  89 sub draw_barcode {
  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'};
  94
  95     _draw_barcode(      $self,
  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'},
 103     );
 104 }
 105
 106 =head2 draw_guide_box
 107
 108 =cut
 109
 110 sub draw_guide_box {
 111     my ($self, $pdf) = @_;
 112     warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
 113
 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);
 122 }
 123
 124 =head2 draw_guide_grid
 125
 126     $patron_card->draw_guide_grid($pdf)
 127
 128 Adds a grid to the PDF output ($pdf) to support layout design
 129
 130 =cut
 131
 132 sub draw_guide_grid {
 133     my ($self, $pdf) = @_;
 134     warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
 135
 136     # Set up the grid in user defined units.
 137     # Each 5th and 10th line get separate values
 138
 139     my $obj_stream = "q\n";   # save the graphic state
 140     my $x = $self->{'llx'};
 141     my $y = $self->{'lly'};
 142
 143     my $cnt = 0;
 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";
 153         } else {
 154             $obj_stream .= "0.0 0.0 1.0  RG\n";
 155             $obj_stream .= "0 w\n";
 156         }
 157         $cnt ++;
 158
 159         $obj_stream .= "$xx $y m\n";
 160         $obj_stream .= "$xx $yy l\n";
 161
 162         $obj_stream .= "s\n";
 163     }
 164
 165     $x = $self->{'llx'};
 166     $y = $self->{'lly'};
 167     $cnt = 0;
 168     for ( $y = $self->{'lly'}/$self->{'unitvalue'}; $y <= ($self->{'lly'} + $self->{'height'})/$self->{'unitvalue'}; $y++) {
 169
 170         my $xx = $x + $self->{'width'};
 171         my $yy = $y*$self->{'unitvalue'};
 172
 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";
 179         } else {
 180             $obj_stream .= "0.0 0.0 1.0  RG\n";
 181             $obj_stream .= "0 w\n";
 182         }
 183         $cnt ++;
 184
 185         $obj_stream .= "$x $yy m\n";
 186         $obj_stream .= "$xx $yy l\n";
 187         $obj_stream .= "s\n";
 188     }
 189
 190     $obj_stream .= "Q\n"; # restore the graphic state
 191     $pdf->Add($obj_stream);
 192
 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'});
 196     my $font_size = 6;
 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 );
 202 }
 203
 204 =head2 draw_text
 205
 206     $patron_card->draw_text($pdf)
 207
 208 Draws text to PDF output ($pdf)
 209
 210 =cut
 211
 212 sub draw_text {
 213     my ($self, $pdf, %params) = @_;
 214     warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
 215     my @card_text = ();
 216     return unless (ref($self->{'layout'}->{'text'}) eq 'ARRAY'); # just in case there is not text
 217
 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...
 224             my @fields = ();
 225             while ($parse_line =~ m/<([A-Za-z0-9_]+)>(.*$)/) {
 226                 push (@fields, $1);
 227                 $parse_line = $2;
 228             }
 229             my $borrower_attributes = get_borrower_attributes($self->{'borrower_number'},@fields);
 230             @orig_line = map { # substitute data for db fields
 231                 my $l = $_;
 232                 if ($l =~ m/<([A-Za-z0-9_]+)>/) {
 233                     my $field = $1;
 234                     $l =~ s/$l/$borrower_attributes->{$field}/;
 235                 }
 236                 $l;
 237             } @orig_line;
 238             $line = join(' ',@orig_line);
 239         }
 240         my $text_attribs = shift @$text;
 241         my $origin_llx = $self->{'llx'} + $text_attribs->{'llx'} * $self->{'unitvalue'};
 242         my $origin_lly = $self->{'lly'} + $text_attribs->{'lly'} * $self->{'unitvalue'};
 243         my $Tx = 0;     # final text llx
 244         my $Ty = $origin_lly;   # final text lly
 245         my $Tw = 0;     # final text word spacing. See http://www.adobe.com/devnet/pdf/pdf_reference.html ISO 32000-1
 246 #FIXME: Move line wrapping code to its own sub if possible
 247         my $trim = '';
 248         my @lines = ();
 249 #FIXME: Using embedded True Type fonts is a far superior way of handing things as well as being much more unicode friendly.
 250 #       However this will take significant work using better than PDF::Reuse to do it. For the time being, I'm leaving
 251 #       the basic code here commented out to preserve the basic method of accomplishing this. -chris_n
 252 #
 253 #        my $m = Font::TTFMetrics->new("/usr/share/fonts/truetype/msttcorefonts/Times_New_Roman_Bold.ttf");
 254 #        my $units_per_em =  $m->get_units_per_em();
 255 #        my $font_units_width = $m->string_width($line);
 256 #        my $string_width = ($font_units_width * $text_attribs->{'font_size'}) / $units_per_em;
 257         my $string_width = C4::Creators::PDF->StrWidth($line, $text_attribs->{'font'}, $text_attribs->{'font_size'});
 258         if (($string_width + $text_attribs->{'llx'}) > $self->{'width'}) {
 259             WRAP_LINES:
 260             while (1) {
 261 #                $line =~ m/^.*(\s\b.*\b\s*|\s&|\<\b.*\b\>)$/; # original regexp... can be removed after dev stage is over
 262                 $line =~ m/^.*(\s.*\s*|\s&|\<.*\>)$/;
 263                 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                 $trim = $1 . $trim;
 265                 #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)
 266                 $line =~ s/\Q$1\E$//;
 267                 $string_width = C4::Creators::PDF->StrWidth($line, $text_attribs->{'font'}, $text_attribs->{'font_size'});
 268 #                $font_units_width = $m->string_width($line);
 269 #                $string_width = ($font_units_width * $text_attribs->{'font_size'}) / $units_per_em;
 270                 if (($string_width + $text_attribs->{'llx'}) < $self->{'width'}) {
 271                     ($Tx, $Tw) = text_alignment($origin_llx, $self->{'width'}, $text_attribs->{'llx'}, $string_width, $line, $text_attribs->{'text_alignment'});
 272                     push @lines, {line=> $line, Tx => $Tx, Ty => $Ty, Tw => $Tw};
 273                     $line = undef;
 274                     last WRAP_LINES if $trim eq '';
 275                     $Ty -= leading($text_attribs->{'font_size'});
 276                     $line = $trim;
 277                     $trim = '';
 278                     $string_width = C4::Creators::PDF->StrWidth($line, $text_attribs->{'font'}, $text_attribs->{'font_size'});
 279                     #$font_units_width = $m->string_width($line);
 280                     #$string_width = ($font_units_width * $text_attribs->{'font_size'}) / $units_per_em;
 281                     if ( $string_width + ( $text_attribs->{'llx'} * $self->{'unitvalue'} ) < $self->{'width'}) {
 282                         ($Tx, $Tw) = text_alignment($origin_llx, $self->{'width'}, $text_attribs->{'llx'} * $self->{'unitvalue'}, $string_width, $line, $text_attribs->{'text_alignment'});
 283                         $line =~ s/^\s+//g;     # strip naughty leading spaces
 284                         push @lines, {line=> $line, Tx => $Tx, Ty => $Ty, Tw => $Tw};
 285                         last WRAP_LINES;
 286                     }
 287                 }
 288             }
 289         }
 290         else {
 291             ($Tx, $Tw) = text_alignment($origin_llx, $self->{'width'}, $text_attribs->{'llx'} * $self->{'unitvalue'}, $string_width, $line, $text_attribs->{'text_alignment'});
 292             $line =~ s/^\s+//g;     # strip naughty leading spaces
 293             push @lines, {line=> $line, Tx => $Tx, Ty => $Ty, Tw => $Tw};
 294         }
 295 # Draw boxes around text box areas
 296 # 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.
 297 #        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.
 298         if (0) {
 299             my $box_height = 0;
 300             my $box_lly = $origin_lly;
 301             if (scalar(@lines) > 1) {
 302                 $box_height += scalar(@lines) * ($text_attribs->{'font_size'} * 1.2);
 303                 $box_lly -= ($text_attribs->{'font_size'} * 0.2);
 304             }
 305             else {
 306                 $box_height += $text_attribs->{'font_size'};
 307             }
 308             box ($origin_llx, $box_lly, $self->{'width'} - ( $text_attribs->{'llx'} * $self->{'unitvalue'} ), $box_height, $pdf);
 309         }
 310         $pdf->Font($text_attribs->{'font'});
 311         $pdf->FontSize($text_attribs->{'font_size'});
 312         foreach my $line (@lines) {
 313             $pdf->Text($line->{'Tx'}, $line->{'Ty'}, $line->{'line'});
 314         }
 315     }
 316 }
 317
 318 =head2 draw_image
 319
 320     $patron_card->draw_image($pdf)
 321
 322 Draws images to PDF output ($pdf)
 323
 324 =cut
 325
 326 sub draw_image {
 327     my ($self, $pdf) = @_;
 328     warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
 329     my $images = $self->{'layout'}->{'images'};
 330
 331     PROCESS_IMAGES:
 332     foreach my $image (keys %$images) {
 333         next PROCESS_IMAGES if $images->{$image}->{'data_source'}->[0]->{'image_source'} eq 'none';
 334         my $Tx = $self->{'llx'} + $images->{$image}->{'Tx'} * $self->{'unitvalue'};
 335         my $Ty = $self->{'lly'} + $images->{$image}->{'Ty'} * $self->{'unitvalue'};
 336         warn sprintf('No image passed in.') and next if !$images->{$image}->{'data'};
 337         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);
 338         my $obj_stream = "q\n";
 339         $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
 340         $obj_stream .= "$images->{$image}->{'scale'} 0 0 $images->{$image}->{'scale'} 0 0 cm\n"; #scale to 20%
 341         $obj_stream .= "/$intName Do\n";
 342         $obj_stream .= "Q\n";
 343         $pdf->Add($obj_stream);
 344     }
 345 }
 346
 347 =head2 draw_barcode
 348
 349     $patron_card->draw_barcode($pdf)
 350
 351 Draws a barcode to PDF output ($pdf)
 352
 353 =cut
 354
 355 sub _draw_barcode {   # this is cut-and-paste from Label.pm because there is no common place for it atm...
 356     my $self = shift;
 357     my %params = @_;
 358
 359     my $x_scale_factor = 1;
 360     my $num_of_chars = length($params{'barcode_data'});
 361     my $tot_bar_length = 0;
 362     my $bar_length = 0;
 363     my $guard_length = 10;
 364     if ($params{'barcode_type'} =~ m/CODE39/) {
 365         $bar_length = '17.5';
 366         $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
 367         $x_scale_factor = ($params{'width'} / $tot_bar_length);
 368         if ($params{'barcode_type'} eq 'CODE39MOD') {
 369             my $c39 = CheckDigits('code_39');   # get modulo 43 checksum
 370             $params{'barcode_data'} = $c39->complete($params{'barcode_data'});
 371         }
 372         elsif ($params{'barcode_type'} eq 'CODE39MOD10') {
 373             my $c39_10 = CheckDigits('siret');   # get modulo 10 checksum
 374             $params{'barcode_data'} = $c39_10->complete($params{'barcode_data'});
 375         }
 376         eval {
 377             PDF::Reuse::Barcode::Code39(
 378                 x                   => $params{'llx'} * $self->{'unitvalue'},
 379                 y                   => $params{'lly'} * $self->{'unitvalue'},
 380                 value               => "*$params{barcode_data}*",
 381                 xSize               => $x_scale_factor,
 382                 ySize               => $params{'y_scale_factor'},
 383                 hide_asterisk       => 1,
 384                 text                => $params{'text'},
 385                 mode                => 'graphic',
 386             );
 387         };
 388         if ($@) {
 389             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
 390         }
 391     }
 392     elsif ($params{'barcode_type'} eq 'COOP2OF5') {
 393         $bar_length = '9.43333333333333';
 394         $tot_bar_length = ($bar_length * $num_of_chars) + ($guard_length * 2);
 395         $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
 396         eval {
 397             PDF::Reuse::Barcode::COOP2of5(
 398                 x                   => $params{'llx'}* $self->{'unitvalue'},
 399                 y                   => $params{'lly'}* $self->{'unitvalue'},
 400                 value               => $params{barcode_data},
 401                 xSize               => $x_scale_factor,
 402                 ySize               => $params{'y_scale_factor'},
 403                 mode                    => 'graphic',
 404             );
 405         };
 406         if ($@) {
 407             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
 408         }
 409     }
 410     elsif ( $params{'barcode_type'} eq 'INDUSTRIAL2OF5' ) {
 411         $bar_length = '13.1333333333333';
 412         $tot_bar_length = ($bar_length * $num_of_chars) + ($guard_length * 2);
 413         $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
 414         eval {
 415             PDF::Reuse::Barcode::Industrial2of5(
 416                 x                   => $params{'llx'}* $self->{'unitvalue'} ,
 417                 y                   => $params{'lly'}* $self->{'unitvalue'},
 418                 value               => $params{barcode_data},
 419                 xSize               => $x_scale_factor,
 420                 ySize               => $params{'y_scale_factor'},
 421                 mode                    => 'graphic',
 422             );
 423         };
 424         if ($@) {
 425             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
 426         }
 427     }
 428 }
 429
 430 1;
 431 __END__
 432
 433 =head1 AUTHOR
 434
 435 Chris Nighswonger <cnighswonger AT foundations DOT edu>
 436
 437 =cut