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 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 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);
  28 use C4::Creators::PDF qw(StrWidth);
  29 use C4::Patroncards::Lib qw(unpack_UTF8 text_alignment leading box get_borrower_attributes);
  30
  31 BEGIN {
  32     use version; our $VERSION = qv('3.07.00.049');
  33 }
  34
  35 sub new {
  36     my ($invocant, %params) = @_;
  37     my $type = ref($invocant) || $invocant;
  38     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     bless ($self, $type);
  50     return $self;
  51 }
  52
  53 sub draw_barcode {
  54     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     my $barcode_width = 0.8 * $self->{'width'};                         # this scales the barcode width to 80% of the label width
  57     my $barcode_y_scale_factor = 0.01 * $self->{'height'};              # this scales the barcode height to 1% of the label height
  58     _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
  69 sub draw_guide_box {
  70     my ($self, $pdf) = @_;
  71     warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
  72     my $obj_stream = "q\n";                            # save the graphic state
  73     $obj_stream .= "0.5 w\n";                          # border line width
  74     $obj_stream .= "1.0 0.0 0.0  RG\n";                # border color red
  75     $obj_stream .= "1.0 1.0 1.0  rg\n";                # fill color white
  76     $obj_stream .= "$self->{'llx'} $self->{'lly'} $self->{'width'} $self->{'height'} re\n";    # a rectangle
  77     $obj_stream .= "B\n";                              # fill (and a little more)
  78     $obj_stream .= "Q\n";                              # restore the graphic state
  79     $pdf->Add($obj_stream);
  80 }
  81
  82 sub draw_text {
  83     my ($self, $pdf, %params) = @_;
  84     warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
  85     my @card_text = ();
  86     return unless (ref($self->{'layout'}->{'text'}) eq 'ARRAY'); # just in case there is not text
  87     my $text = [@{$self->{'layout'}->{'text'}}]; # make a copy of the arrayref *not* simply a pointer
  88     while (scalar @$text) {
  89         my $line = shift @$text;
  90         my $parse_line = $line;
  91         my @orig_line = split(/ /,$line);
  92         if ($parse_line =~ m/<[A-Za-z0-9]+>/) {     # test to see if the line has db fields embedded...
  93             my @fields = ();
  94             while ($parse_line =~ m/<([A-Za-z0-9]+)>(.*$)/) {
  95                 push (@fields, $1);
  96                 $parse_line = $2;
  97             }
  98             my $borrower_attributes = get_borrower_attributes($self->{'borrower_number'},@fields);
  99             grep{ # substitute data for db fields
 100                 if ($_ =~ m/<([A-Za-z0-9]+)>/) {
 101                     my $field = $1;
 102                     $_ =~ s/$_/$borrower_attributes->{$field}/;
 103                 }
 104             } @orig_line;
 105             $line = join(' ',@orig_line);
 106         }
 107         my $text_attribs = shift @$text;
 108         my $origin_llx = $self->{'llx'} + $text_attribs->{'llx'};
 109         my $origin_lly = $self->{'lly'} + $text_attribs->{'lly'};
 110         my $Tx = 0;     # final text llx
 111         my $Ty = $origin_lly;   # final text lly
 112         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         my $trim = '';
 115         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         my $string_width = C4::Creators::PDF->StrWidth($line, $text_attribs->{'font'}, $text_attribs->{'font_size'});
 125         if (($string_width + $text_attribs->{'llx'}) > $self->{'width'}) {
 126             WRAP_LINES:
 127             while (1) {
 128 #                $line =~ m/^.*(\s\b.*\b\s*|\s&|\<\b.*\b\>)$/; # original regexp... can be removed after dev stage is over
 129                 $line =~ m/^.*(\s.*\s*|\s&|\<.*\>)$/;
 130                 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                 $trim = $1 . $trim;
 132                 $line =~ s/$1//;
 133                 $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                 if (($string_width + $text_attribs->{'llx'}) < $self->{'width'}) {
 137                     ($Tx, $Tw) = text_alignment($origin_llx, $self->{'width'}, $text_attribs->{'llx'}, $string_width, $line, $text_attribs->{'text_alignment'});
 138                     push @lines, {line=> $line, Tx => $Tx, Ty => $Ty, Tw => $Tw};
 139                     $line = undef;
 140                     last WRAP_LINES if $trim eq '';
 141                     $Ty -= leading($text_attribs->{'font_size'});
 142                     $line = $trim;
 143                     $trim = '';
 144                     $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                     if (($string_width + $text_attribs->{'llx'}) < $self->{'width'}) {
 148                         ($Tx, $Tw) = text_alignment($origin_llx, $self->{'width'}, $text_attribs->{'llx'}, $string_width, $line, $text_attribs->{'text_alignment'});
 149                         $line =~ s/^\s+//g;     # strip naughty leading spaces
 150                         push @lines, {line=> $line, Tx => $Tx, Ty => $Ty, Tw => $Tw};
 151                         last WRAP_LINES;
 152                     }
 153                 }
 154             }
 155         }
 156         else {
 157             ($Tx, $Tw) = text_alignment($origin_llx, $self->{'width'}, $text_attribs->{'llx'}, $string_width, $line, $text_attribs->{'text_alignment'});
 158             $line =~ s/^\s+//g;     # strip naughty leading spaces
 159             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         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         my $font_resource = $pdf->Font($text_attribs->{'font'});
 179         foreach my $line (@lines) {
 180 #            $pdf->Text($line->{'Tx'}, $line->{'Ty'}, $line->{'line'});
 181             my $text_line = "BT /$font_resource $text_attribs->{'font_size'} Tf $line->{'Tx'} $line->{'Ty'} Td $line->{'Tw'} Tw ($line->{'line'}) Tj ET";
 182             $pdf->Add($text_line);
 183         }
 184     }
 185 }
 186
 187 sub draw_image {
 188     my ($self, $pdf) = @_;
 189     warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
 190     my $images = $self->{'layout'}->{'images'};
 191     PROCESS_IMAGES:
 192     foreach my $image (keys %$images) {
 193         next PROCESS_IMAGES if $images->{$image}->{'data_source'}->[0]->{'image_source'} eq 'none';
 194         my $Tx = $self->{'llx'} + $images->{$image}->{'Tx'};
 195         my $Ty = $self->{'lly'} + $images->{$image}->{'Ty'};
 196         warn sprintf('No image passed in.') and next if !$images->{$image}->{'data'};
 197         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         my $obj_stream = "q\n";
 199         $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         $obj_stream .= "/$intName Do\n";
 201         $obj_stream .= "Q\n";
 202         $pdf->Add($obj_stream);
 203     }
 204 }
 205
 206 sub _draw_barcode {   # this is cut-and-paste from Label.pm because there is no common place for it atm...
 207     my $self = shift;
 208     my %params = @_;
 209     my $x_scale_factor = 1;
 210     my $num_of_chars = length($params{'barcode_data'});
 211     my $tot_bar_length = 0;
 212     my $bar_length = 0;
 213     my $guard_length = 10;
 214     if ($params{'barcode_type'} =~ m/CODE39/) {
 215         $bar_length = '17.5';
 216         $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         $x_scale_factor = ($params{'width'} / $tot_bar_length);
 218         if ($params{'barcode_type'} eq 'CODE39MOD') {
 219             my $c39 = CheckDigits('code_39');   # get modulo 43 checksum
 220             $params{'barcode_data'} = $c39->complete($params{'barcode_data'});
 221         }
 222         elsif ($params{'barcode_type'} eq 'CODE39MOD10') {
 223             my $c39_10 = CheckDigits('siret');   # get modulo 10 checksum
 224             $params{'barcode_data'} = $c39_10->complete($params{'barcode_data'});
 225         }
 226         eval {
 227             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         if ($@) {
 239             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         $bar_length = '9.43333333333333';
 244         $tot_bar_length = ($bar_length * $num_of_chars) + ($guard_length * 2);
 245         $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
 246         eval {
 247             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         if ($@) {
 257             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         $bar_length = '13.1333333333333';
 262         $tot_bar_length = ($bar_length * $num_of_chars) + ($guard_length * 2);
 263         $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
 264         eval {
 265             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         if ($@) {
 275             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
 276         }
 277     }
 278 }
 279
 280 1;
 281 __END__
 282
 283 =head1 AUTHOR
 284
 285 Chris Nighswonger <cnighswonger AT foundations DOT edu>
 286
 287 =cut
 288
 289
 290