Koha-community
/
Koha
13
5
Fork 0
Code Issues Releases Wiki Activity
Browse Source

[1/30] C4::Patroncards::Patroncard Module 

A module for creating patron card objects and manipulating them.
3.2.x
Chris Nighswonger 15 years ago
parent
9bebe2e914
commit
347848ede3
1 changed files with 290 additions and 0 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 290
      C4/Patroncards/Patroncard.pm

290
C4/Patroncards/Patroncard.pm
View File

@ -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 <cnighswonger AT foundations DOT edu>
=cut
Write Preview
Loading…
Cancel
Save