Revision ca2ec834
Von Sven Schöling vor etwa 9 Jahren hinzugefügt
| modules/override/PDF/Table.pm | ||
|---|---|---|
|
use 5.006;
|
||
|
use strict;
|
||
|
use warnings;
|
||
|
our $VERSION = '0.9.3';
|
||
|
use Carp;
|
||
|
our $VERSION = '0.9.10';
|
||
|
|
||
|
use List::Util qw(sum);
|
||
|
print __PACKAGE__.' is version: '.$VERSION.$/ if($ENV{'PDF_TABLE_DEBUG'});
|
||
|
|
||
|
############################################################
|
||
|
#
|
||
| ... | ... | |
|
#
|
||
|
############################################################
|
||
|
|
||
|
sub new {
|
||
|
my ($type) = @_;
|
||
|
sub new
|
||
|
{
|
||
|
my $type = shift(@_);
|
||
|
my $class = ref($type) || $type;
|
||
|
my $self = {};
|
||
|
bless ($self, $class);
|
||
|
|
||
|
my $class = ref($type) || $type;
|
||
|
my $self = {};
|
||
|
bless ($self, $class);
|
||
|
return $self;
|
||
|
# Pass all the rest to init for validation and initialisation
|
||
|
$self->_init(@_);
|
||
|
|
||
|
return $self;
|
||
|
}
|
||
|
|
||
|
sub _init
|
||
|
{
|
||
|
my ($self, $pdf, $page, $data, %options ) = @_;
|
||
|
|
||
|
# Check and set default values
|
||
|
$self->set_defaults();
|
||
|
|
||
|
# Check and set mandatory params
|
||
|
$self->set_pdf($pdf);
|
||
|
$self->set_page($page);
|
||
|
$self->set_data($data);
|
||
|
$self->set_options(\%options);
|
||
|
|
||
|
return;
|
||
|
}
|
||
|
|
||
|
sub set_defaults{
|
||
|
my $self = shift;
|
||
|
|
||
|
$self->{'font_size'} = 12;
|
||
|
}
|
||
|
|
||
|
sub set_pdf{
|
||
|
my ($self, $pdf) = @_;
|
||
|
$self->{'pdf'} = $pdf;
|
||
|
}
|
||
|
|
||
|
sub set_page{
|
||
|
my ($self, $page) = @_;
|
||
|
if ( defined($page) && ref($page) ne 'PDF::API2::Page' ){
|
||
|
|
||
|
if( ref($self->{'pdf'}) eq 'PDF::API2' ){
|
||
|
$self->{'page'} = $self->{'pdf'}->page();
|
||
|
} else {
|
||
|
carp 'Warning: Page must be a PDF::API2::Page object but it seems to be: '.ref($page).$/;
|
||
|
carp 'Error: Cannot set page from passed PDF object either as it is invalid!'.$/;
|
||
|
}
|
||
|
return;
|
||
|
}
|
||
|
$self->{'page'} = $page;
|
||
|
|
||
|
}
|
||
|
|
||
|
sub set_data{
|
||
|
my ($self, $data) = @_;
|
||
|
#TODO: implement
|
||
|
}
|
||
|
|
||
|
sub set_options{
|
||
|
my ($self, $options) = @_;
|
||
|
#TODO: implement
|
||
|
}
|
||
|
|
||
|
############################################################
|
||
| ... | ... | |
|
#
|
||
|
############################################################
|
||
|
|
||
|
sub text_block {
|
||
|
my $self = shift;
|
||
|
my $text_object = shift;
|
||
|
my $text = shift; # The text to be displayed
|
||
|
my %arg = @_; # Additional Arguments
|
||
|
|
||
|
my ($align, $xpos, $ypos, $xbase, $ybase, $line_width, $wordspace, $endw , $width, $height)
|
||
|
= (undef , undef, undef, undef , undef , undef , undef , undef , undef , undef );
|
||
|
my @line = (); # Temp data array with words on one line
|
||
|
my %width = (); # The width of every unique word in the givven text
|
||
|
|
||
|
# Try to provide backward compatibility
|
||
|
foreach my $key (keys %arg) {
|
||
|
my $newkey = $key;
|
||
|
if ($newkey =~ s#^-##) {
|
||
|
$arg{$newkey} = $arg{$key};
|
||
|
delete $arg{$key};
|
||
|
sub text_block
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my $text_object = shift;
|
||
|
my $text = shift; # The text to be displayed
|
||
|
my %arg = @_; # Additional Arguments
|
||
|
|
||
|
my ( $align, $xpos, $ypos, $xbase, $ybase, $line_width, $wordspace, $endw , $width, $height) =
|
||
|
( undef , undef, undef, undef , undef , undef , undef , undef , undef , undef );
|
||
|
my @line = (); # Temp data array with words on one line
|
||
|
my %width = (); # The width of every unique word in the givven text
|
||
|
|
||
|
# Try to provide backward compatibility
|
||
|
foreach my $key (keys %arg)
|
||
|
{
|
||
|
my $newkey = $key;
|
||
|
if($newkey =~ s#^-##)
|
||
|
{
|
||
|
$arg{$newkey} = $arg{$key};
|
||
|
delete $arg{$key};
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
#####
|
||
|
|
||
|
#---
|
||
|
# Lets check mandatory parameters with no default values
|
||
|
#---
|
||
|
$xbase = $arg{'x'} || -1;
|
||
|
$ybase = $arg{'y'} || -1;
|
||
|
$width = $arg{'w'} || -1;
|
||
|
$height = $arg{'h'} || -1;
|
||
|
unless ( $xbase > 0 ) { print "Error: Left Edge of Block is NOT defined!\n"; return; }
|
||
|
unless ( $ybase > 0 ) { print "Error: Base Line of Block is NOT defined!\n"; return; }
|
||
|
unless ( $width > 0 ) { print "Error: Width of Block is NOT defined!\n"; return; }
|
||
|
unless ( $height > 0 ) { print "Error: Height of Block is NOT defined!\n"; return; }
|
||
|
# Check if any text to display
|
||
|
unless ( defined( $text) and length($text) > 0 ) {
|
||
|
print "Warning: No input text found. Trying to add dummy '-' and not to break everything.\n";
|
||
|
$text = '-';
|
||
|
}
|
||
|
|
||
|
# Strip any <CR> and Split the text into paragraphs
|
||
|
$text =~ s/\r//g;
|
||
|
my @paragraphs = split(/\n/, $text);
|
||
|
|
||
|
# Width between lines in pixels
|
||
|
my $line_space = defined $arg{'lead'} && $arg{'lead'} > 0 ? $arg{'lead'} : 12;
|
||
|
|
||
|
# Calculate width of all words
|
||
|
my $space_width = $text_object->advancewidth("\x20");
|
||
|
my @words = split(/\s+/, $text);
|
||
|
foreach (@words) {
|
||
|
next if exists $width{$_};
|
||
|
$width{$_} = $text_object->advancewidth($_);
|
||
|
}
|
||
|
|
||
|
my @paragraph = split(' ', shift(@paragraphs));
|
||
|
my $first_line = 1;
|
||
|
my $first_paragraph = 1;
|
||
|
|
||
|
# Little Init
|
||
|
$xpos = $xbase;
|
||
|
$ypos = $ybase;
|
||
|
$ypos = $ybase + $line_space;
|
||
|
my $bottom_border = $ybase - $height;
|
||
|
# While we can add another line
|
||
|
while ( $ypos >= $bottom_border + $line_space ) {
|
||
|
# Is there any text to render ?
|
||
|
unless (@paragraph) {
|
||
|
# Finish if nothing left
|
||
|
last unless scalar @paragraphs;
|
||
|
# Else take one line from the text
|
||
|
@paragraph = split(' ', shift( @paragraphs ) );
|
||
|
|
||
|
$ypos -= $arg{'parspace'} if $arg{'parspace'};
|
||
|
last unless $ypos >= $bottom_border;
|
||
|
#####
|
||
|
|
||
|
#---
|
||
|
# Lets check mandatory parameters with no default values
|
||
|
#---
|
||
|
$xbase = $arg{'x'} || -1;
|
||
|
$ybase = $arg{'y'} || -1;
|
||
|
$width = $arg{'w'} || -1;
|
||
|
$height = $arg{'h'} || -1;
|
||
|
unless( $xbase > 0 ){ carp "Error: Left Edge of Block is NOT defined!\n"; return; }
|
||
|
unless( $ybase > 0 ){ carp "Error: Base Line of Block is NOT defined!\n"; return; }
|
||
|
unless( $width > 0 ){ carp "Error: Width of Block is NOT defined!\n"; return; }
|
||
|
unless( $height > 0 ){ carp "Error: Height of Block is NOT defined!\n"; return; }
|
||
|
# Check if any text to display
|
||
|
unless( defined( $text) and length($text) > 0 )
|
||
|
{
|
||
|
carp "Warning: No input text found. Trying to add dummy '-' and not to break everything.\n";
|
||
|
$text = '-';
|
||
|
}
|
||
|
$ypos -= $line_space;
|
||
|
$xpos = $xbase;
|
||
|
|
||
|
# While there's room on the line, add another word
|
||
|
@line = ();
|
||
|
$line_width = 0;
|
||
|
if ( $first_line && exists $arg{'hang'} ) {
|
||
|
my $hang_width = $text_object->advancewidth($arg{'hang'});
|
||
|
# Strip any <CR> and Split the text into paragraphs
|
||
|
$text =~ s/\r//g;
|
||
|
my @paragraphs = split(/\n/, $text);
|
||
|
|
||
|
$text_object->translate( $xpos, $ypos );
|
||
|
$text_object->text( $arg{'hang'} );
|
||
|
# Width between lines in pixels
|
||
|
my $line_space = defined $arg{'lead'} && $arg{'lead'} > 0 ? $arg{'lead'} : 12;
|
||
|
|
||
|
$xpos += $hang_width;
|
||
|
$line_width += $hang_width;
|
||
|
$arg{'indent'} += $hang_width if $first_paragraph;
|
||
|
# Calculate width of all words
|
||
|
my $space_width = $text_object->advancewidth("\x20");
|
||
|
my @words = split(/\s+/, $text);
|
||
|
foreach (@words)
|
||
|
{
|
||
|
next if exists $width{$_};
|
||
|
$width{$_} = $text_object->advancewidth($_);
|
||
|
}
|
||
|
|
||
|
} elsif ( $first_line && exists $arg{'flindent'} && $arg{'flindent'} > 0 ) {
|
||
|
$xpos += $arg{'flindent'};
|
||
|
$line_width += $arg{'flindent'};
|
||
|
my @paragraph = split(' ', shift(@paragraphs));
|
||
|
my $first_line = 1;
|
||
|
my $first_paragraph = 1;
|
||
|
|
||
|
# Little Init
|
||
|
$xpos = $xbase;
|
||
|
$ypos = $ybase;
|
||
|
$ypos = $ybase + $line_space;
|
||
|
my $bottom_border = $ypos - $height;
|
||
|
# While we can add another line
|
||
|
while ( $ypos >= $bottom_border + $line_space )
|
||
|
{
|
||
|
# Is there any text to render ?
|
||
|
unless (@paragraph)
|
||
|
{
|
||
|
# Finish if nothing left
|
||
|
last unless scalar @paragraphs;
|
||
|
# Else take one line from the text
|
||
|
@paragraph = split(' ', shift( @paragraphs ) );
|
||
|
|
||
|
$ypos -= $arg{'parspace'} if $arg{'parspace'};
|
||
|
last unless $ypos >= $bottom_border;
|
||
|
}
|
||
|
$ypos -= $line_space;
|
||
|
$xpos = $xbase;
|
||
|
|
||
|
# While there's room on the line, add another word
|
||
|
@line = ();
|
||
|
$line_width = 0;
|
||
|
if( $first_line && exists $arg{'hang'} )
|
||
|
{
|
||
|
my $hang_width = $text_object->advancewidth($arg{'hang'});
|
||
|
|
||
|
$text_object->translate( $xpos, $ypos );
|
||
|
$text_object->text( $arg{'hang'} );
|
||
|
|
||
|
$xpos += $hang_width;
|
||
|
$line_width += $hang_width;
|
||
|
$arg{'indent'} += $hang_width if $first_paragraph;
|
||
|
}
|
||
|
elsif( $first_line && exists $arg{'flindent'} && $arg{'flindent'} > 0 )
|
||
|
{
|
||
|
$xpos += $arg{'flindent'};
|
||
|
$line_width += $arg{'flindent'};
|
||
|
}
|
||
|
elsif( $first_paragraph && exists $arg{'fpindent'} && $arg{'fpindent'} > 0 )
|
||
|
{
|
||
|
$xpos += $arg{'fpindent'};
|
||
|
$line_width += $arg{'fpindent'};
|
||
|
}
|
||
|
elsif (exists $arg{'indent'} && $arg{'indent'} > 0 )
|
||
|
{
|
||
|
$xpos += $arg{'indent'};
|
||
|
$line_width += $arg{'indent'};
|
||
|
}
|
||
|
|
||
|
# Lets take from paragraph as many words as we can put into $width - $indent;
|
||
|
while ( @paragraph and $text_object->advancewidth( join("\x20", @line)."\x20" . $paragraph[0]) +
|
||
|
$line_width < $width )
|
||
|
{
|
||
|
push(@line, shift(@paragraph));
|
||
|
}
|
||
|
$line_width += $text_object->advancewidth(join('', @line));
|
||
|
|
||
|
# calculate the space width
|
||
|
if( $arg{'align'} eq 'fulljustify' or ($arg{'align'} eq 'justify' and @paragraph))
|
||
|
{
|
||
|
@line = split(//,$line[0]) if (scalar(@line) == 1) ;
|
||
|
$wordspace = ($width - $line_width) / (scalar(@line) - 1);
|
||
|
$align='justify';
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
$align=($arg{'align'} eq 'justify') ? 'left' : $arg{'align'};
|
||
|
$wordspace = $space_width;
|
||
|
}
|
||
|
$line_width += $wordspace * (scalar(@line) - 1);
|
||
|
|
||
|
if( $align eq 'justify')
|
||
|
{
|
||
|
foreach my $word (@line)
|
||
|
{
|
||
|
$text_object->translate( $xpos, $ypos );
|
||
|
$text_object->text( $word );
|
||
|
$xpos += ($width{$word} + $wordspace) if (@line);
|
||
|
}
|
||
|
$endw = $width;
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
# calculate the left hand position of the line
|
||
|
if( $align eq 'right' )
|
||
|
{
|
||
|
$xpos += $width - $line_width;
|
||
|
}
|
||
|
elsif( $align eq 'center' )
|
||
|
{
|
||
|
$xpos += ( $width / 2 ) - ( $line_width / 2 );
|
||
|
}
|
||
|
|
||
|
# render the line
|
||
|
$text_object->translate( $xpos, $ypos );
|
||
|
$endw = $text_object->text( join("\x20", @line));
|
||
|
}
|
||
|
$first_line = 0;
|
||
|
}#End of while(
|
||
|
unshift(@paragraphs, join(' ',@paragraph)) if scalar(@paragraph);
|
||
|
return ($endw, $ypos, join("\n", @paragraphs))
|
||
|
}
|
||
|
|
||
|
} elsif ( $first_paragraph && exists $arg{'fpindent'} && $arg{'fpindent'} > 0 ) {
|
||
|
$xpos += $arg{'fpindent'};
|
||
|
$line_width += $arg{'fpindent'};
|
||
|
|
||
|
} elsif (exists $arg{'indent'} && $arg{'indent'} > 0 ) {
|
||
|
$xpos += $arg{'indent'};
|
||
|
$line_width += $arg{'indent'};
|
||
|
################################################################
|
||
|
# table - utility method to build multi-row, multicolumn tables
|
||
|
################################################################
|
||
|
sub table
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my $pdf = shift;
|
||
|
my $page = shift;
|
||
|
my $data = shift;
|
||
|
my %arg = @_;
|
||
|
|
||
|
#=====================================
|
||
|
# Mandatory Arguments Section
|
||
|
#=====================================
|
||
|
unless($pdf and $page and $data)
|
||
|
{
|
||
|
carp "Error: Mandatory parameter is missing pdf/page/data object!\n";
|
||
|
return;
|
||
|
}
|
||
|
|
||
|
# Lets take from paragraph as many words as we can put into $width - $indent;. Always take at least one word; otherwise we'd end up in an infinite loop.
|
||
|
while (!scalar(@line) || (@paragraph && ($text_object->advancewidth( join("\x20", @line)."\x20" . $paragraph[0]) + $line_width < $width))) {
|
||
|
push(@line, shift(@paragraph));
|
||
|
# Validate mandatory argument data type
|
||
|
croak "Error: Invalid pdf object received." unless (ref($pdf) eq 'PDF::API2');
|
||
|
croak "Error: Invalid page object received." unless (ref($page) eq 'PDF::API2::Page');
|
||
|
croak "Error: Invalid data received." unless ((ref($data) eq 'ARRAY') && scalar(@$data));
|
||
|
croak "Error: Missing required settings." unless (scalar(keys %arg));
|
||
|
|
||
|
# Validate settings key
|
||
|
my %valid_settings_key = (
|
||
|
x => 1,
|
||
|
w => 1,
|
||
|
start_y => 1,
|
||
|
start_h => 1,
|
||
|
next_y => 1,
|
||
|
next_h => 1,
|
||
|
lead => 1,
|
||
|
padding => 1,
|
||
|
padding_right => 1,
|
||
|
padding_left => 1,
|
||
|
padding_top => 1,
|
||
|
padding_bottom => 1,
|
||
|
background_color => 1,
|
||
|
background_color_odd => 1,
|
||
|
background_color_even => 1,
|
||
|
border => 1,
|
||
|
border_color => 1,
|
||
|
horizontal_borders => 1,
|
||
|
vertical_borders => 1,
|
||
|
font => 1,
|
||
|
font_size => 1,
|
||
|
font_color => 1,
|
||
|
font_color_even => 1,
|
||
|
background_color_odd => 1,
|
||
|
background_color_even => 1,
|
||
|
row_height => 1,
|
||
|
new_page_func => 1,
|
||
|
header_props => 1,
|
||
|
column_props => 1,
|
||
|
cell_props => 1,
|
||
|
max_word_length => 1,
|
||
|
);
|
||
|
foreach my $key (keys %arg) {
|
||
|
croak "Error: Invalid setting key '$key' received."
|
||
|
unless (exists $valid_settings_key{$key});
|
||
|
}
|
||
|
$line_width += $text_object->advancewidth(join('', @line));
|
||
|
|
||
|
# calculate the space width
|
||
|
if ( $arg{'align'} eq 'fulljustify' or ($arg{'align'} eq 'justify' and @paragraph)) {
|
||
|
@line = split(//,$line[0]) if (scalar(@line) == 1) ;
|
||
|
$wordspace = ($width - $line_width) / (scalar(@line) - 1);
|
||
|
$align ='justify';
|
||
|
|
||
|
} else {
|
||
|
$align = ($arg{'align'} eq 'justify') ? 'left' : $arg{'align'};
|
||
|
$wordspace = $space_width;
|
||
|
# Try to provide backward compatibility
|
||
|
foreach my $key (keys %arg)
|
||
|
{
|
||
|
my $newkey = $key;
|
||
|
if($newkey =~ s#^-##)
|
||
|
{
|
||
|
$arg{$newkey} = $arg{$key};
|
||
|
delete $arg{$key};
|
||
|
}
|
||
|
}
|
||
|
$line_width += $wordspace * (scalar(@line) - 1);
|
||
|
|
||
|
if ( $align eq 'justify') {
|
||
|
foreach my $word (@line) {
|
||
|
$text_object->translate( $xpos, $ypos );
|
||
|
$text_object->text( $word );
|
||
|
$xpos += ($width{$word} + $wordspace) if (@line);
|
||
|
}
|
||
|
$endw = $width;
|
||
|
|
||
|
} else {
|
||
|
# calculate the left hand position of the line
|
||
|
if ( $align eq 'right' ) {
|
||
|
$xpos += $width - $line_width;
|
||
|
|
||
|
} elsif ( $align eq 'center' ) {
|
||
|
$xpos += ( $width / 2 ) - ( $line_width / 2 );
|
||
|
}
|
||
|
|
||
|
# render the line
|
||
|
$text_object->translate( $xpos, $ypos );
|
||
|
$endw = $text_object->text( join("\x20", @line));
|
||
|
|
||
|
######
|
||
|
#TODO: Add code for header props compatibility and col_props comp....
|
||
|
######
|
||
|
my ( $xbase, $ybase, $width, $height ) = ( undef, undef, undef, undef );
|
||
|
# Could be 'int' or 'real' values
|
||
|
$xbase = $arg{'x' } || -1;
|
||
|
$ybase = $arg{'start_y'} || -1;
|
||
|
$width = $arg{'w' } || -1;
|
||
|
$height = $arg{'start_h'} || -1;
|
||
|
|
||
|
# Global geometry parameters are also mandatory.
|
||
|
unless( $xbase > 0 ){ carp "Error: Left Edge of Table is NOT defined!\n"; return; }
|
||
|
unless( $ybase > 0 ){ carp "Error: Base Line of Table is NOT defined!\n"; return; }
|
||
|
unless( $width > 0 ){ carp "Error: Width of Table is NOT defined!\n"; return; }
|
||
|
unless( $height > 0 ){ carp "Error: Height of Table is NOT defined!\n"; return; }
|
||
|
|
||
|
# Ensure default values for -next_y and -next_h
|
||
|
my $next_y = $arg{'next_y'} || $arg{'start_y'} || 0;
|
||
|
my $next_h = $arg{'next_h'} || $arg{'start_h'} || 0;
|
||
|
|
||
|
# Create Text Object
|
||
|
my $txt = $page->text;
|
||
|
|
||
|
# Set Default Properties
|
||
|
my $fnt_name = $arg{'font' } || $pdf->corefont('Times',-encode => 'utf8');
|
||
|
my $fnt_size = $arg{'font_size' } || 12;
|
||
|
my $max_word_len= $arg{'max_word_length' } || 20;
|
||
|
|
||
|
#=====================================
|
||
|
# Table Header Section
|
||
|
#=====================================
|
||
|
# Disable header row into the table
|
||
|
my $header_props = undef;
|
||
|
|
||
|
# Check if the user enabled it ?
|
||
|
if(defined $arg{'header_props'} and ref( $arg{'header_props'}) eq 'HASH')
|
||
|
{
|
||
|
# Transfer the reference to local variable
|
||
|
$header_props = $arg{'header_props'};
|
||
|
|
||
|
# Check other params and put defaults if needed
|
||
|
$header_props->{'repeat' } = $header_props->{'repeat' } || 0;
|
||
|
$header_props->{'font' } = $header_props->{'font' } || $fnt_name;
|
||
|
$header_props->{'font_color' } = $header_props->{'font_color' } || '#000066';
|
||
|
$header_props->{'font_size' } = $header_props->{'font_size' } || $fnt_size + 2;
|
||
|
$header_props->{'bg_color' } = $header_props->{'bg_color' } || '#FFFFAA';
|
||
|
$header_props->{'justify' } = $header_props->{'justify' };
|
||
|
}
|
||
|
$first_line = 0;
|
||
|
}#End of while(
|
||
|
|
||
|
unshift(@paragraphs, join(' ',@paragraph)) if scalar(@paragraph);
|
||
|
|
||
|
return ($endw, $ypos, join("\n", @paragraphs))
|
||
|
}
|
||
|
|
||
|
|
||
|
############################################################
|
||
|
# table - utility method to build multi-row, multicolumn tables
|
||
|
############################################################
|
||
|
sub table {
|
||
|
my $self = shift;
|
||
|
my $pdf = shift;
|
||
|
my $page = shift;
|
||
|
my $data = shift;
|
||
|
my %arg = @_;
|
||
|
|
||
|
#=====================================
|
||
|
# Mandatory Arguments Section
|
||
|
#=====================================
|
||
|
unless ($pdf and $page and $data) {
|
||
|
print "Error: Mandatory parameter is missing pdf/page/data object!\n";
|
||
|
return;
|
||
|
}
|
||
|
# Try to provide backward compatibility
|
||
|
foreach my $key (keys %arg) {
|
||
|
my $newkey = $key;
|
||
|
if ($newkey =~ s#^-##) {
|
||
|
$arg{$newkey} = $arg{$key};
|
||
|
delete $arg{$key};
|
||
|
my $header_row = undef;
|
||
|
#=====================================
|
||
|
# Other Parameters check
|
||
|
#=====================================
|
||
|
my $lead = $arg{'lead' } || $fnt_size;
|
||
|
my $pad_left = $arg{'padding_left' } || $arg{'padding'} || 0;
|
||
|
my $pad_right = $arg{'padding_right' } || $arg{'padding'} || 0;
|
||
|
my $pad_top = $arg{'padding_top' } || $arg{'padding'} || 0;
|
||
|
my $pad_bot = $arg{'padding_bottom'} || $arg{'padding'} || 0;
|
||
|
my $line_w = defined $arg{'border'} ? $arg{'border'} : 1 ;
|
||
|
my $horiz_borders = defined $arg{'horizontal_borders'}
|
||
|
? $arg{'horizontal_borders'}
|
||
|
: $line_w;
|
||
|
my $vert_borders = defined $arg{'vertical_borders'}
|
||
|
? $arg{'vertical_borders'}
|
||
|
: $line_w;
|
||
|
|
||
|
my $background_color_even = $arg{'background_color_even' } || $arg{'background_color'} || undef;
|
||
|
my $background_color_odd = $arg{'background_color_odd' } || $arg{'background_color'} || undef;
|
||
|
my $font_color_even = $arg{'font_color_even' } || $arg{'font_color' } || 'black';
|
||
|
my $font_color_odd = $arg{'font_color_odd' } || $arg{'font_color' } || 'black';
|
||
|
my $border_color = $arg{'border_color' } || 'black';
|
||
|
|
||
|
my $min_row_h = $fnt_size + $pad_top + $pad_bot;
|
||
|
my $row_h = defined ($arg{'row_height'})
|
||
|
&&
|
||
|
($arg{'row_height'} > $min_row_h)
|
||
|
?
|
||
|
$arg{'row_height'} : $min_row_h;
|
||
|
|
||
|
my $pg_cnt = 1;
|
||
|
my $cur_y = $ybase;
|
||
|
my $cell_props = $arg{cell_props} || []; # per cell properties
|
||
|
|
||
|
#If there is no valid data array reference warn and return!
|
||
|
if(ref $data ne 'ARRAY')
|
||
|
{
|
||
|
carp "Passed table data is not an ARRAY reference. It's actually a ref to ".ref($data);
|
||
|
return ($page,0,$cur_y);
|
||
|
}
|
||
|
}
|
||
|
#TODO: Add code for header props compatibility and col_props comp....
|
||
|
#####
|
||
|
my ( $xbase, $ybase, $width, $height ) = ( undef, undef, undef, undef );
|
||
|
# Could be 'int' or 'real' values
|
||
|
$xbase = $arg{'x' } || -1;
|
||
|
$ybase = $arg{'start_y'} || -1;
|
||
|
$width = $arg{'w' } || -1;
|
||
|
$height = $arg{'start_h'} || -1;
|
||
|
|
||
|
# Global geometry parameters are also mandatory.
|
||
|
unless ( $xbase > 0 ) { print "Error: Left Edge of Table is NOT defined!\n"; return; }
|
||
|
unless ( $ybase > 0 ) { print "Error: Base Line of Table is NOT defined!\n"; return; }
|
||
|
unless ( $width > 0 ) { print "Error: Width of Table is NOT defined!\n"; return; }
|
||
|
unless ( $height > 0 ) { print "Error: Height of Table is NOT defined!\n"; return; }
|
||
|
|
||
|
# Ensure default values for -next_y and -next_h
|
||
|
my $next_y = $arg{'next_y'} || $arg{'start_y'} || 0;
|
||
|
my $next_h = $arg{'next_h'} || $arg{'start_h'} || 0;
|
||
|
|
||
|
# Create Text Object
|
||
|
my $txt = $page->text;
|
||
|
# Set Default Properties
|
||
|
my $fnt_name = $arg{'font'} || $pdf->corefont('Times', -encode => 'utf8');
|
||
|
my $fnt_size = $arg{'font_size'} || 12;
|
||
|
my $max_word_len = $arg{'max_word_length'} || 20;
|
||
|
|
||
|
#=====================================
|
||
|
# Table Header Section
|
||
|
#=====================================
|
||
|
# Disable header row into the table
|
||
|
my $header_props;
|
||
|
my $num_header_rows = 0;
|
||
|
my (@header_rows, @header_row_cell_props);
|
||
|
# Check if the user enabled it ?
|
||
|
if (defined $arg{'header_props'} and ref( $arg{'header_props'}) eq 'HASH') {
|
||
|
# Transfer the reference to local variable
|
||
|
$header_props = $arg{'header_props'};
|
||
|
# Check other params and put defaults if needed
|
||
|
$header_props->{'repeat'} = $header_props->{'repeat'} || 0;
|
||
|
$header_props->{'font'} = $header_props->{'font'} || $fnt_name;
|
||
|
$header_props->{'font_color'} = $header_props->{'font_color'} || '#000066';
|
||
|
$header_props->{'font_size'} = $header_props->{'font_size'} || $fnt_size + 2;
|
||
|
$header_props->{'bg_color'} = $header_props->{'bg_color'} || '#FFFFAA';
|
||
|
|
||
|
$num_header_rows = $arg{'num_header_rows'} || 1;
|
||
|
}
|
||
|
#=====================================
|
||
|
# Other Parameters check
|
||
|
#=====================================
|
||
|
|
||
|
my $lead = $arg{'lead'} || $fnt_size;
|
||
|
my $pad_left = $arg{'padding_left'} || $arg{'padding'} || 0;
|
||
|
my $pad_right = $arg{'padding_right'} || $arg{'padding'} || 0;
|
||
|
my $pad_top = $arg{'padding_top'} || $arg{'padding'} || 0;
|
||
|
my $pad_bot = $arg{'padding_bottom'} || $arg{'padding'} || 0;
|
||
|
my $pad_w = $pad_left + $pad_right;
|
||
|
my $pad_h = $pad_top + $pad_bot ;
|
||
|
my $line_w = defined $arg{'border'} ? $arg{'border'} : 1 ;
|
||
|
|
||
|
my $background_color_even = $arg{'background_color_even'} || $arg{'background_color'} || undef;
|
||
|
my $background_color_odd = $arg{'background_color_odd'} || $arg{'background_color'} || undef;
|
||
|
my $font_color_even = $arg{'font_color_even'} || $arg{'font_color'} || 'black';
|
||
|
my $font_color_odd = $arg{'font_color_odd'} || $arg{'font_color'} || 'black';
|
||
|
my $border_color = $arg{'border_color'} || 'black';
|
||
|
|
||
|
my $min_row_h = $fnt_size + $pad_top + $pad_bot;
|
||
|
my $row_h = defined ($arg{'row_height'}) && ($arg{'row_height'} > $min_row_h) ? $arg{'row_height'} : $min_row_h;
|
||
|
|
||
|
my $pg_cnt = 1;
|
||
|
my $cur_y = $ybase;
|
||
|
my $cell_props = $arg{cell_props} || []; # per cell properties
|
||
|
my $row_cnt = $num_header_rows;
|
||
|
|
||
|
#If there is valid data array reference use it!
|
||
|
if (ref $data eq 'ARRAY') {
|
||
|
|
||
|
# Copy the header row if header is enabled
|
||
|
if (defined $header_props) {
|
||
|
map { push @header_rows, $$data[$_] } (0..$num_header_rows - 1);
|
||
|
map { push @header_row_cell_props, $$cell_props[$_] } (0..$num_header_rows - 1);
|
||
|
}
|
||
|
@$header_row = $$data[0] if defined $header_props;
|
||
|
# Determine column widths based on content
|
||
|
|
||
|
# an arrayref whose values are a hashref holding
|
||
|
# an arrayref whose values are a hashref holding
|
||
|
# the minimum and maximum width of that column
|
||
|
my $col_props = $arg{'column_props'} || [];
|
||
|
|
||
|
# An array ref of arrayrefs whose values are
|
||
|
# An array ref of arrayrefs whose values are
|
||
|
# the actual widths of the column/row intersection
|
||
|
my $row_props = [];
|
||
|
# An array ref with the widths of the header row
|
||
|
my @header_row_widths;
|
||
|
|
||
|
# Scalars that hold sum of the maximum and minimum widths of all columns
|
||
|
my ( $max_col_w, $min_col_w ) = ( 0,0 );
|
||
|
my $row_col_widths = [];
|
||
|
# An array ref with the widths of the header row
|
||
|
my $header_row_props = [];
|
||
|
|
||
|
# Scalars that hold sum of the maximum and minimum widths of all columns
|
||
|
my ( $max_col_w , $min_col_w ) = ( 0,0 );
|
||
|
my ( $row, $col_name, $col_fnt_size, $space_w );
|
||
|
|
||
|
# Hash that will hold the width of every word from input text
|
||
|
my $word_w = {};
|
||
|
my $rows_counter = 0;
|
||
|
|
||
|
foreach $row ( @{$data} ) {
|
||
|
push(@header_row_widths, []) if ($rows_counter < $num_header_rows);
|
||
|
my $word_widths = {};
|
||
|
my $rows_height = [];
|
||
|
my $first_row = 1;
|
||
|
|
||
|
my $column_widths = []; #holds the width of each column
|
||
|
for( my $j = 0; $j < scalar(@$row) ; $j++ ) {
|
||
|
# look for font information for this column
|
||
|
$col_fnt_size = $col_props->[$j]->{'font_size'} || $fnt_size;
|
||
|
if ( !$rows_counter and ref $header_props) {
|
||
|
$txt->font( $header_props->{'font'}, $header_props->{'font_size'} );
|
||
|
|
||
|
} elsif ( $col_props->[$j]->{'font'} ) {
|
||
|
$txt->font( $col_props->[$j]->{'font'}, $col_fnt_size );
|
||
|
|
||
|
} else {
|
||
|
$txt->font( $fnt_name, $col_fnt_size );
|
||
|
}
|
||
|
|
||
|
# This should fix a bug with very long word like serial numbers etc.
|
||
|
# $myone is used because $1 gets out of scope in while condition
|
||
|
my $myone;
|
||
|
do {
|
||
|
$myone = 0;
|
||
|
# This RegEx will split any word that is longer than {25} symbols
|
||
|
$row->[$j] =~ s#(\b\S{$max_word_len}?)(\S.*?\b)# $1 $2#;
|
||
|
$myone = 1 if ( defined $2 );
|
||
|
} while( $myone );
|
||
|
$row->[$j] =~ s/^\s+//;
|
||
|
|
||
|
$space_w = $txt->advancewidth( "\x20" );
|
||
|
$column_widths->[$j] = 0;
|
||
|
$max_col_w = 0;
|
||
|
$min_col_w = 0;
|
||
|
|
||
|
my @words = split( /\s+/, $row->[$j] );
|
||
|
|
||
|
foreach( @words ) {
|
||
|
unless ( exists $word_w->{$_} ) { # Calculate the width of every word and add the space width to it
|
||
|
$word_w->{$_} = $txt->advancewidth( $_ ) + $space_w;
|
||
|
}
|
||
|
$column_widths->[$j] += $word_w->{$_};
|
||
|
$min_col_w = $word_w->{$_} if $word_w->{$_} > $min_col_w;
|
||
|
$max_col_w += $word_w->{$_};
|
||
|
}
|
||
|
$min_col_w += $pad_w;
|
||
|
$max_col_w += $pad_w;
|
||
|
$column_widths->[$j] += $pad_w;
|
||
|
for( my $row_idx = 0; $row_idx < scalar(@$data) ; $row_idx++ )
|
||
|
{
|
||
|
my $column_widths = []; #holds the width of each column
|
||
|
# Init the height for this row
|
||
|
$rows_height->[$row_idx] = 0;
|
||
|
|
||
|
for( my $column_idx = 0; $column_idx < scalar(@{$data->[$row_idx]}) ; $column_idx++ )
|
||
|
{
|
||
|
# look for font information for this column
|
||
|
my ($cell_font, $cell_font_size);
|
||
|
|
||
|
if( !$row_idx and ref $header_props )
|
||
|
{
|
||
|
$cell_font = $header_props->{'font'};
|
||
|
$cell_font_size = $header_props->{'font_size'};
|
||
|
}
|
||
|
|
||
|
# Get the most specific value if none was already set from header_props
|
||
|
$cell_font ||= $cell_props->[$row_idx][$column_idx]->{'font'}
|
||
|
|| $col_props->[$column_idx]->{'font'}
|
||
|
|| $fnt_name;
|
||
|
|
||
|
$cell_font_size ||= $cell_props->[$row_idx][$column_idx]->{'font_size'}
|
||
|
|| $col_props->[$column_idx]->{'font_size'}
|
||
|
|| $fnt_size;
|
||
|
|
||
|
# Set Font
|
||
|
$txt->font( $cell_font, $cell_font_size );
|
||
|
|
||
|
# Set row height to biggest font size from row's cells
|
||
|
if( $cell_font_size > $rows_height->[$row_idx] )
|
||
|
{
|
||
|
$rows_height->[$row_idx] = $cell_font_size;
|
||
|
}
|
||
|
|
||
|
# Keep a running total of the overall min and max widths
|
||
|
$col_props->[$j]->{min_w} = $col_props->[$j]->{min_w} || 0;
|
||
|
$col_props->[$j]->{max_w} = $col_props->[$j]->{max_w} || 0;
|
||
|
# This should fix a bug with very long words like serial numbers etc.
|
||
|
if( $max_word_len > 0 )
|
||
|
{
|
||
|
$data->[$row_idx][$column_idx] =~ s#(\S{$max_word_len})(?=\S)#$1 #g;
|
||
|
}
|
||
|
|
||
|
if ( $min_col_w > $col_props->[$j]->{min_w} ) { # Calculated Minimum Column Width is more than user-defined
|
||
|
$col_props->[$j]->{min_w} = $min_col_w ;
|
||
|
}
|
||
|
if ( $max_col_w > $col_props->[$j]->{max_w} ) { # Calculated Maximum Column Width is more than user-defined
|
||
|
$col_props->[$j]->{max_w} = $max_col_w ;
|
||
|
}
|
||
|
}#End of for(my $j....
|
||
|
$row_props->[$rows_counter] = $column_widths;
|
||
|
# Copy the calculated row properties of header row.
|
||
|
if (($rows_counter < $num_header_rows) && $header_props) {
|
||
|
push(@header_row_widths, [ @{ $column_widths } ]);
|
||
|
}
|
||
|
$rows_counter++;
|
||
|
# Init cell size limits
|
||
|
$space_w = $txt->advancewidth( "\x20" );
|
||
|
$column_widths->[$column_idx] = 0;
|
||
|
$max_col_w = 0;
|
||
|
$min_col_w = 0;
|
||
|
|
||
|
my @words = split( /\s+/, $data->[$row_idx][$column_idx] );
|
||
|
|
||
|
foreach( @words )
|
||
|
{
|
||
|
unless( exists $word_widths->{$_} )
|
||
|
{ # Calculate the width of every word and add the space width to it
|
||
|
$word_widths->{$_} = $txt->advancewidth( $_ ) + $space_w;
|
||
|
}
|
||
|
|
||
|
$column_widths->[$column_idx] += $word_widths->{$_};
|
||
|
$min_col_w = $word_widths->{$_} if( $word_widths->{$_} > $min_col_w );
|
||
|
$max_col_w += $word_widths->{$_};
|
||
|
}
|
||
|
|
||
|
$min_col_w += $pad_left + $pad_right;
|
||
|
$max_col_w += $pad_left + $pad_right;
|
||
|
$column_widths->[$column_idx] += $pad_left + $pad_right;
|
||
|
|
||
|
# Keep a running total of the overall min and max widths
|
||
|
$col_props->[$column_idx]->{'min_w'} ||= 0;
|
||
|
$col_props->[$column_idx]->{'max_w'} ||= 0;
|
||
|
|
||
|
if( $min_col_w > $col_props->[$column_idx]->{'min_w'} )
|
||
|
{ # Calculated Minimum Column Width is more than user-defined
|
||
|
$col_props->[$column_idx]->{'min_w'} = $min_col_w ;
|
||
|
}
|
||
|
|
||
|
if( $max_col_w > $col_props->[$column_idx]->{'max_w'} )
|
||
|
{ # Calculated Maximum Column Width is more than user-defined
|
||
|
$col_props->[$column_idx]->{'max_w'} = $max_col_w ;
|
||
|
}
|
||
|
}#End of for(my $column_idx....
|
||
|
|
||
|
$row_col_widths->[$row_idx] = $column_widths;
|
||
|
|
||
|
# Copy the calculated row properties of header row.
|
||
|
@$header_row_props = @$column_widths if(!$row_idx and ref $header_props);
|
||
|
}
|
||
|
|
||
|
# Calc real column widths and expand table width if needed.
|
||
|
my $calc_column_widths;
|
||
|
($calc_column_widths, $width) = $self->CalcColumnWidths( $col_props, $width );
|
||
|
my $num_cols = scalar @{ $calc_column_widths };
|
||
|
my $comp_cnt = 1;
|
||
|
$rows_counter = 0;
|
||
|
my $calc_column_widths;
|
||
|
($calc_column_widths, $width) = CalcColumnWidths( $col_props, $width );
|
||
|
|
||
|
my ( $gfx , $gfx_bg , $background_color , $font_color, );
|
||
|
my ( $bot_marg, $table_top_y, $text_start , $record, $record_widths );
|
||
|
# Lets draw what we have!
|
||
|
my $row_index = 0;
|
||
|
# Store header row height for later use if headers have to be repeated
|
||
|
my $header_row_height = $rows_height->[0];
|
||
|
|
||
|
my $remaining_header_rows = $header_props ? $num_header_rows : 0;
|
||
|
my ( $gfx, $gfx_bg, $background_color, $font_color, $bot_marg, $table_top_y, $text_start);
|
||
|
|
||
|
# Each iteration adds a new page as neccessary
|
||
|
while(scalar(@{$data})) {
|
||
|
my $page_header;
|
||
|
if ($pg_cnt == 1) {
|
||
|
$table_top_y = $ybase;
|
||
|
$bot_marg = $table_top_y - $height;
|
||
|
|
||
|
} else {
|
||
|
if (ref $arg{'new_page_func'}) {
|
||
|
$page = &{$arg{'new_page_func'}};
|
||
|
|
||
|
} else {
|
||
|
$page = $pdf->page;
|
||
|
}
|
||
|
|
||
|
$table_top_y = $next_y;
|
||
|
$bot_marg = $table_top_y - $next_h;
|
||
|
while(scalar(@{$data}))
|
||
|
{
|
||
|
my ($page_header, $columns_number);
|
||
|
|
||
|
if ( ref $header_props and $header_props->{'repeat'}) {
|
||
|
foreach my $idx (0 .. $num_header_rows - 1) {
|
||
|
unshift @$data, [ @{ $header_rows[$idx] } ];
|
||
|
unshift @$row_props, [ @{ $header_row_widths[$idx] } ];
|
||
|
}
|
||
|
$remaining_header_rows = $num_header_rows;
|
||
|
if($pg_cnt == 1)
|
||
|
{
|
||
|
$table_top_y = $ybase;
|
||
|
$bot_marg = $table_top_y - $height;
|
||
|
}
|
||
|
}
|
||
|
|
||
|
# Check for safety reasons
|
||
|
if ( $bot_marg < 0 ) { # This warning should remain i think
|
||
|
# print "!!! Warning: !!! Incorrect Table Geometry! Setting bottom margin to end of sheet!\n";
|
||
|
$bot_marg = 0;
|
||
|
}
|
||
|
|
||
|
$gfx_bg = $page->gfx;
|
||
|
$txt = $page->text;
|
||
|
$txt->font($fnt_name, $fnt_size);
|
||
|
$gfx = $page->gfx;
|
||
|
$gfx->strokecolor($border_color);
|
||
|
$gfx->linewidth($line_w);
|
||
|
|
||
|
# Draw the top line
|
||
|
$cur_y = $table_top_y;
|
||
|
$gfx->move( $xbase , $cur_y );
|
||
|
$gfx->hline($xbase + $width );
|
||
|
|
||
|
# Each iteration adds a row to the current page until the page is full
|
||
|
# or there are no more rows to add
|
||
|
while(scalar(@{$data}) and $cur_y-$row_h > $bot_marg) {
|
||
|
# Remove the next item from $data
|
||
|
$record = shift @{$data};
|
||
|
# Added to resolve infite loop bug with returned undef values
|
||
|
for(my $d = 0; $d < scalar(@{$record}) ; $d++) {
|
||
|
$record->[$d] = '-' unless ( defined $record->[$d]);
|
||
|
else
|
||
|
{
|
||
|
if(ref $arg{'new_page_func'})
|
||
|
{
|
||
|
$page = &{$arg{'new_page_func'}};
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
$page = $pdf->page;
|
||
|
}
|
||
|
|
||
|
$table_top_y = $next_y;
|
||
|
$bot_marg = $table_top_y - $next_h;
|
||
|
|
||
|
if( ref $header_props and $header_props->{'repeat'})
|
||
|
{
|
||
|
# Copy Header Data
|
||
|
@$page_header = @$header_row;
|
||
|
my $hrp ;
|
||
|
@$hrp = @$header_row_props ;
|
||
|
# Then prepend it to master data array
|
||
|
unshift @$data, @$page_header;
|
||
|
unshift @$row_col_widths, $hrp;
|
||
|
unshift @$rows_height, $header_row_height;
|
||
|
|
||
|
$first_row = 1; # Means YES
|
||
|
$row_index--; # Rollback the row_index because a new header row has been added
|
||
|
}
|
||
|
}
|
||
|
|
||
|
$record_widths = shift @$row_props;
|
||
|
next unless $record;
|
||
|
|
||
|
# Choose colors for this row
|
||
|
$background_color = $rows_counter % 2 ? $background_color_even : $background_color_odd;
|
||
|
$font_color = $rows_counter % 2 ? $font_color_even : $font_color_odd;
|
||
|
|
||
|
if ($remaining_header_rows and ref $header_props) {
|
||
|
$background_color = $header_props->{'bg_color'}
|
||
|
# Check for safety reasons
|
||
|
if( $bot_marg < 0 )
|
||
|
{ # This warning should remain i think
|
||
|
carp "!!! Warning: !!! Incorrect Table Geometry! Setting bottom margin to end of sheet!\n";
|
||
|
$bot_marg = 0;
|
||
|
}
|
||
|
$text_start = $cur_y - $fnt_size - $pad_top;
|
||
|
my $cur_x = $xbase;
|
||
|
my $leftovers = undef; # Reference to text that is returned from textblock()
|
||
|
my $do_leftovers = 0;
|
||
|
|
||
|
my ($colspan, @vertical_lines);
|
||
|
|
||
|
# Process every column from current row
|
||
|
for( my $j = 0; $j < scalar( @$record); $j++ ) {
|
||
|
next unless $col_props->[$j]->{max_w};
|
||
|
next unless $col_props->[$j]->{min_w};
|
||
|
$leftovers->[$j] = undef;
|
||
|
$gfx_bg = $page->gfx;
|
||
|
$txt = $page->text;
|
||
|
$txt->font($fnt_name, $fnt_size);
|
||
|
|
||
|
# Choose font color
|
||
|
if ( $remaining_header_rows and ref $header_props ) {
|
||
|
$txt->fillcolor( $header_props->{'font_color'} );
|
||
|
$cur_y = $table_top_y;
|
||
|
|
||
|
} elsif ( $cell_props->[$row_cnt][$j]{font_color} ) {
|
||
|
$txt->fillcolor( $cell_props->[$row_cnt][$j]{font_color} );
|
||
|
if ($line_w)
|
||
|
{
|
||
|
$gfx = $page->gfx;
|
||
|
$gfx->strokecolor($border_color);
|
||
|
$gfx->linewidth($line_w);
|
||
|
|
||
|
} elsif ( $col_props->[$j]->{'font_color'} ) {
|
||
|
$txt->fillcolor( $col_props->[$j]->{'font_color'} );
|
||
|
# Draw the top line
|
||
|
if ($horiz_borders)
|
||
|
{
|
||
|
$gfx->move( $xbase , $cur_y );
|
||
|
$gfx->hline($xbase + $width );
|
||
|
}
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
$gfx = undef;
|
||
|
}
|
||
|
|
||
|
} else {
|
||
|
$txt->fillcolor($font_color);
|
||
|
}
|
||
|
# Each iteration adds a row to the current page until the page is full
|
||
|
# or there are no more rows to add
|
||
|
# Row_Loop
|
||
|
while(scalar(@{$data}) and $cur_y-$row_h > $bot_marg)
|
||
|
{
|
||
|
# Remove the next item from $data
|
||
|
my $record = shift @{$data};
|
||
|
|
||
|
# Get columns number to know later how many vertical lines to draw
|
||
|
# TODO: get the max number of columns per page as currently last row's columns overrides
|
||
|
$columns_number = scalar(@$record);
|
||
|
|
||
|
# Get the next set of row related settings
|
||
|
# Row Height
|
||
|
my $pre_calculated_row_height = shift @$rows_height;
|
||
|
|
||
|
# Row cell widths
|
||
|
my $record_widths = shift @$row_col_widths;
|
||
|
|
||
|
# Row coloumn props - TODO in another commit
|
||
|
|
||
|
# Row cell props - TODO in another commit
|
||
|
|
||
|
# Added to resolve infite loop bug with returned undef values
|
||
|
for(my $d = 0; $d < scalar(@{$record}) ; $d++)
|
||
|
{
|
||
|
$record->[$d] = '-' unless( defined $record->[$d]);
|
||
|
}
|
||
|
|
||
|
# Choose font size
|
||
|
if ( $remaining_header_rows and ref $header_props ) {
|
||
|
$col_fnt_size = $header_props->{'font_size'};
|
||
|
# Choose colors for this row
|
||
|
$background_color = $row_index % 2 ? $background_color_even : $background_color_odd;
|
||
|
$font_color = $row_index % 2 ? $font_color_even : $font_color_odd;
|
||
|
|
||
|
} elsif ( $col_props->[$j]->{'font_size'} ) {
|
||
|
$col_fnt_size = $col_props->[$j]->{'font_size'};
|
||
|
#Determine current row height
|
||
|
my $current_row_height = $pad_top + $pre_calculated_row_height + $pad_bot;
|
||
|
|
||
|
} else {
|
||
|
$col_fnt_size = $fnt_size;
|
||
|
}
|
||
|
# $row_h is the calculated global user requested row height.
|
||
|
# It will be honored, only if it has bigger value than the calculated one.
|
||
|
# TODO: It's questionable if padding should be inclided in this calculation or not
|
||
|
if($current_row_height < $row_h){
|
||
|
$current_row_height = $row_h;
|
||
|
}
|
||
|
|
||
|
# Choose font family
|
||
|
if ( $remaining_header_rows and ref $header_props ) {
|
||
|
$txt->font( $header_props->{'font'}, $header_props->{'font_size'});
|
||
|
# Define the font y base position for this line.
|
||
|
$text_start = $cur_y - ($current_row_height - $pad_bot);
|
||
|
|
||
|
my $cur_x = $xbase;
|
||
|
my $leftovers = undef; # Reference to text that is returned from textblock()
|
||
|
my $do_leftovers = 0;
|
||
|
|
||
|
# Process every cell(column) from current row
|
||
|
for( my $column_idx = 0; $column_idx < scalar( @$record); $column_idx++ )
|
||
|
{
|
||
|
next unless $col_props->[$column_idx]->{'max_w'};
|
||
|
next unless $col_props->[$column_idx]->{'min_w'};
|
||
|
$leftovers->[$column_idx] = undef;
|
||
|
|
||
|
# look for font information for this cell
|
||
|
my ($cell_font, $cell_font_size, $cell_font_color, $justify);
|
||
|
|
||
|
if( $first_row and ref $header_props)
|
||
|
{
|
||
|
$cell_font = $header_props->{'font'};
|
||
|
$cell_font_size = $header_props->{'font_size'};
|
||
|
$cell_font_color = $header_props->{'font_color'};
|
||
|
$justify = $header_props->{'justify'};
|
||
|
}
|
||
|
|
||
|
# Get the most specific value if none was already set from header_props
|
||
|
$cell_font ||= $cell_props->[$row_index][$column_idx]->{'font'}
|
||
|
|| $col_props->[$column_idx]->{'font'}
|
||
|
|| $fnt_name;
|
||
|
|
||
|
$cell_font_size ||= $cell_props->[$row_index][$column_idx]->{'font_size'}
|
||
|
|| $col_props->[$column_idx]->{'font_size'}
|
||
|
|| $fnt_size;
|
||
|
|
||
|
$cell_font_color ||= $cell_props->[$row_index][$column_idx]->{'font_color'}
|
||
|
|| $col_props->[$column_idx]->{'font_color'}
|
||
|
|| $font_color;
|
||
|
|
||
|
$justify ||= $cell_props->[$row_index][$column_idx]->{'justify'}
|
||
|
|| $col_props->[$column_idx]->{'justify'}
|
||
|
|| $arg{'justify'}
|
||
|
|| 'left';
|
||
|
|
||
|
# Init cell font object
|
||
|
$txt->font( $cell_font, $cell_font_size );
|
||
|
$txt->fillcolor($cell_font_color);
|
||
|
|
||
|
# If the content is wider than the specified width, we need to add the text as a text block
|
||
|
if( $record->[$column_idx] !~ m/(.\n.)/ and
|
||
|
$record_widths->[$column_idx] and
|
||
|
$record_widths->[$column_idx] <= $calc_column_widths->[$column_idx]
|
||
|
){
|
||
|
my $space = $pad_left;
|
||
|
if ($justify eq 'right')
|
||
|
{
|
||
|
$space = $calc_column_widths->[$column_idx] -($txt->advancewidth($record->[$column_idx]) + $pad_right);
|
||
|
}
|
||
|
elsif ($justify eq 'center')
|
||
|
{
|
||
|
$space = ($calc_column_widths->[$column_idx] - $txt->advancewidth($record->[$column_idx])) / 2;
|
||
|
}
|
||
|
$txt->translate( $cur_x + $space, $text_start );
|
||
|
$txt->text( $record->[$column_idx] );
|
||
|
}
|
||
|
# Otherwise just use the $page->text() method
|
||
|
else
|
||
|
{
|
||
|
my ($width_of_last_line, $ypos_of_last_line, $left_over_text) = $self->text_block(
|
||
|
$txt,
|
||
|
$record->[$column_idx],
|
||
|
x => $cur_x + $pad_left,
|
||
|
y => $text_start,
|
||
|
w => $calc_column_widths->[$column_idx] - $pad_left - $pad_right,
|
||
|
h => $cur_y - $bot_marg - $pad_top - $pad_bot,
|
||
|
align => $justify,
|
||
|
lead => $lead
|
||
|
);
|
||
|
# Desi - Removed $lead because of fixed incorrect ypos bug in text_block
|
||
|
my $current_cell_height = $cur_y - $ypos_of_last_line + $pad_bot;
|
||
|
if( $current_cell_height > $current_row_height )
|
||
|
{
|
||
|
$current_row_height = $current_cell_height;
|
||
|
}
|
||
|
|
||
|
if( $left_over_text )
|
||
|
{
|
||
|
$leftovers->[$column_idx] = $left_over_text;
|
||
|
$do_leftovers = 1;
|
||
|
}
|
||
|
}
|
||
|
$cur_x += $calc_column_widths->[$column_idx];
|
||
|
}
|
||
|
if( $do_leftovers )
|
||
|
{
|
||
|
unshift @$data, $leftovers;
|
||
|
unshift @$row_col_widths, $record_widths;
|
||
|
unshift @$rows_height, $pre_calculated_row_height;
|
||
|
}
|
||
|
|
||
|
# Draw cell bgcolor
|
||
|
# This has to be separately from the text loop
|
||
|
# because we do not know the final height of the cell until all text has been drawn
|
||
|
$cur_x = $xbase;
|
||
|
for(my $column_idx = 0 ; $column_idx < scalar(@$record) ; $column_idx++)
|
||
|
{
|
||
|
my $cell_bg_color;
|
||
|
|
||
|
if( $first_row and ref $header_props)
|
||
|
{ #Compatibility Consistency with other props
|
||
|
$cell_bg_color = $header_props->{'bg_color'} || $header_props->{'background_color'};
|
||
|
}
|
||
|
|
||
|
# Get the most specific value if none was already set from header_props
|
||
|
$cell_bg_color ||= $cell_props->[$row_index][$column_idx]->{'background_color'}
|
||
|
|| $col_props->[$column_idx]->{'background_color'}
|
||
|
|| $background_color;
|
||
|
|
||
|
if ($cell_bg_color)
|
||
|
{
|
||
|
$gfx_bg->rect( $cur_x, $cur_y-$current_row_height, $calc_column_widths->[$column_idx], $current_row_height);
|
||
|
$gfx_bg->fillcolor($cell_bg_color);
|
||
|
$gfx_bg->fill();
|
||
|
}
|
||
|
$cur_x += $calc_column_widths->[$column_idx];
|
||
|
}#End of for(my $column_idx....
|
||
|
|
||
|
$cur_y -= $current_row_height;
|
||
|
if ($gfx && $horiz_borders)
|
||
|
{
|
||
|
$gfx->move( $xbase , $cur_y );
|
||
|
$gfx->hline( $xbase + $width );
|
||
|
}
|
||
|
|
||
|
} elsif ( $col_props->[$j]->{'font'} ) {
|
||
|
$txt->font( $col_props->[$j]->{'font'}, $col_fnt_size);
|
||
|
$row_index++ unless ( $do_leftovers );
|
||
|
$first_row = 0;
|
||
|
}# End of Row_Loop
|
||
|
|
||
|
if ($gfx)
|
||
|
{
|
||
|
# Draw vertical lines
|
||
|
if ($vert_borders)
|
||
|
{
|
||
|
$gfx->move( $xbase, $table_top_y);
|
||
|
$gfx->vline( $cur_y );
|
||
|
my $cur_x = $xbase;
|
||
|
for( my $j = 0; $j < $columns_number; $j++ )
|
||
|
{
|
||
|
$cur_x += $calc_column_widths->[$j];
|
||
|
$gfx->move( $cur_x, $table_top_y );
|
||
|
$gfx->vline( $cur_y );
|
||
|
}
|
||
|
}
|
||
|
|
||
|
} else {
|
||
|
$txt->font( $fnt_name, $col_fnt_size);
|
||
|
}
|
||
|
#TODO: Implement Center text align
|
||
|
$col_props->[$j]->{justify} = $col_props->[$j]->{justify} || 'left';
|
||
|
# ACTUALLY draw all the lines
|
||
|
$gfx->fillcolor( $border_color);
|
||
|
$gfx->stroke;
|
||
|
}
|
||
|
$pg_cnt++;
|
||
|
}# End of while(scalar(@{$data}))
|
||
|
|
||
|
my $this_width;
|
||
|
if (!$remaining_header_rows && $cell_props->[$row_cnt]->[$j]->{colspan}) {
|
||
|
$colspan = $cell_props->[$row_cnt]->[$j]->{colspan};
|
||
|
return ($page,--$pg_cnt,$cur_y);
|
||
|
}
|
||
|
|
||
|
} elsif ($remaining_header_rows && $header_row_cell_props[$num_header_rows - $remaining_header_rows]->[$j]->{colspan}) {
|
||
|
$colspan = $header_row_cell_props[$num_header_rows - $remaining_header_rows]->[$j]->{colspan};
|
||
|
|
||
|
}
|
||
|
# calculate the column widths
|
||
|
sub CalcColumnWidths
|
||
|
{
|
||
|
my $col_props = shift;
|
||
|
my $avail_width = shift;
|
||
|
my $min_width = 0;
|
||
|
|
||
|
if ($colspan) {
|
||
|
$colspan = $num_cols - $j if (-1 == $colspan);
|
||
|
my $last_idx = $j + $colspan - 1;
|
||
|
$this_width = sum @{ $calc_column_widths }[$j..$last_idx];
|
||
|
my $calc_widths ;
|
||
|
|
||
|
} else {
|
||
|
$this_width = $calc_column_widths->[$j];
|
||
|
}
|
||
|
for(my $j = 0; $j < scalar( @$col_props); $j++)
|
||
|
{
|
||
|
$min_width += $col_props->[$j]->{min_w} || 0;
|
||
|
}
|
||
|
|
||
|
# If the content is wider than the specified width, we need to add the text as a text block
|
||
|
if ($record->[$j] !~ m#(.\n.)# and $record_widths->[$j] and ($record_widths->[$j] < $this_width)) {
|
||
|
my $space = $pad_left;
|
||
|
if ($col_props->[$j]->{justify} eq 'right') {
|
||
|
$space = $this_width -($txt->advancewidth($record->[$j]) + $pad_right);
|
||
|
}
|
||
|
$txt->translate( $cur_x + $space, $text_start );
|
||
|
$txt->text( $record->[$j] );
|
||
|
} else { # Otherwise just use the $page->text() method
|
||
|
my($width_of_last_line, $ypos_of_last_line, $left_over_text) =
|
||
|
$self->text_block($txt,
|
||
|
$record->[$j],
|
||
|
'x' => $cur_x + $pad_left,
|
||
|
'y' => $text_start,
|
||
|
'w' => $this_width - $pad_w,
|
||
|
'h' => $cur_y - $bot_marg - $pad_top - $pad_bot,
|
||
|
'align' => $col_props->[$j]->{justify},
|
||
|
'lead' => $lead
|
||
|
);
|
||
|
# Desi - Removed $lead because of fixed incorrect ypos bug in text_block
|
||
|
my $this_row_h = $cur_y - ( $ypos_of_last_line - $pad_bot );
|
||
|
$row_h = $this_row_h if $this_row_h > $row_h;
|
||
|
if ( $left_over_text ) {
|
||
|
$leftovers->[$j] = $left_over_text;
|
||
|
$do_leftovers = 1;
|
||
|
}
|
||
|
}
|
||
|
$cur_x += $calc_column_widths->[$j];
|
||
|
# I think this is the optimal variant when good view can be guaranateed
|
||
|
if($avail_width < $min_width)
|
||
|
{
|
||
|
carp "!!! Warning !!!\n Calculated Mininal width($min_width) > Table width($avail_width).\n",
|
||
|
' Expanding table width to:',int($min_width)+1,' but this could lead to unexpected results.',"\n",
|
||
|
' Possible solutions:',"\n",
|
||
|
' 0)Increase table width.',"\n",
|
||
|
' 1)Decrease font size.',"\n",
|
||
|
' 2)Choose a more narrow font.',"\n",
|
||
|
' 3)Decrease "max_word_length" parameter.',"\n",
|
||
|
' 4)Rotate page to landscape(if it is portrait).',"\n",
|
||
|
' 5)Use larger paper size.',"\n",
|
||
|
'!!! --------- !!!',"\n";
|
||
|
$avail_width = int( $min_width) + 1;
|
||
|
|
||
|
push @vertical_lines, (!$colspan || (1 >= $colspan)) ? 1 : 0;
|
||
|
$colspan-- if ($colspan);
|
||
|
}
|
||
|
}
|
||
|
|
||
|
if ( $do_leftovers ) {
|
||
|
unshift @$data, $leftovers;
|
||
|
unshift @$row_props, $record_widths;
|
||
|
$rows_counter--;
|
||
|
}
|
||
|
# Calculate how much can be added to every column to fit the available width.
|
||
|
for(my $j = 0; $j < scalar(@$col_props); $j++ )
|
||
|
{
|
||
|
$calc_widths->[$j] = $col_props->[$j]->{min_w} || 0;;
|
||
|
}
|
||
|
|
||
|
# Draw cell bgcolor
|
||
|
# This has to be separately from the text loop
|
||
|
# because we do not know the final height of the cell until all text has been drawn
|
||
|
$cur_x = $xbase;
|
||
|
for(my $j =0;$j < scalar(@$record);$j++) {
|
||
|
if ( $cell_props->[$row_cnt][$j]->{'background_color'} ||
|
||
|
$col_props->[$j]->{'background_color'} ||
|
||
|
$background_color ) {
|
||
|
$gfx_bg->rect( $cur_x, $cur_y-$row_h, $calc_column_widths->[$j], $row_h);
|
||
|
if ( $cell_props->[$row_cnt][$j]->{'background_color'} && !$remaining_header_rows ) {
|
||
|
$gfx_bg->fillcolor($cell_props->[$row_cnt][$j]->{'background_color'});
|
||
|
|
||
|
} elsif ( $col_props->[$j]->{'background_color'} && !$remaining_header_rows ) {
|
||
|
$gfx_bg->fillcolor($col_props->[$j]->{'background_color'});
|
||
|
|
||
|
} else {
|
||
|
$gfx_bg->fillcolor($background_color);
|
||
|
# Allow columns to expand to max_w before applying extra space equally.
|
||
|
my $is_last_iter;
|
||
|
for (;;)
|
||
|
{
|
||
|
my $span = ($avail_width - $min_width) / scalar( @$col_props);
|
||
|
last if $span <= 0;
|
||
|
|
||
|
$min_width = 0;
|
||
|
my $next_will_be_last_iter = 1;
|
||
|
for(my $j = 0; $j < scalar(@$col_props); $j++ )
|
||
|
{
|
||
|
my $new_w = $calc_widths->[$j] + $span;
|
||
|
|
||
|
if (!$is_last_iter && $new_w > $col_props->[$j]->{max_w})
|
||
|
{
|
||
|
$new_w = $col_props->[$j]->{max_w}
|
||
|
}
|
||
|
$gfx_bg->fill();
|
||
|
}
|
||
|
|
||
|
$cur_x += $calc_column_widths->[$j];
|
||
|
|
||
|
if ($line_w && $vertical_lines[$j] && ($j != (scalar(@{ $record }) - 1))) {
|
||
|
$gfx->move($cur_x, $cur_y);
|
||
|
$gfx->vline($cur_y - $row_h);
|
||
|
$gfx->fillcolor($border_color);
|
||
|
}
|
||
|
}#End of for(my $j....
|
||
|
|
||
|
$cur_y -= $row_h;
|
||
|
$row_h = $min_row_h;
|
||
|
$gfx->move( $xbase , $cur_y );
|
||
|
$gfx->hline( $xbase + $width );
|
||
|
$rows_counter++;
|
||
|
if ($remaining_header_rows) {
|
||
|
$remaining_header_rows--;
|
||
|
} else {
|
||
|
$row_cnt++ unless $do_leftovers;
|
||
|
if ($calc_widths->[$j] != $new_w )
|
||
|
{
|
||
|
$calc_widths->[$j] = $new_w;
|
||
|
$next_will_be_last_iter = 0;
|
||
|
}
|
||
|
$min_width += $new_w;
|
||
|
}
|
||
|
}# End of while(scalar(@{$data}) and $cur_y-$row_h > $bot_marg)
|
||
|
|
||
|
# Draw vertical lines
|
||
|
if ($line_w) {
|
||
|
$gfx->move($xbase, $table_top_y);
|
||
|
$gfx->vline($cur_y);
|
||
|
$gfx->move($xbase + sum(@{ $calc_column_widths }[0..$num_cols - 1]), $table_top_y);
|
||
|
$gfx->vline($cur_y);
|
||
|
$gfx->fillcolor($border_color);
|
||
|
$gfx->stroke();
|
||
|
}
|
||
|
$pg_cnt++;
|
||
|
}# End of while(scalar(@{$data}))
|
||
|
}# End of if (ref $data eq 'ARRAY')
|
||
|
|
||
|
return ($page,--$pg_cnt,$cur_y);
|
||
|
}
|
||
|
|
||
|
last if $is_last_iter;
|
||
|
$is_last_iter = $next_will_be_last_iter;
|
||
|
}
|
||
|
|
||
|
# calculate the column widths
|
||
|
sub CalcColumnWidths {
|
||
|
my $self = shift;
|
||
|
my $col_props = shift;
|
||
|
my $avail_width = shift;
|
||
|
my $min_width = 0;
|
||
|
|
||
|
my $calc_widths ;
|
||
|
for(my $j = 0; $j < scalar( @$col_props); $j++) {
|
||
|
$min_width += $col_props->[$j]->{min_w};
|
||
|
}
|
||
|
|
||
|
# I think this is the optimal variant when good view can be guaranateed
|
||
|
if ($avail_width < $min_width) {
|
||
|
# print "!!! Warning !!!\n Calculated Mininal width($min_width) > Table width($avail_width).\n",
|
||
|
# ' Expanding table width to:',int($min_width)+1,' but this could lead to unexpected results.',"\n",
|
||
|
# ' Possible solutions:',"\n",
|
||
|
# ' 0)Increase table width.',"\n",
|
||
|
# ' 1)Decrease font size.',"\n",
|
||
|
# ' 2)Choose a more narrow font.',"\n",
|
||
|
# ' 3)Decrease "max_word_length" parameter.',"\n",
|
||
|
# ' 4)Rotate page to landscape(if it is portrait).',"\n",
|
||
|
# ' 5)Use larger paper size.',"\n",
|
||
|
# '!!! --------- !!!',"\n";
|
||
|
$avail_width = int( $min_width) + 1;
|
||
|
|
||
|
}
|
||
|
|
||
|
my $span = 0;
|
||
|
# Calculate how much can be added to every column to fit the available width
|
||
|
$span = ($avail_width - $min_width) / scalar( @$col_props);
|
||
|
for (my $j = 0; $j < scalar(@$col_props); $j++ ) {
|
||
|
$calc_widths->[$j] = $col_props->[$j]->{min_w} + $span;
|
||
|
}
|
||
|
|
||
|
return ($calc_widths,$avail_width);
|
||
|
return ($calc_widths,$avail_width);
|
||
|
}
|
||
|
1;
|
||
|
|
||
| ... | ... | |
|
$some_data,
|
||
|
x => $left_edge_of_table,
|
||
|
w => 495,
|
||
|
start_y => 750,
|
||
|
next_y => 700,
|
||
|
start_y => 500,
|
||
|
start_h => 300,
|
||
|
next_h => 500,
|
||
|
# some optional params
|
||
|
next_y => 750,
|
||
|
next_h => 500,
|
||
|
padding => 5,
|
||
|
padding_right => 10,
|
||
|
background_color_odd => "gray",
|
||
| ... | ... | |
|
|
||
|
=head1 DESCRIPTION
|
||
|
|
||
|
This class is a utility for use with the PDF::API2 module from CPAN.
|
||
|
It can be used to display text data in a table layout within the PDF.
|
||
|
The text data must be in a 2d array (such as returned by a DBI statement handle fetchall_arrayref() call).
|
||
|
The PDF::Table will automatically add as many new pages as necessary to display all of the data.
|
||
|
Various layout properties, such as font, font size, and cell padding and background color can be specified for each column and/or for even/odd rows.
|
||
|
Also a (non)repeated header row with different layout properties can be specified.
|
||
|
This class is a utility for use with the PDF::API2 module from CPAN.
|
||
|
It can be used to display text data in a table layout within a PDF.
|
||
|
The text data must be in a 2D array (such as returned by a DBI statement handle fetchall_arrayref() call).
|
||
|
The PDF::Table will automatically add as many new pages as necessary to display all of the data.
|
||
|
Various layout properties, such as font, font size, and cell padding and background color can be specified for each column and/or for even/odd rows.
|
||
|
Also a (non)repeated header row with different layout properties can be specified.
|
||
|
|
||
|
See the METHODS section for complete documentation of every parameter.
|
||
Auch abrufbar als: Unified diff
PDF::Table update auf aktuelle Version aus git
cpan speist sich aus https://github.com/kamenov/PDF-Table
Diese hier ist aktuell aus Commit 5a9f499