500 lines
19 KiB
Perl
500 lines
19 KiB
Perl
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 3 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, see <https://www.gnu.org/licenses>.
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use autouse 'Data::Dumper' => qw(Dumper);
|
|
|
|
#use Font::TTFMetrics;
|
|
|
|
use C4::Creators::Lib qw( get_unit_values );
|
|
use C4::Creators::PDF;
|
|
use C4::Patroncards::Lib qw(
|
|
box
|
|
get_borrower_attributes
|
|
leading
|
|
text_alignment
|
|
);
|
|
|
|
=head1 NAME
|
|
|
|
C4::Patroncards::Patroncard
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use C4::Patroncards::Patroncard;
|
|
|
|
# Please extend
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This module allows you to ...
|
|
|
|
=head1 FUNCTIONS
|
|
|
|
=head2 new
|
|
|
|
=cut
|
|
|
|
sub new {
|
|
my ( $invocant, %params ) = @_;
|
|
my $type = ref($invocant) || $invocant;
|
|
|
|
my $units = get_unit_values();
|
|
my $unitvalue = 1;
|
|
my $unitdesc = '';
|
|
foreach my $un (@$units) {
|
|
if ( $un->{'type'} eq $params{'layout'}->{'units'} ) {
|
|
$unitvalue = $un->{'value'};
|
|
$unitdesc = $un->{'desc'};
|
|
}
|
|
}
|
|
|
|
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'},
|
|
unitvalue => $unitvalue,
|
|
unitdesc => $unitdesc,
|
|
text_wrap_cols => $params{'text_wrap_cols'},
|
|
barcode_height_scale => $params{'layout'}->{'barcode'}[0]->{'height_scale'} || 0.01,
|
|
barcode_width_scale => $params{'layout'}->{'barcode'}[0]->{'width_scale'} || 0.8,
|
|
};
|
|
bless( $self, $type );
|
|
return $self;
|
|
}
|
|
|
|
=head2 draw_barcode
|
|
|
|
=cut
|
|
|
|
sub draw_barcode {
|
|
my ( $self, $pdf ) = @_;
|
|
|
|
# Default values for barcode scaling are set in constructor to work with pre-existing installations
|
|
my $barcode_height_scale = $self->{'barcode_height_scale'};
|
|
my $barcode_width_scale = $self->{'barcode_width_scale'};
|
|
my $llx = $self->{'llx'} || 0;
|
|
my $llx_layout = $self->{'layout'}->{'barcode'}->[0]->{'llx'} || 0;
|
|
my $lly = $self->{'lly'} || 0;
|
|
my $lly_layout = $self->{'layout'}->{'barcode'}->[0]->{'lly'} || 0;
|
|
_draw_barcode(
|
|
$self,
|
|
llx => $llx + $llx_layout * $self->{'unitvalue'},
|
|
lly => $lly + $lly_layout * $self->{'unitvalue'},
|
|
width => $self->{'width'} * $barcode_width_scale,
|
|
y_scale_factor => $self->{'height'} * $barcode_height_scale,
|
|
barcode_type => $self->{'layout'}->{'barcode'}->[0]->{'type'},
|
|
barcode_data => $self->{'layout'}->{'barcode'}->[0]->{'data'},
|
|
text => $self->{'layout'}->{'barcode'}->[0]->{'text_print'},
|
|
);
|
|
}
|
|
|
|
=head2 draw_guide_box
|
|
|
|
=cut
|
|
|
|
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);
|
|
}
|
|
|
|
=head2 draw_guide_grid
|
|
|
|
$patron_card->draw_guide_grid($pdf)
|
|
|
|
Adds a grid to the PDF output ($pdf) to support layout design
|
|
|
|
=cut
|
|
|
|
sub draw_guide_grid {
|
|
my ( $self, $pdf ) = @_;
|
|
warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
|
|
|
|
# Set up the grid in user defined units.
|
|
# Each 5th and 10th line get separate values
|
|
|
|
my $obj_stream = "q\n"; # save the graphic state
|
|
my $x = $self->{'llx'};
|
|
my $y = $self->{'lly'};
|
|
|
|
my $cnt = 0;
|
|
for (
|
|
$x = $self->{'llx'} / $self->{'unitvalue'} ;
|
|
$x <= ( $self->{'llx'} + $self->{'width'} ) / $self->{'unitvalue'} ;
|
|
$x++
|
|
)
|
|
{
|
|
my $xx = $x * $self->{'unitvalue'};
|
|
my $yy = $y + $self->{'height'};
|
|
if ( ( $cnt % 10 ) && !( $cnt % 5 ) ) {
|
|
$obj_stream .= "0.0 1.0 0.0 RG\n";
|
|
$obj_stream .= "0 w\n";
|
|
} elsif ( $cnt % 5 ) {
|
|
$obj_stream .= "0.0 1.0 1.0 RG\n";
|
|
$obj_stream .= "0 w\n";
|
|
} else {
|
|
$obj_stream .= "0.0 0.0 1.0 RG\n";
|
|
$obj_stream .= "0 w\n";
|
|
}
|
|
$cnt++;
|
|
|
|
$obj_stream .= "$xx $y m\n";
|
|
$obj_stream .= "$xx $yy l\n";
|
|
|
|
$obj_stream .= "s\n";
|
|
}
|
|
|
|
$x = $self->{'llx'};
|
|
$y = $self->{'lly'};
|
|
$cnt = 0;
|
|
for (
|
|
$y = $self->{'lly'} / $self->{'unitvalue'} ;
|
|
$y <= ( $self->{'lly'} + $self->{'height'} ) / $self->{'unitvalue'} ;
|
|
$y++
|
|
)
|
|
{
|
|
|
|
my $xx = $x + $self->{'width'};
|
|
my $yy = $y * $self->{'unitvalue'};
|
|
|
|
if ( ( $cnt % 10 ) && !( $cnt % 5 ) ) {
|
|
$obj_stream .= "0.0 1.0 0.0 RG\n";
|
|
$obj_stream .= "0 w\n";
|
|
} elsif ( $cnt % 5 ) {
|
|
$obj_stream .= "0.0 1.0 1.0 RG\n";
|
|
$obj_stream .= "0 w\n";
|
|
} else {
|
|
$obj_stream .= "0.0 0.0 1.0 RG\n";
|
|
$obj_stream .= "0 w\n";
|
|
}
|
|
$cnt++;
|
|
|
|
$obj_stream .= "$x $yy m\n";
|
|
$obj_stream .= "$xx $yy l\n";
|
|
$obj_stream .= "s\n";
|
|
}
|
|
|
|
$obj_stream .= "Q\n"; # restore the graphic state
|
|
$pdf->Add($obj_stream);
|
|
|
|
# Add info about units
|
|
my $strbottom = "0/0 $self->{'unitdesc'}";
|
|
my $strtop = sprintf( '%.2f', $self->{'width'} / $self->{'unitvalue'} ) . '/'
|
|
. sprintf( '%.2f', $self->{'height'} / $self->{'unitvalue'} );
|
|
my $font_size = 6;
|
|
$pdf->Font('Courier');
|
|
$pdf->FontSize($font_size);
|
|
my $strtop_len = $pdf->StrWidth($strtop) * 1.5;
|
|
$pdf->Text( $self->{'llx'} + 2, $self->{'lly'} + 2, $strbottom );
|
|
$pdf->Text(
|
|
$self->{'llx'} + $self->{'width'} - $strtop_len, $self->{'lly'} + $self->{'height'} - $font_size,
|
|
$strtop
|
|
);
|
|
}
|
|
|
|
=head2 draw_text
|
|
|
|
$patron_card->draw_text($pdf)
|
|
|
|
Draws text to PDF output ($pdf)
|
|
|
|
=cut
|
|
|
|
sub draw_text {
|
|
my ( $self, $pdf, %params ) = @_;
|
|
warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
|
|
my @card_text = ();
|
|
return unless ( ref( $self->{'layout'}->{'text'} ) eq 'ARRAY' ); # just in case there is not text
|
|
|
|
my $text = [ @{ $self->{'layout'}->{'text'} } ]; # make a copy of the arrayref *not* simply a pointer
|
|
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 );
|
|
@orig_line = map { # substitute data for db fields
|
|
my $l = $_;
|
|
if ( $l =~ m/<([A-Za-z0-9_]+)>/ ) {
|
|
my $field = $1;
|
|
$l =~ s/$l/$borrower_attributes->{$field}/;
|
|
}
|
|
$l;
|
|
} @orig_line;
|
|
$line = join( ' ', @orig_line );
|
|
}
|
|
my $text_attribs = shift @$text;
|
|
my $llx = $self->{'llx'} || 0;
|
|
my $llx_text_attr = $text_attribs->{'llx'} || 0;
|
|
my $lly = $self->{'lly'} || 0;
|
|
my $lly_text_attr = $text_attribs->{'lly'} || 0;
|
|
|
|
my $origin_llx = $llx + $llx_text_attr * $self->{'unitvalue'};
|
|
my $origin_lly = $lly + $lly_text_attr * $self->{'unitvalue'};
|
|
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;
|
|
## Please see file perltidy.ERR
|
|
my $string_width = C4::Creators::PDF->StrWidth( $line, $text_attribs->{'font'}, $text_attribs->{'font_size'} );
|
|
if ( ( $string_width + $llx_text_attr ) > $self->{'width'} ) {
|
|
my $cur_line = "";
|
|
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&|\<.*\>)$/;
|
|
$trim = $1 . $trim;
|
|
|
|
#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)
|
|
$line =~ s/\Q$1\E$//;
|
|
$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 && ( ( $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->{'unitvalue'} ) < $self->{'width'} ) {
|
|
( $Tx, $Tw ) = text_alignment(
|
|
$origin_llx, $self->{'width'},
|
|
$text_attribs->{'llx'} * $self->{'unitvalue'}, $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 {
|
|
|
|
# We only split lines on spaces - it seems if we push a line too far, it can end
|
|
# never getting short enough in which case we need to escape and the malformed PDF
|
|
# will indicate the layout problem
|
|
last WRAP_LINES if $cur_line eq $line;
|
|
$cur_line = $line;
|
|
}
|
|
}
|
|
} else {
|
|
( $Tx, $Tw ) = text_alignment(
|
|
$origin_llx, $self->{'width'}, $lly_text_attr * $self->{'unitvalue'}, $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'} * $self->{'unitvalue'} ),
|
|
$box_height, $pdf
|
|
);
|
|
}
|
|
$pdf->Font( $text_attribs->{'font'} );
|
|
$pdf->FontSize( $text_attribs->{'font_size'} );
|
|
foreach my $line (@lines) {
|
|
$pdf->Text( $line->{'Tx'}, $line->{'Ty'}, $line->{'line'} );
|
|
}
|
|
}
|
|
}
|
|
|
|
=head2 draw_image
|
|
|
|
$patron_card->draw_image($pdf)
|
|
|
|
Draws images to PDF output ($pdf)
|
|
|
|
=cut
|
|
|
|
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'}->[0]->{'image_source'} eq 'none';
|
|
my $Tx = $self->{'llx'} + $images->{$image}->{'Tx'} * $self->{'unitvalue'};
|
|
my $Ty = $self->{'lly'} + $images->{$image}->{'Ty'} * $self->{'unitvalue'};
|
|
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 .= "$images->{$image}->{'scale'} 0 0 $images->{$image}->{'scale'} 0 0 cm\n"; #scale to 20%
|
|
$obj_stream .= "/$intName Do\n";
|
|
$obj_stream .= "Q\n";
|
|
$pdf->Add($obj_stream);
|
|
}
|
|
}
|
|
|
|
=head2 draw_barcode
|
|
|
|
$patron_card->draw_barcode($pdf)
|
|
|
|
Draws a barcode to PDF output ($pdf)
|
|
|
|
=cut
|
|
|
|
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 <cnighswonger AT foundations DOT edu>
|
|
|
|
=cut
|