From 347848ede3c453625783ffaddd43372814ec1a1c Mon Sep 17 00:00:00 2001 From: Chris Nighswonger Date: Mon, 11 Jan 2010 16:34:22 -0500 Subject: [PATCH] [1/30] C4::Patroncards::Patroncard Module A module for creating patron card objects and manipulating them. --- C4/Patroncards/Patroncard.pm | 290 +++++++++++++++++++++++++++++++++++ 1 file changed, 290 insertions(+) create mode 100644 C4/Patroncards/Patroncard.pm diff --git a/C4/Patroncards/Patroncard.pm b/C4/Patroncards/Patroncard.pm new file mode 100644 index 0000000000..8aef3cd3cb --- /dev/null +++ b/C4/Patroncards/Patroncard.pm @@ -0,0 +1,290 @@ +package C4::Patroncards::Patroncard; + +# Copyright 2009 Foundations Bible College. +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along with +# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +use strict; +use warnings; + +use autouse 'Data::Dumper' => qw(Dumper); +use Text::Wrap qw(wrap); +#use Font::TTFMetrics; + +use C4::Creators::Lib 1.000000 qw(get_font_types); +use C4::Creators::PDF 1.000000 qw(StrWidth); +use C4::Patroncards::Lib 1.000000 qw(unpack_UTF8 text_alignment leading box get_borrower_attributes); + +BEGIN { + use version; our $VERSION = qv('1.0.0_1'); +} + +sub new { + my ($invocant, %params) = @_; + my $type = ref($invocant) || $invocant; + my $self = { + batch_id => $params{'batch_id'}, + #card_number => $params{'card_number'}, + borrower_number => $params{'borrower_number'}, + llx => $params{'llx'}, + lly => $params{'lly'}, + height => $params{'height'}, + width => $params{'width'}, + layout => $params{'layout'}, + text_wrap_cols => $params{'text_wrap_cols'}, + }; + bless ($self, $type); + return $self; +} + +sub draw_barcode { + my ($self, $pdf) = @_; +#FIXME: We do some scaling foo on the barcode here which probably should be done by the one invoking draw_barcode + my $barcode_width = 0.8 * $self->{'width'}; # this scales the barcode width to 80% of the label width + my $barcode_y_scale_factor = 0.01 * $self->{'height'}; # this scales the barcode height to 1% of the label height + _draw_barcode( $self, + llx => $self->{'llx'} + $self->{'layout'}->{'barcode'}->{'llx'}, + lly => $self->{'lly'} + $self->{'layout'}->{'barcode'}->{'lly'}, + width => $barcode_width, + y_scale_factor => $barcode_y_scale_factor, + barcode_type => $self->{'layout'}->{'barcode'}->{'type'}, + barcode_data => $self->{'layout'}->{'barcode'}->{'data'}, + text => $self->{'layout'}->{'barcode'}->{'text_print'}, + ); +} + +sub draw_guide_box { + my ($self, $pdf) = @_; + warn sprintf('No pdf object passed in.') and return -1 if !$pdf; + my $obj_stream = "q\n"; # save the graphic state + $obj_stream .= "0.5 w\n"; # border line width + $obj_stream .= "1.0 0.0 0.0 RG\n"; # border color red + $obj_stream .= "1.0 1.0 1.0 rg\n"; # fill color white + $obj_stream .= "$self->{'llx'} $self->{'lly'} $self->{'width'} $self->{'height'} re\n"; # a rectangle + $obj_stream .= "B\n"; # fill (and a little more) + $obj_stream .= "Q\n"; # restore the graphic state + $pdf->Add($obj_stream); +} + +sub draw_text { + my ($self, $pdf, %params) = @_; + warn sprintf('No pdf object passed in.') and return -1 if !$pdf; + my @card_text = (); + my $text = $self->{'layout'}->{'text'}; + return unless (ref($text) eq 'ARRAY'); # just in case there is not text + while (scalar @$text) { + my $line = shift @$text; + my $parse_line = $line; + my @orig_line = split(/ /,$line); + if ($parse_line =~ m/<[A-Za-z0-9]+>/) { # test to see if the line has db fields embedded... + my @fields = (); + while ($parse_line =~ m/<([A-Za-z0-9]+)>(.*$)/) { + push (@fields, $1); + $parse_line = $2; + } + my $borrower_attributes = get_borrower_attributes($self->{'borrower_number'},@fields); + grep{ # substitute data for db fields + if ($_ =~ m/<([A-Za-z0-9]+)>/) { + my $field = $1; + $_ =~ s/$_/$borrower_attributes->{$field}/; + } + } @orig_line; + $line = join(' ',@orig_line); + } + my $text_attribs = shift @$text; + my $origin_llx = $self->{'llx'} + $text_attribs->{'llx'}; + my $origin_lly = $self->{'lly'} + $text_attribs->{'lly'}; + my $Tx = 0; # final text llx + my $Ty = $origin_lly; # final text lly + my $Tw = 0; # final text word spacing. See http://www.adobe.com/devnet/pdf/pdf_reference.html ISO 32000-1 +#FIXME: Move line wrapping code to its own sub if possible + my $trim = ''; + my @lines = (); +#FIXME: Using embedded True Type fonts is a far superior way of handing things as well as being much more unicode friendly. +# However this will take significant work using better than PDF::Reuse to do it. For the time being, I'm leaving +# the basic code here commented out to preserve the basic method of accomplishing this. -chris_n +# +# my $m = Font::TTFMetrics->new("/usr/share/fonts/truetype/msttcorefonts/Times_New_Roman_Bold.ttf"); +# my $units_per_em = $m->get_units_per_em(); +# my $font_units_width = $m->string_width($line); +# my $string_width = ($font_units_width * $text_attribs->{'font_size'}) / $units_per_em; + my $string_width = C4::Creators::PDF->StrWidth($line, $text_attribs->{'font'}, $text_attribs->{'font_size'}); + if (($string_width + $text_attribs->{'llx'}) > $self->{'width'}) { + WRAP_LINES: + while (1) { +# $line =~ m/^.*(\s\b.*\b\s*|\s&|\<\b.*\b\>)$/; # original regexp... can be removed after dev stage is over + $line =~ m/^.*(\s.*\s*|\s&|\<.*\>)$/; + 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.org', $line) and last WRAP_LINES if !$1; + $trim = $1 . $trim; + $line =~ s/$1//; + $string_width = C4::Creators::PDF->StrWidth($line, $text_attribs->{'font'}, $text_attribs->{'font_size'}); +# $font_units_width = $m->string_width($line); +# $string_width = ($font_units_width * $text_attribs->{'font_size'}) / $units_per_em; + if (($string_width + $text_attribs->{'llx'}) < $self->{'width'}) { + ($Tx, $Tw) = text_alignment($origin_llx, $self->{'width'}, $text_attribs->{'llx'}, $string_width, $line, $text_attribs->{'text_alignment'}); + push @lines, {line=> $line, Tx => $Tx, Ty => $Ty, Tw => $Tw}; + $line = undef; + last WRAP_LINES if $trim eq ''; + $Ty -= leading($text_attribs->{'font_size'}); + $line = $trim; + $trim = ''; + $string_width = C4::Creators::PDF->StrWidth($line, $text_attribs->{'font'}, $text_attribs->{'font_size'}); + #$font_units_width = $m->string_width($line); + #$string_width = ($font_units_width * $text_attribs->{'font_size'}) / $units_per_em; + if (($string_width + $text_attribs->{'llx'}) < $self->{'width'}) { + ($Tx, $Tw) = text_alignment($origin_llx, $self->{'width'}, $text_attribs->{'llx'}, $string_width, $line, $text_attribs->{'text_alignment'}); + $line =~ s/^\s+//g; # strip naughty leading spaces + push @lines, {line=> $line, Tx => $Tx, Ty => $Ty, Tw => $Tw}; + last WRAP_LINES; + } + } + } + } + else { + ($Tx, $Tw) = text_alignment($origin_llx, $self->{'width'}, $text_attribs->{'llx'}, $string_width, $line, $text_attribs->{'text_alignment'}); + $line =~ s/^\s+//g; # strip naughty leading spaces + push @lines, {line=> $line, Tx => $Tx, Ty => $Ty, Tw => $Tw}; + } +# Draw boxes around text box areas +# 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. +# 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. + if (0) { + my $box_height = 0; + my $box_lly = $origin_lly; + if (scalar(@lines) > 1) { + $box_height += scalar(@lines) * ($text_attribs->{'font_size'} * 1.2); + $box_lly -= ($text_attribs->{'font_size'} * 0.2); + } + else { + $box_height += $text_attribs->{'font_size'}; + } + box ($origin_llx, $box_lly, $self->{'width'} - $text_attribs->{'llx'}, $box_height, $pdf); + } +# my $font_resource = $pdf->TTFont("/usr/share/fonts/truetype/msttcorefonts/Times_New_Roman_Bold.ttf"); +# $pdf->FontSize($text_attribs->{'font_size'}); + my $font_resource = $pdf->Font($text_attribs->{'font'}); + foreach my $line (@lines) { +# $pdf->Text($line->{'Tx'}, $line->{'Ty'}, $line->{'line'}); + my $text_line = "BT /$font_resource $text_attribs->{'font_size'} Tf $line->{'Tx'} $line->{'Ty'} Td $line->{'Tw'} Tw ($line->{'line'}) Tj ET"; + $pdf->Add($text_line); + } + } +} + +sub draw_image { + my ($self, $pdf) = @_; + warn sprintf('No pdf object passed in.') and return -1 if !$pdf; + my $images = $self->{'layout'}->{'images'}; + PROCESS_IMAGES: + foreach my $image (keys %$images) { + next PROCESS_IMAGES if $images->{$image}->{'data_source'}->{'image_source'} eq 'none'; + my $Tx = $self->{'llx'} + $images->{$image}->{'Tx'}; + my $Ty = $self->{'lly'} + $images->{$image}->{'Ty'}; + warn sprintf('No image passed in.') and next if !$images->{$image}->{'data'}; + 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); + my $obj_stream = "q\n"; + $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 + $obj_stream .= "/$intName Do\n"; + $obj_stream .= "Q\n"; + $pdf->Add($obj_stream); + } +} + +sub _draw_barcode { # this is cut-and-paste from Label.pm because there is no common place for it atm... + my $self = shift; + my %params = @_; + my $x_scale_factor = 1; + my $num_of_chars = length($params{'barcode_data'}); + my $tot_bar_length = 0; + my $bar_length = 0; + my $guard_length = 10; + if ($params{'barcode_type'} =~ m/CODE39/) { + $bar_length = '17.5'; + $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 + $x_scale_factor = ($params{'width'} / $tot_bar_length); + if ($params{'barcode_type'} eq 'CODE39MOD') { + my $c39 = CheckDigits('code_39'); # get modulo 43 checksum + $params{'barcode_data'} = $c39->complete($params{'barcode_data'}); + } + elsif ($params{'barcode_type'} eq 'CODE39MOD10') { + my $c39_10 = CheckDigits('siret'); # get modulo 10 checksum + $params{'barcode_data'} = $c39_10->complete($params{'barcode_data'}); + } + eval { + PDF::Reuse::Barcode::Code39( + x => $params{'llx'}, + y => $params{'lly'}, + value => "*$params{barcode_data}*", + xSize => $x_scale_factor, + ySize => $params{'y_scale_factor'}, + hide_asterisk => 1, + text => $params{'text'}, + mode => 'graphic', + ); + }; + if ($@) { + warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@); + } + } + elsif ($params{'barcode_type'} eq 'COOP2OF5') { + $bar_length = '9.43333333333333'; + $tot_bar_length = ($bar_length * $num_of_chars) + ($guard_length * 2); + $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9; + eval { + PDF::Reuse::Barcode::COOP2of5( + x => $params{'llx'}, + y => $params{'lly'}, + value => "*$params{barcode_data}*", + xSize => $x_scale_factor, + ySize => $params{'y_scale_factor'}, + mode => 'graphic', + ); + }; + if ($@) { + warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@); + } + } + elsif ( $params{'barcode_type'} eq 'INDUSTRIAL2OF5' ) { + $bar_length = '13.1333333333333'; + $tot_bar_length = ($bar_length * $num_of_chars) + ($guard_length * 2); + $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9; + eval { + PDF::Reuse::Barcode::Industrial2of5( + x => $params{'llx'}, + y => $params{'lly'}, + value => "*$params{barcode_data}*", + xSize => $x_scale_factor, + ySize => $params{'y_scale_factor'}, + mode => 'graphic', + ); + }; + if ($@) { + warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@); + } + } +} + +1; +__END__ + +=head1 AUTHOR + +Chris Nighswonger + +=cut + + + -- 2.20.1