File Coverage

blib/lib/PDF/Table.pm

Criterion	Covered	Total	%
statement	552	710	77.7
branch	183	320	57.1
condition	162	293	55.2
subroutine	17	17	100.0
pod	3	9	33.3
total	917	1349	67.9

line	stmt	bran	cond	sub	pod	time	code
1							#!/usr/bin/env perl
2							# vim: softtabstop=4 tabstop=4 shiftwidth=4 ft=perl expandtab smarttab
3
4	4			4		301153	use 5.010;
	4					47
5	4			4		24	use strict;
	4					7
	4					101
6	4			4		21	use warnings;
	4					8
	4					148
7
8							package PDF::Table;
9
10							# portions (c) copyright 2004 Stone Environmental Inc.
11							# (c) copyright 2006 Daemmon Hughes
12							# (c) copyright 2020 - 2023 by Phil M. Perry
13
14	4			4		22	use Carp;
	4					18
	4					326
15	4			4		28	use List::Util qw[min max]; # core
	4					8
	4					546
16
17	4			4		1912	use PDF::Table::ColumnWidth;
	4					10
	4					141
18	4			4		1925	use PDF::Table::Settings;
	4					11
	4					31296
19							# can't move text_block() b/c many globals referenced
20
21							our $VERSION = '1.005'; # fixed, read by Makefile.PL
22							our $LAST_UPDATE = '1.005'; # manually update whenever code is changed
23							# don't forget to update VERSION down in POD area
24
25							my $compat_mode = 0; # 0 = new behaviors, 1 = compatible with old
26							# NOTE that a number of t-tests will FAIL in mode 1 (compatible with old)
27							# due to slightly different text placements
28
29							# ================ COMPATIBILITY WITH OLDER VERSIONS ===============
30							my $repeat_default = 1; # header repeat: old = change to 0
31							my $oddeven_default = 1; # odd/even lines, use old method = change to 0
32							my $padding_default = 2; # 2 points of padding. old = 0 (no padding)
33							# ==================================================================
34							if ($compat_mode) { # 1: be compatible with older PDF::Table behavior
35							($repeat_default, $oddeven_default, $padding_default) = (0, 0, 0);
36							} else { # 0: do not force compatibility with older PDF::Table behavior
37							($repeat_default, $oddeven_default, $padding_default) = (1, 1, 2);
38							}
39
40							# ================ OTHER GLOBAL DEFAULTS =========================== per #7
41							my $fg_color_default = 'black'; # foreground text color
42							# no bg_color_default (defaults to transparent background)
43							my $h_fg_color_default = '#000066'; # fg text color for header
44							my $h_bg_color_default = '#FFFFAA'; # bg color for header
45							my $font_size_default = 12; # base font size
46							my $leading_ratio = 1.25; # leading/font_size ratio (if 'lead' not given)
47							my $border_w_default = 1; # line width for borders
48							my $max_wordlen_default = 20; # split any run of 20 non-space chars
49							my $empty_cell_text = '-'; # something to put in an empty cell
50							my $dashed_rule_default = 2; # dash/space pattern length for broken rows
51							my $min_col_width = 2; # absolute minimum width of a column, > 0
52							# ==================================================================
53							my $ink = 1; # by default, actually make PDF output
54
55							print __PACKAGE__.' is version: '.$VERSION.$/ if ($ENV{'PDF_TABLE_DEBUG'});
56
57							############################################################
58							#
59							# new - Constructor
60							#
61							# Parameters are meta information about the PDF. They may be
62							# omitted, so long as the information is passed instead to
63							# the table() method.
64							#
65							# $pdf = PDF::Table->new();
66							# $page = $pdf->page();
67							# $data
68							# %options
69							#
70							############################################################
71
72							sub new {
73	7			7	1	4478	my $type = shift(@_);
74	7		33			46	my $class = ref($type) \|\| $type;
75	7					20	my $self = {};
76	7					17	bless ($self, $class);
77
78							# Pass all the rest to init for validation and initialization
79	7					31	$self->_init(@_);
80
81	7					54	return $self;
82							}
83
84							sub _init {
85	7			7		27	my ($self, $pdf, $page, $data, %options ) = @_;
86
87							# Check and set default values
88	7					28	$self->set_defaults();
89
90							# Check and set mandatory parameters
91	7					28	$self->set_pdf($pdf);
92	7					28	$self->set_page($page);
93	7					22	$self->set_data($data);
94	7					24	$self->set_options(\%options);
95
96	7					12	return;
97							}
98
99							sub set_defaults {
100	7			7	0	19	my $self = shift;
101
102	7					25	$self->{'font_size'} = $font_size_default;
103	7					30	$min_col_width = max($min_col_width, 1); # minimum width
104	7					16	return;
105							}
106
107							sub set_pdf {
108	7			7	0	17	my ($self, $pdf) = @_;
109	7					27	$self->{'pdf'} = $pdf;
110	7					14	return;
111							}
112
113							sub set_page {
114	7			7	0	20	my ($self, $page) = @_;
115	7	50	33			48	if ( defined($page) && ref($page) ne 'PDF::API2::Page'
			33
116							&& ref($page) ne 'PDF::Builder::Page' ) {
117
118	0	0	0			0	if (ref($self->{'pdf'}) eq 'PDF::API2' \|\|
119							ref($self->{'pdf'}) eq 'PDF::Builder') {
120	0					0	$self->{'page'} = $self->{'pdf'}->page();
121							} else {
122	0					0	carp 'Warning: Page must be a PDF::API2::Page or PDF::Builder::Page object but it seems to be: '.ref($page).$/;
123	0					0	carp 'Error: Cannot set page from passed PDF object either, as it is invalid!'.$/;
124							}
125	0					0	return;
126							}
127	7					21	$self->{'page'} = $page;
128	7					12	return;
129							}
130
131							sub set_data {
132	7			7	0	21	my ($self, $data) = @_;
133							# TODO: implement
134	7					12	return;
135							}
136
137							sub set_options {
138	7			7	0	18	my ($self, $options) = @_;
139							# TODO: implement
140	7					11	return;
141							}
142
143							################################################################
144							# table - utility method to build multi-row, multicolumn tables
145							################################################################
146
147							sub table {
148							#use Storable qw( dclone );
149							# can't use Storable::dclone because can't handle CODE. would like to deep
150							# clone %arg so that modifications (remove leading '-' and/or substitute for
151							# deprecated names) won't modify original %arg hash on the outside.
152	14			14	1	6196	my $self = shift;
153	14					26	my $pdf = shift;
154	14					19	my $page = shift;
155	14					37	my $data = shift;
156	14					82	my %arg = @_;
157
158							#=====================================
159							# Mandatory Arguments Section
160							#=====================================
161	13	50	33			113	unless ($pdf and $page and $data) {
			33
162	0					0	carp "Error: Mandatory parameter is missing PDF/page/data object!\n";
163	0					0	return ($page, 0, 0);
164							}
165
166							# Validate mandatory argument data type
167	13	100	66			239	croak "Error: Invalid PDF object received."
168							unless (ref($pdf) eq 'PDF::API2' \|\|
169							ref($pdf) eq 'PDF::Builder');
170	12	100	66			114	croak "Error: Invalid page object received."
171							unless (ref($page) eq 'PDF::API2::Page' \|\|
172							ref($page) eq 'PDF::Builder::Page');
173	11	100	100			175	croak "Error: Invalid data received."
174							unless ((ref($data) eq 'ARRAY') && scalar(@$data));
175	10	50				55	croak "Error: Missing required settings."
176							unless (scalar(keys %arg));
177
178							# ==================================================================
179							# did client code ask to redefine?
180							($repeat_default, $oddeven_default, $padding_default) =
181	10	50				42	@{$arg{'compatibility'}} if defined $arg{'compatibility'};
	0					0
182
183							# set some defaults !!!!
184	10		100			50	$arg{'cell_render_hook' } \|\|= undef;
185
186							# $ink is whether or not to output PDF, as opposed to sizing
187	10	50				25	$ink = $arg{'ink'} if defined $arg{'ink'}; # 1 yes, 0 no (size)
188	10					20	my @vsizes;
189
190							# Validate settings key
191	10					350	my %valid_settings_key = (
192							'x' => 1, # global, mandatory
193							'w' => 1, # global, mandatory
194							'y' => 1, # global, mandatory
195							'start_y' => 1, # deprecated
196							'h' => 1, # global, mandatory
197							'start_h' => 1, # deprecated
198							'ink' => 1, # global
199							'next_y' => 1, # global
200							'next_h' => 1, # global
201							'leading' => 1, # text_block
202							'lead' => 1, # deprecated
203							'padding' => 1, # global
204							'padding_right' => 1, # global
205							'padding_left' => 1, # global
206							'padding_top' => 1, # global
207							'padding_bottom' => 1, # global
208							'bg_color' => 1, # global, header, row, column, cell
209							'background_color' => 1, # deprecated
210							'bg_color_odd' => 1, # global, column, cell
211							'background_color_odd'=> 1, # deprecated
212							'bg_color_even' => 1, # global, column, cell
213							'background_color_even'=> 1, # deprecated
214							'fg_color' => 1, # global, header, row, column, cell
215							'font_color' => 1, # deprecated
216							'fg_color_odd' => 1, # global, column, cell
217							'font_color_odd' => 1, # deprecated
218							'fg_color_even' => 1, # global, column, cell
219							'font_color_even' => 1, # deprecated
220							'border_w' => 1, # global
221							'border' => 1, # deprecated
222							'h_border_w' => 1, # global
223							'horizontal_borders' => 1, # deprecated
224							'v_border_w' => 1, # global
225							'vertical_borders' => 1, # deprecated
226							'border_c' => 1, # global
227							'border_color' => 1, # deprecated
228							# possibly in future, separate h_border_c and v_border_c
229							'rule_w' => 1, # global, row, column, cell
230							'h_rule_w' => 1, # global, row, column, cell
231							'v_rule_w' => 1, # global, row, column, cell
232							'rule_c' => 1, # global, row, column, cell
233							'h_rule_c' => 1, # global, row, column, cell
234							'v_rule_c' => 1, # global, row, column, cell
235							'font' => 1, # global, header, row, column, cell
236							'font_size' => 1, # global, header, row, column, cell
237							'underline' => 1, # global, header, row, column, cell
238							'font_underline' => 1, # deprecated
239							'min_w' => 1, # global, header, row, column, cell
240							'max_w' => 1, # global, header, row, column, cell
241							'min_rh' => 1, # global, header, row, column, cell
242							'row_height' => 1, # deprecated
243							'new_page_func' => 1, # global
244							'header_props' => 1, # includes sub-settings like repeat
245							'row_props' => 1, # includes sub-settings like fg_color
246							'column_props' => 1, # includes sub-settings like fg_color
247							'cell_props' => 1, # includes sub-settings like fg_color
248							'max_word_length' => 1, # global, text_block
249							'cell_render_hook' => 1, # global
250							'default_text' => 1, # global
251							'justify' => 1, # global
252							# 'repeat' # header
253							# 'align' # text_block
254							# 'parspace' # text_block
255							# 'hang' # text_block
256							# 'flindent' # text_block
257							# 'fpindent' # text_block
258							# 'indent' # text_block
259							'size' => 1, # global
260							);
261	10					44	foreach my $key (keys %arg) {
262							# Provide backward compatibility
263	90	50				176	$arg{$key} = delete $arg{"-$key"} if $key =~ s/^-//;
264
265							croak "Error: Invalid setting key '$key' received."
266	90	50				143	unless exists $valid_settings_key{$key};
267							}
268
269
270	10					32	my ( $xbase, $ybase, $width, $height ) = ( undef, undef, undef, undef );
271							# TBD eventually deprecated start_y and start_h go away
272							# special treatment here because haven't yet copied deprecated names
273	10		50			82	$xbase = $arg{'x'} \|\| -1;
274	10		50			41	$ybase = $arg{'y'} \|\| $arg{'start_y'} \|\| -1;
275	10		50			46	$width = $arg{'w'} \|\| -1;
276	10		50			39	$height = $arg{'h'} \|\| $arg{'start_h'} \|\| -1;
277
278							# Global geometry parameters are also mandatory.
279	10	50				34	unless ( $xbase > 0 ) {
280	0					0	carp "Error: Left Edge of Table is NOT defined!\n";
281	0					0	return ($page, 0, $ybase);
282							}
283	10	50				34	unless ( $ybase > 0 ) {
284	0					0	carp "Error: Base Line of Table is NOT defined!\n";
285	0					0	return ($page, 0, $ybase);
286							}
287	10	50				32	unless ( $width > 0 ) {
288	0					0	carp "Error: Width of Table is NOT defined!\n";
289	0					0	return ($page, 0, $ybase);
290							}
291	10	50				27	unless ( $height > 0 ) {
292	0					0	carp "Error: Height of Table is NOT defined!\n";
293	0					0	return ($page, 0, $ybase);
294							}
295	10					20	my $bottom_margin = $ybase - $height;
296
297	10					24	my $pg_cnt = 1;
298	10					15	my $cur_y = $ybase;
299	10		100			35	my $cell_props = $arg{'cell_props'} \|\| []; # per cell properties
300
301							# If there is no valid data array reference, warn and return!
302	10	50				43	if (ref $data ne 'ARRAY') {
303	0					0	carp "Passed table data is not an ARRAY reference. It's actually a ref to ".ref($data);
304	0					0	return ($page, 0, $cur_y);
305							}
306
307							# Ensure default values for next_y and next_h
308	10		50			27	my $next_y = $arg{'next_y'} \|\| undef;
309	10		50			31	my $next_h = $arg{'next_h'} \|\| undef;
310	10		50			43	my $size = $arg{'size'} \|\| undef;
311
312							# Create Text Object
313	10					41	my $txt = $page->text(); # $ink==0 still needs for font size, etc.
314							# doing sizing or actual output?
315	10	50				160	if (!$ink) {
316	0					0	@vsizes = (0, 0, 0); # overall, header, footer (future)
317							# push each row onto @vsizes as defined
318							# override y,h to nearly infinitely large (will never paginate)
319	0					0	$ybase = $height = 2147000000;
320							}
321
322							#=====================================
323							# Table Header Section
324							#
325							# order of precedence: header_props, column_props, globals, defaults
326							# here, header settings are initialized to globals/defaults
327							#=====================================
328							# Disable header row into the table
329	10					18	my $header_props = undef;
330	10					24	my $do_headers = 0; # not doing headers
331
332							# Check if the user enabled it ?
333	10	100	66			35	if (defined $arg{'header_props'} and ref( $arg{'header_props'}) eq 'HASH') {
334							# Transfer the reference to local variable
335	1					3	$header_props = $arg{'header_props'};
336
337							# Check other parameters and put defaults if needed
338	1		33			5	$header_props->{'repeat' } \|\|= $repeat_default;
339
340	1					2	$do_headers = 1; # do headers, no repeat
341	1	50				3	$do_headers = 2 if $header_props->{'repeat'}; # do headers w/ repeat
342							}
343
344	10					20	my $header_row = undef;
345							# Copy the header row (text) if header is enabled
346	10	100				24	@$header_row = $$data[0] if $do_headers;
347							# Determine column widths based on content
348
349							# an arrayref whose values are a hashref holding
350							# the minimum and maximum width of that column
351	10		100			51	my $col_props = $arg{'column_props'} \|\| [];
352
353							# an arrayref whose values are a hashref holding
354							# various row settings for a specific row
355	10		50			44	my $row_props = $arg{'row_props'} \|\| [];
356
357							# deprecated setting (globals) names, copy to new names
358	10					75	PDF::Table::Settings::deprecated_settings(
359							$data, $row_props, $col_props, $cell_props, $header_props, \%arg);
360							# check settings values as much as possible
361	10					56	PDF::Table::Settings::check_settings(%arg);
362
363							#=====================================
364							# Set Global Default Properties
365							#=====================================
366							# geometry-related global settings checked, last value for find_value()
367	10		33			112	my $fnt_obj = $arg{'font' } \|\|
368							$pdf->corefont('Times-Roman',-encode => 'latin1');
369	10		66			129	my $fnt_size = $arg{'font_size' } \|\| $font_size_default;
370	10					33	my $min_leading = $fnt_size * $leading_ratio;
371	10		33			37	my $leading = $arg{'leading'} \|\| $min_leading;
372	10	50				35	if ($leading < $fnt_size) {
373	0					0	carp "Warning: Global leading value $leading is less than font size $fnt_size, increased to $min_leading\n";
374	0					0	$arg{'leading'} = $leading = $min_leading;
375							}
376
377							# can't condense $border_w to \|\| because border_w=>0 gets default of 1!
378	10	100				30	my $border_w = defined $arg{'border_w'}? $arg{'border_w'}: 1;
379	10		66			42	my $h_border_w = $arg{'h_border_w'} \|\| $border_w;
380	10		66			44	my $v_border_w = $arg{'v_border_w'} \|\| $border_w;
381
382							# non-geometry global settings
383	10		66			52	my $border_c = $arg{'border_c'} \|\| $fg_color_default;
384							# global fallback values for find_value() call
385	10		50			34	my $underline = $arg{'underline' } \|\|
386							undef; # merely stating undef is the intended default
387	10		66			33	my $max_word_len = $arg{'max_word_length' } \|\| $max_wordlen_default;
388	10		33			45	my $default_text = $arg{'default_text' } \|\| $empty_cell_text;
389
390							# An array ref of arrayrefs whose values are
391							# the actual widths of the column/row intersection
392	10					45	my $row_col_widths = [];
393							# An array ref with the widths of the header row
394	10					35	my $h_row_widths = [];
395
396							# Scalars that hold sum of the maximum and minimum widths of all columns
397	10					27	my ( $max_col_w, $min_col_w ) = ( 0,0 );
398	10					16	my ( $row, $space_w );
399
400	10					19	my $word_widths = {};
401	10					16	my $rows_height = [];
402	10					18	my $first_row = 1;
403	10					59	my $is_header_row = 0;
404
405							# per-cell values
406	10					26	my ($cell_font, $cell_font_size, $cell_underline, $cell_justify,
407							$cell_height, $cell_pad_top, $cell_pad_right, $cell_pad_bot,
408							$cell_pad_left, $cell_leading, $cell_max_word_len, $cell_bg_color,
409							$cell_fg_color, $cell_bg_color_even, $cell_bg_color_odd,
410							$cell_fg_color_even, $cell_fg_color_odd, $cell_min_w, $cell_max_w,
411							$cell_h_rule_w, $cell_v_rule_w, $cell_h_rule_c, $cell_v_rule_c,
412							$cell_def_text, $cell_markup);
413
414							# for use by find_value()
415	10					26	my $GLOBALS = [$cell_props, $col_props, $row_props, -1, -1, \%arg];
416							# ----------------------------------------------------------------------
417							# GEOMETRY
418							# figure row heights and column widths,
419							# update overall table width if necessary
420							# here we're only interested in things that affect the table geometry
421							#
422							# $rows_height->[$row_idx] array overall height of each row
423							# $calc_column_widths overall width of each column
424	10					18	my $col_min_width = []; # holds the running width of each column
425	10					26	my $col_max_content = []; # min and max (min_w & longest word,
426							# length of content)
427	10					22	my $max_w = []; # each column's max_w, if defined
428	10					48	for ( my $row_idx = 0; $row_idx < scalar(@$data) ; $row_idx++ ) {
429	19					36	$GLOBALS->[3] = $row_idx;
430	19					28	my $column_widths = []; # holds the width of each column
431							# initialize the height for this row
432	19					30	$rows_height->[$row_idx] = 0;
433
434	19					39	for ( my $col_idx = 0;
435	69					156	$col_idx < scalar(@{$data->[$row_idx]});
436							$col_idx++ ) {
437	50					76	$GLOBALS->[4] = $col_idx;
438							# initialize min and max column content widths to 0
439	50	100				109	$col_min_width->[$col_idx]=0 if !defined $col_min_width->[$col_idx];
440	50	100				93	$col_max_content->[$col_idx]=0 if !defined $col_max_content->[$col_idx];
441
442							# determine if this content is a simple string for normal usage,
443							# or it is markup
444	50					78	my $bad_markup = '';
445	50	50				98	if (ref($data->[$row_idx][$col_idx]) eq '') {
		0
446							# it is a scalar string for normal usage
447							# (or some data easily stringified)
448	50					75	$cell_markup = '';
449							} elsif (ref($data->[$row_idx][$col_idx]) eq 'ARRAY') {
450							# it is an array for markup usage. exact type is the first
451							# element.
452	0	0				0	if (!defined $data->[$row_idx][$col_idx]->[0]) {
453	0					0	$bad_markup = 'array has no data';
454							} else {
455	0					0	$cell_markup = $data->[$row_idx][$col_idx]->[0];
456
457							# [0] should be none, md1, html, or pre
458	0	0	0			0	if ($cell_markup ne 'none' && $cell_markup ne 'md1' &&
		0	0
		0	0
			0
			0
			0
459							$cell_markup ne 'html' && $cell_markup ne 'pre') {
460	0					0	$bad_markup = "markup type '$cell_markup' unsupported";
461							# [1] should be string or array of strings
462							} elsif (defined $data->[$row_idx][$col_idx]->[1] &&
463							ref($data->[$row_idx][$col_idx]->[1]) ne '' &&
464							ref($data->[$row_idx][$col_idx]->[1]) ne 'ARRAY') {
465	0					0	$bad_markup = 'data not string or array of strings';
466							# [2] should be hash reference (possibly empty)
467							} elsif (defined $data->[$row_idx][$col_idx]->[2] &&
468							ref($data->[$row_idx][$col_idx]->[2]) ne 'HASH') {
469	0					0	$bad_markup = 'options not hash ref';
470							}
471							# [3+] additional elements ignored
472							}
473							} else {
474							# um, is not a legal data type for this purpose, even if it
475							# IS able to stringify to something reasonable.
476							# See if we can stringify it... better than a total failure?
477	0					0	my $string = ''; # in case stringification fails
478	0					0	$bad_markup = ''; # in case stringification succeeds
479	0					0	eval { $string = ''.$data->[$row_idx][$col_idx]; };
	0					0
480	0	0				0	$bad_markup = 'is not a string or array reference' if $@;
481	0					0	$data->[$row_idx][$col_idx] = $string;
482							# if fatal error in eval, $string will be empty, and $bad_markup
483							# will cause it to be ignored anyway
484							}
485	50	50				120	if ($bad_markup ne '') {
486							# replace bad markup with a simple string
487	0					0	carp "Cell $row_idx,$col_idx $bad_markup.\n";
488	0					0	$data->[$row_idx][$col_idx] = '(invalid)';
489	0					0	$cell_markup = '';
490							}
491
492	50	100	100			183	if ( !$row_idx && $do_headers ) {
493							# header row
494	3					6	$is_header_row = 1;
495	3					6	$GLOBALS->[3] = 0;
496	3					6	$cell_font = $header_props->{'font'};
497	3					15	$cell_font_size = $header_props->{'font_size'};
498	3					8	$cell_leading = $header_props->{'leading'};
499	3					5	$cell_height = $header_props->{'min_rh'};
500							$cell_pad_top = $header_props->{'padding_top'} \|\|
501	3		33			11	$header_props->{'padding'};
502							$cell_pad_right = $header_props->{'padding_right'} \|\|
503	3		33			19	$header_props->{'padding'};
504							$cell_pad_bot = $header_props->{'padding_bottom'} \|\|
505	3		33			10	$header_props->{'padding'};
506							$cell_pad_left = $header_props->{'padding_left'} \|\|
507	3		33			9	$header_props->{'padding'};
508	3					5	$cell_max_word_len = $header_props->{'max_word_length'};
509	3					5	$cell_min_w = $header_props->{'min_w'};
510	3					4	$cell_max_w = $header_props->{'max_w'};
511	3					5	$cell_def_text = $header_props->{'default_text'};
512							# items not of interest for determining geometry
513							#$cell_underline = $header_props->{'underline'};
514							#$cell_justify = $header_props->{'justify'};
515							#$cell_bg_color = $header_props->{'bg_color'};
516							#$cell_fg_color = $header_props->{'fg_color'};
517							#$cell_bg_color_even= undef;
518							#$cell_bg_color_odd = undef;
519							#$cell_fg_color_even= undef;
520							#$cell_fg_color_odd = undef;
521							#$cell_h_rule_w = header_props->{'h_rule_w'};
522							#$cell_v_rule_w = header_props->{'v_rule_w'};
523							#$cell_h_rule_c = header_props->{'h_rule_c'};
524							#$cell_v_rule_c = header_props->{'v_rule_c'};
525							} else {
526							# not a header row, so uninitialized
527	47					72	$is_header_row = 0;
528	47					57	$cell_font = undef;
529	47					57	$cell_font_size = undef;
530	47					65	$cell_leading = undef;
531	47					55	$cell_height = undef;
532	47					57	$cell_pad_top = undef;
533	47					63	$cell_pad_right = undef;
534	47					69	$cell_pad_bot = undef;
535	47					60	$cell_pad_left = undef;
536	47					53	$cell_max_word_len = undef;
537	47					66	$cell_min_w = undef;
538	47					54	$cell_max_w = undef;
539	47					60	$cell_def_text = undef;
540							# items not of interest for determining geometry
541							#$cell_underline = undef;
542							#$cell_justify = undef;
543							#$cell_bg_color = undef;
544							#$cell_fg_color = undef;
545							#$cell_bg_color_even= undef;
546							#$cell_bg_color_odd = undef;
547							#$cell_fg_color_even= undef;
548							#$cell_fg_color_odd = undef;
549							#$cell_h_rule_w = undef;
550							#$cell_v_rule_w = undef;
551							#$cell_h_rule_c = undef;
552							#$cell_v_rule_c = undef;
553							}
554
555							# Get the most specific value if none was already set from header_props
556							# TBD should header_props be treated like a row_props (taking
557							# precedence over row_props), but otherwise like a row_props? or
558							# should anything in header_props take absolute precedence as now?
559
560	50					109	$cell_font = find_value($cell_font,
561							'font', '', $fnt_obj, $GLOBALS);
562	50					91	$cell_font_size = find_value($cell_font_size,
563							'font_size', '', 0, $GLOBALS);
564	50	100				99	if ($cell_font_size == 0) {
565	22	50				38	if ($is_header_row) {
566	0					0	$cell_font_size = $fnt_size + 2;
567							} else {
568	22					32	$cell_font_size = $fnt_size;
569							}
570							}
571	50					96	$cell_leading = find_value($cell_leading, 'leading',
572							'', -1, $GLOBALS);
573	50					102	$cell_height = find_value($cell_height,
574							'min_rh', '', 0, $GLOBALS);
575	50					90	$cell_pad_top = find_value($cell_pad_top, 'padding_top',
576							'padding', $padding_default,
577							$GLOBALS);
578	50					90	$cell_pad_right = find_value($cell_pad_right, 'padding_right',
579							'padding', $padding_default,
580							$GLOBALS);
581	50					100	$cell_pad_bot = find_value($cell_pad_bot, 'padding_bottom',
582							'padding', $padding_default,
583							$GLOBALS);
584	50					84	$cell_pad_left = find_value($cell_pad_left, 'padding_left',
585							'padding', $padding_default,
586							$GLOBALS);
587	50					95	$cell_max_word_len = find_value($cell_max_word_len, 'max_word_len',
588							'', $max_word_len, $GLOBALS);
589	50					90	$cell_min_w = find_value($cell_min_w, 'min_w',
590							'', undef, $GLOBALS);
591	50					97	$cell_max_w = find_value($cell_max_w, 'max_w',
592							'', undef, $GLOBALS);
593	50	50	33			112	if (defined $cell_max_w && defined $cell_min_w) {
594	0					0	$cell_max_w = max($cell_max_w, $cell_min_w);
595							}
596	50					90	$cell_def_text = find_value($cell_def_text, 'default_text', '',
597							$default_text, $GLOBALS);
598							# items not of interest for determining geometry
599							#$cell_underline = find_value($cell_underline,
600							# 'underline', '', $underline, $GLOBALS);
601							#$cell_justify = find_value($cell_justify,
602							# 'justify', '', 'left', $GLOBALS);
603							#$cell_bg_color = find_value($cell_bg_color, 'bg_color',
604							# '', undef, $GLOBALS);
605							#$cell_fg_color = find_value($cell_fg_color, 'fg_color',
606							# '', $fg_color_default, $GLOBALS);
607							#$cell_bg_color_even = find_value($cell_bg_color_even,
608							# 'bg_color_even', '', undef, $GLOBALS);
609							#$cell_bg_color_odd = find_value($cell_bg_color_odd,
610							# 'bg_color_odd', '', undef, $GLOBALS);
611							#$cell_fg_color_even = find_value($cell_fg_color_even,
612							# 'fg_color_even', '', undef, $GLOBALS);
613							#$cell_fg_color_odd = find_value($cell_fg_color_odd,
614							# 'fg_color_odd', '', undef, $GLOBALS);
615							#$cell_h_rule_w = find_value($cell_h_rule_w, 'h_rule_w',
616							# 'rule_w', $h_border_w, $GLOBALS);
617							#$cell_v_rule_w = find_value($cell_v_rule_w, 'v_rule_w',
618							# 'rule_w', $v_border_w, $GLOBALS);
619							#$cell_h_rule_c = find_value($cell_h_rule_c, 'h_rule_c',
620							# 'rule_c', $border_c, $GLOBALS);
621							#$cell_v_rule_c = find_value($cell_v_rule_c, 'v_rule_c',
622							# 'rule_c', $border_c, $GLOBALS);
623
624	50					96	my $min_leading = $cell_font_size * $leading_ratio;
625	50	50				105	if ($cell_leading <= 0) {
626							# leading left at default, silently set to minimum
627	50					67	$cell_leading = $min_leading;
628							} else {
629							# leading specified, but is too small?
630	0	0				0	if ($cell_leading < $cell_font_size) {
631	0					0	carp "Warning: Cell[$row_idx][$col_idx] leading value $cell_leading is less than font size $cell_font_size, increased to $min_leading\n";
632	0					0	$cell_leading = $min_leading;
633							}
634							}
635
636							# Set Font
637	50					172	$txt->font( $cell_font, $cell_font_size );
638
639							# Set row height to biggest font size from row's cells
640							# Note that this assumes just one line of text per cell
641	50					446	$rows_height->[$row_idx] = max($rows_height->[$row_idx],
642							$cell_leading + $cell_pad_top + $cell_pad_bot, $cell_height);
643
644							# This should fix a bug with very long words like serial numbers,
645							# etc. TBD: consider splitting ONLY on end of line, and adding a
646							# hyphen (dash) at split. would have to track split words (by
647							# index numbers?) and glue them back together when there's space
648							# to do so (including hyphen).
649							# update: split words only if simple strings (not calling column())
650	50	100	66			297	if ( $cell_max_word_len > 0 && $data->[$row_idx][$col_idx] &&
			66
651							ref($data->[$row_idx][$col_idx]) eq '') {
652	48					297	$data->[$row_idx][$col_idx] =~ s#(\S{$cell_max_word_len})(?=\S)#$1 #g;
653							}
654
655							# Init cell size limits (per row)
656	50					129	$space_w = $txt->advancewidth( "\x20" );
657							# font/size can change for each cell, so space width can vary
658	50					200	$column_widths->[$col_idx] = 0; # per-row basis
659	50					75	$max_col_w = 0;
660	50					64	$min_col_w = 0;
661
662	50					64	my @words;
663	50	100				212	@words = split( /\s+/, $data->[$row_idx][$col_idx] )
664							if $data->[$row_idx][$col_idx];
665							# TBD count up spaces instead of assuming one between each word,
666							# don't know what to do about \t (not defined!). NBSP would
667							# be treated as non-space for these calculations, not sure
668							# how it would render. \r, \n, etc. no space? then there is
669							# check how text is split into lines in text_block if
670							# multiple spaces between words.
671
672							# for cell, minimum width is longest word, maximum is entire text
673							# treat header row like any data row for this
674							# increase minimum width to (optional) specified column min width
675							# keep (optional) specified column max width separate
676							# NOTE that cells with only blanks will be treated as empty (no
677							# words) and have only L+R padding for a width!
678	50					103	foreach ( @words ) {
679	60	100				149	unless ( exists $word_widths->{$_} ) {
680							# Calculate the width of every word and add the space width to it
681							# caching each word so only figure width once
682	58					130	$word_widths->{$_} = $txt->advancewidth($_);
683							}
684
685							# minimum width is longest word or fragment
686	60					327	$min_col_w = max($min_col_w, $word_widths->{$_});
687							# maximum width is total text in cell
688	60	100				105	if ($max_col_w) {
689							# already have text, so add a space first
690							# note that multiple spaces between words become one!
691	12					21	$max_col_w += $space_w;
692							} else {
693							# first word, so no space [before]
694							}
695	60					119	$max_col_w += $word_widths->{$_};
696							}
697
698							# don't forget any default text! it's not split on max_word_len
699							# TBD should default_text be split like other text?
700	50					105	$min_col_w = max($min_col_w, $txt->advancewidth($cell_def_text));
701
702							# at this point we have longest word (min_col_w), overall length
703							# (max_col_w) of this cell. add L+R padding
704							# cell_min/max_w are optional settings
705							# TBD what if $cell_def_text is longer?
706	50					193	$min_col_w += $cell_pad_left + $cell_pad_right;
707	50	50				103	$min_col_w = max($min_col_w, $cell_min_w) if defined $cell_min_w;
708	50					76	$max_col_w += $cell_pad_left + $cell_pad_right;
709	50					97	$max_col_w = max($min_col_w, $max_col_w);
710	50					104	$col_min_width->[$col_idx] = max($col_min_width->[$col_idx],
711							$min_col_w);
712	50					80	$col_max_content->[$col_idx] = max($col_max_content->[$col_idx],
713							$max_col_w);
714
715	50	100				107	if (!defined $max_w->[$col_idx]) { $max_w->[$col_idx] = -1; }
	27					44
716	50	50				86	$max_w->[$col_idx] = max($max_w->[$col_idx], $cell_max_w) if
717							defined $cell_max_w; # otherwise -1
718	50					107	$column_widths->[$col_idx] = $col_max_content->[$col_idx];
719
720							} # (End of cols) for (my $col_idx....
721
722	19					46	$row_col_widths->[$row_idx] = $column_widths;
723
724							# Copy the calculated row properties of header row.
725	19	100	100			83	@$h_row_widths = @$column_widths if !$row_idx && $do_headers;
726
727							} # (End of rows) for ( my $row_idx row heights and column widths
728
729							# Calc real column widths and expand table width if needed.
730	10					30	my $calc_column_widths;
731	10					31	my $em_size = $txt->advancewidth('M');
732	10					48	my $ex_size = $txt->advancewidth('x');
733
734	10	50				48	if (defined $size) {
735	0					0	($calc_column_widths, $width) =
736							PDF::Table::ColumnWidth::SetColumnWidths(
737							$width, $size, $em_size, $ex_size );
738							} else {
739	10					38	($calc_column_widths, $width) =
740							PDF::Table::ColumnWidth::CalcColumnWidths(
741							$width, $col_min_width, $col_max_content, $max_w );
742							}
743
744							# ----------------------------------------------------------------------
745							# Let's draw what we have!
746	10					29	my $row_idx = 0; # first row (might be header)
747	10					16	my $row_is_odd = 0; # first data row output (row 0) is "even"
748							# Store header row height for later use if headers have to be repeated
749	10					21	my $header_min_rh = $rows_height->[0]; # harmless if no header
750							# kind of top border to draw, depending on start or continuation
751	10					17	my $next_top_border = 0;
752
753	10					21	my ( $gfx, $gfx_bg, $bg_color, $fg_color,
754							$bot_margin, $table_top_y, $text_start_y);
755
756							# Each iteration adds a new page as necessary
757	10					16	while (scalar(@{$data})) { # still row(s) remaining to output
	21					55
758	11					18	my ($page_header, $columns_number);
759
760	11	100				40	if ($pg_cnt == 1) {
761							# on first page output
762	10					17	$table_top_y = $ybase;
763	10					18	$bot_margin = $table_top_y - $height;
764
765							# Check for safety reasons
766	10	50				55	if ( $bot_margin < 0 ) {
767	0					0	carp "!!! Warning: !!! Incorrect Table Geometry! h ($height) greater than remaining page space y ($table_top_y). Reducing height to fit on page.\n";
768	0					0	$bot_margin = 0;
769	0					0	$height = $table_top_y;
770							}
771
772							} else {
773							# on subsequent (overflow) pages output
774	1	50				10	if (ref $arg{'new_page_func'}) {
775	0					0	$page = &{ $arg{'new_page_func'} };
	0					0
776							} else {
777	1					3	$page = $pdf->page();
778							}
779
780							# we NEED next_y and next_h! if undef, complain and use
781							# 90% and 80% respectively of page height
782	1	50				33	if (!defined $next_y) {
783	0					0	my @page_dim = $page->mediabox();
784	0					0	$next_y = ($page_dim[3] - $page_dim[1]) * 0.9;
785	0					0	carp "!!! Error: !!! Table spills to next page, but no next_y was given! Using $next_y.\n";
786							}
787	1	50				4	if (!defined $next_h) {
788	0					0	my @page_dim = $page->mediabox();
789	0					0	$next_h = ($page_dim[3] - $page_dim[1]) * 0.8;
790	0					0	carp "!!! Error: !!! Table spills to next page, but no next_h was given! Using $next_h.\n";
791							}
792
793	1					2	$table_top_y = $next_y;
794	1					2	$bot_margin = $table_top_y - $next_h;
795
796							# Check for safety reasons
797	1	50				16	if ( $bot_margin < 0 ) {
798	0					0	carp "!!! Warning: !!! Incorrect Table Geometry! next_h ($next_h) greater than remaining page space next_y ($next_y), must be reduced to fit on page.\n";
799	0					0	$bot_margin = 0;
800	0					0	$next_h = $table_top_y;
801							}
802
803							# push copy of header onto remaining table data, if repeated hdr
804	1	50				7	if ( $do_headers == 2 ) {
805							# Copy Header Data
806	0					0	@$page_header = @$header_row;
807	0					0	my $hrw ;
808	0					0	@$hrw = @$h_row_widths ;
809							# Then prepend it to master data array
810	0					0	unshift @$data, @$page_header;
811	0					0	unshift @$row_col_widths, $hrw;
812	0					0	unshift @$rows_height, $header_min_rh;
813
814	0					0	$first_row = 1; # Means YES
815							# Roll back the row_idx because a new header row added
816	0					0	$row_idx--;
817							}
818
819							}
820							# ----------------------------------------------------------------
821							# should be at top of table for current page
822							# either start of table, or continuation
823							# pg_cnt >= 1
824							# do_headers = 0 not doing headers
825							# 1 non-repeating header
826							# 2 repeating header
827
828							# check if enough vertical space for first data row (row 0 or 1), AND
829							# for header (0) if doing a header row! increase height, decrease
830							# bot_margin. possible that bot_margin goes < 0 (warning message).
831							# TBD if first page (pg_cnt==1), and sufficient space on next page,
832							# just skip first page and go on to second
833							# For degenerate cases where there is only a header row and no data
834							# row(s), don't try to make use of missing rows height [1]
835	11					24	my $min_height = $rows_height->[0];
836	11	50	100			99	$min_height += $rows_height->[1] if
			66
837							($do_headers && $pg_cnt==1 \|\| $do_headers==2 && $pg_cnt>1) &&
838							defined $rows_height->[1];
839	11	50				48	if ($min_height >= $table_top_y - $bot_margin) {
840							# Houston, we have a problem. height isn't enough
841	0					0	my $delta = $min_height - ($table_top_y - $bot_margin) + 1;
842	0	0				0	if ($delta > $bot_margin) {
843	0					0	carp "!! Error !! Insufficient space (by $delta) to get minimum number of row(s) on page. Some content may be lost off page bottom";
844							} else {
845	0					0	carp "!! Warning !! Need to expand allotted vertical height by $delta to fit minimum number of row(s) on page";
846							}
847	0					0	$bot_margin -= $delta;
848	0	0				0	if ($pg_cnt == 1) {
849	0					0	$height += $delta;
850							} else {
851	0					0	$next_h += $delta;
852							}
853							}
854
855							# order is important -- cell background layer must be rendered
856							# before text layer and then other graphics (rules, borders)
857	11	50				60	$gfx_bg = $page->gfx() if $ink;
858	11					250	$txt = $page->text();
859
860	11					85	$cur_y = $table_top_y;
861
862							# let's just always go ahead and create $gfx (for drawing borders
863							# and rules), as it will almost always be needed
864	11	50				42	$gfx = $page->gfx() if $ink; # for borders, rules, etc.
865	11	50				115	$gfx->strokecolor($border_c) if $ink;
866
867							# Draw the top line (border), only if h_border_w > 0, as we
868							# don't know what rules are doing
869	11	100	66			137	if ($ink && $h_border_w) {
870	8	50				24	if ($next_top_border == 0) {
		0
871							# first top border (page 1), use specified border
872	8					30	$gfx->linewidth($h_border_w);
873							} elsif ($next_top_border == 1) {
874							# solid thin line at start of a row
875	0					0	$gfx->linewidth($border_w_default);
876							} else { # == 2
877							# dashed thin line at continuation in middle of row
878	0					0	$gfx->linewidth($border_w_default);
879	0					0	$gfx->linedash($dashed_rule_default);
880							}
881	8					128	$gfx->move( $xbase-$v_border_w/2 , $cur_y );
882	8					67	$gfx->hline($xbase + $width + $v_border_w/2);
883	8					56	$gfx->stroke();
884	8					48	$gfx->linedash();
885							}
886
887	11					68	my @actual_column_widths;
888							my %colspanned;
889
890							# Each iteration adds a row to the current page until the page is full
891							# or there are no more rows to add
892							# Row_Loop
893	11		100			20	while (scalar(@{$data}) and $cur_y-$rows_height->[0] > $bot_margin) {
	30					128
894							# Remove the next item from $data
895	19					31	my $data_row = shift @{$data};
	19					42
896
897							# Get max columns number to know later how many vertical lines to draw
898	19					34	$columns_number = scalar(@$data_row);
899
900							# Get the next set of row related settings
901							# Row Height (starting point for $current_min_rh)
902	19					46	my $current_min_rh = shift @$rows_height;
903	19					31	my $actual_row_height = $current_min_rh;
904
905							# Row cell widths
906	19					33	my $data_row_widths = shift @$row_col_widths;
907
908							# remember, don't have cell_ stuff yet, just row items ($row_idx)!
909	19					32	my $cur_x = $xbase;
910	19					22	my $leftovers = undef; # Reference to text that is returned from text_block()
911	19					29	my $do_leftovers = 0; # part of a row spilled to next page
912
913							# Process every cell(column) from current row
914							# due to colspan, some rows have fewer columns than others
915	19					49	my @save_bg_color; # clear out for each row
916							my @save_fg_color;
917	19					0	my (@save_v_rule_w, @save_v_rule_c, @save_h_rule_w, @save_h_rule_c);
918	19					47	for ( my $col_idx = 0; $col_idx < $columns_number; $col_idx++ ) {
919	50					84	$GLOBALS->[3] = $row_idx;
920	50					67	$GLOBALS->[4] = $col_idx;
921							# now have each cell[$row_idx][$col_idx]
922	50	100				151	next if $colspanned{$row_idx.'_'.$col_idx};
923	49					78	$leftovers->[$col_idx] = undef;
924
925							# look for font information for this cell
926	49					94	my ($cell_font, $cell_font_size, $cell_leading, $cell_underline,
927							$cell_pad_top, $cell_pad_right, $cell_pad_bot,
928							$cell_pad_left, $cell_justify, $cell_fg_color,
929							$cell_bg_color, $cell_def_text, $cell_min_w, $cell_max_w);
930
931	49	100	100			181	if ($first_row and $do_headers) {
932	3					5	$is_header_row = 1;
933	3					5	$GLOBALS->[3] = 0;
934	3					7	$cell_font = $header_props->{'font'};
935	3					4	$cell_font_size = $header_props->{'font_size'};
936	3					5	$cell_leading = $header_props->{'leading'};
937	3					5	$cell_height = $header_props->{'min_rh'};
938							$cell_pad_top = $header_props->{'padding_top'} \|\|
939	3		33			10	$header_props->{'padding'};
940							$cell_pad_right = $header_props->{'padding_right'} \|\|
941	3		33			9	$header_props->{'padding'};
942							$cell_pad_bot = $header_props->{'padding_bottom'} \|\|
943	3		33			9	$header_props->{'padding'};
944							$cell_pad_left = $header_props->{'padding_left'} \|\|
945	3		33			14	$header_props->{'padding'};
946	3					5	$cell_max_word_len = $header_props->{'max_word_length'};
947	3					12	$cell_min_w = $header_props->{'min_w'};
948	3					8	$cell_max_w = $header_props->{'max_w'};
949	3					5	$cell_underline = $header_props->{'underline'};
950	3					3	$cell_def_text = $header_props->{'default_text'};
951	3					4	$cell_justify = $header_props->{'justify'};
952	3					6	$cell_bg_color = $header_props->{'bg_color'};
953	3					3	$cell_fg_color = $header_props->{'fg_color'};
954	3					12	$cell_bg_color_even= undef;
955	3					10	$cell_bg_color_odd = undef;
956	3					4	$cell_fg_color_even= undef;
957	3					6	$cell_fg_color_odd = undef;
958	3					4	$cell_h_rule_w = $header_props->{'h_rule_w'};
959	3					4	$cell_v_rule_w = $header_props->{'v_rule_w'};
960	3					4	$cell_h_rule_c = $header_props->{'h_rule_c'};
961	3					5	$cell_v_rule_c = $header_props->{'v_rule_c'};
962							} else {
963							# not header row, so initialize to undefined
964	46					68	$is_header_row = 0;
965	46					56	$cell_font = undef;
966	46					58	$cell_font_size = undef;
967	46					60	$cell_leading = undef;
968	46					57	$cell_height = undef;
969	46					59	$cell_pad_top = undef;
970	46					59	$cell_pad_right = undef;
971	46					63	$cell_pad_bot = undef;
972	46					54	$cell_pad_left = undef;
973	46					63	$cell_max_word_len = undef;
974	46					53	$cell_min_w = undef;
975	46					56	$cell_max_w = undef;
976	46					55	$cell_underline = undef;
977	46					53	$cell_def_text = undef;
978	46					52	$cell_justify = undef;
979	46					62	$cell_bg_color = undef;
980	46					68	$cell_fg_color = undef;
981	46					56	$cell_bg_color_even= undef;
982	46					56	$cell_bg_color_odd = undef;
983	46					83	$cell_fg_color_even= undef;
984	46					57	$cell_fg_color_odd = undef;
985	46					50	$cell_h_rule_w = undef;
986	46					59	$cell_v_rule_w = undef;
987	46					65	$cell_h_rule_c = undef;
988	46					61	$cell_v_rule_c = undef;
989							}
990
991							# Get the most specific value if none was already set from header_props
992	49					101	$cell_font = find_value($cell_font,
993							'font', '', $fnt_obj, $GLOBALS);
994	49					110	$cell_font_size = find_value($cell_font_size,
995							'font_size', '', 0, $GLOBALS);
996	49	100				109	if ($cell_font_size == 0) {
997	21	50				44	if ($is_header_row) {
998	0					0	$cell_font_size = $fnt_size + 2;
999							} else {
1000	21					36	$cell_font_size = $fnt_size;
1001							}
1002							}
1003	49					99	$cell_leading = find_value($cell_leading, 'leading',
1004							'leading', -1, $GLOBALS);
1005	49	50				158	if ($cell_leading <= 0) {
1006	49					139	$cell_leading = $cell_font_size * $leading_ratio;
1007							}
1008	49					95	$cell_height = find_value($cell_height,
1009							'min_rh', '', 0, $GLOBALS);
1010	49					94	$cell_pad_top = find_value($cell_pad_top, 'padding_top',
1011							'padding', $padding_default,
1012							$GLOBALS);
1013	49					94	$cell_pad_right = find_value($cell_pad_right, 'padding_right',
1014							'padding', $padding_default,
1015							$GLOBALS);
1016	49					138	$cell_pad_bot = find_value($cell_pad_bot, 'padding_bottom',
1017							'padding', $padding_default,
1018							$GLOBALS);
1019	49					88	$cell_pad_left = find_value($cell_pad_left, 'padding_left',
1020							'padding', $padding_default,
1021							$GLOBALS);
1022	49					93	$cell_max_word_len = find_value($cell_max_word_len,
1023							'max_word_len', '',
1024							$max_word_len, $GLOBALS);
1025	49					103	$cell_min_w = find_value($cell_min_w, 'min_w',
1026							'', undef, $GLOBALS);
1027	49					97	$cell_max_w = find_value($cell_max_w, 'max_w',
1028							'', undef, $GLOBALS);
1029	49	50	33			110	if (defined $cell_max_w && defined $cell_min_w) {
1030	0					0	$cell_max_w = max($cell_max_w, $cell_min_w);
1031							}
1032	49					91	$cell_underline = find_value($cell_underline,
1033							'underline', '', $underline,
1034							$GLOBALS);
1035	49					93	$cell_def_text = find_value($cell_def_text, 'default_text',
1036							'', $default_text, $GLOBALS);
1037	49					111	$cell_justify = find_value($cell_justify, 'justify',
1038							'justify', 'left', $GLOBALS);
1039
1040							# cell bg may still be undef after this, fg must be defined
1041	49	100				113	if ($is_header_row) {
1042	3					6	$cell_bg_color = find_value($cell_bg_color, 'bg_color',
1043							'', $h_bg_color_default,
1044							$GLOBALS);
1045	3					8	$cell_fg_color = find_value($cell_fg_color, 'fg_color',
1046							'', $h_fg_color_default,
1047							$GLOBALS);
1048							# don't use even/odd colors in header
1049							} else {
1050	46					85	$cell_bg_color = find_value($cell_bg_color, 'bg_color',
1051							'', undef, $GLOBALS);
1052	46					90	$cell_fg_color = find_value($cell_fg_color, 'fg_color',
1053							'', undef, $GLOBALS);
1054	46					84	$cell_bg_color_even = find_value($cell_bg_color_even,
1055							'bg_color_even', '', undef, $GLOBALS);
1056	46					106	$cell_bg_color_odd = find_value($cell_bg_color_odd,
1057							'bg_color_odd', '', undef, $GLOBALS);
1058	46					104	$cell_fg_color_even = find_value($cell_fg_color_even,
1059							'fg_color_even', '', undef, $GLOBALS);
1060	46					107	$cell_fg_color_odd = find_value($cell_fg_color_odd,
1061							'fg_color_odd', '', undef, $GLOBALS);
1062							}
1063	49					93	$cell_h_rule_w = find_value($cell_h_rule_w, 'h_rule_w',
1064							'rule_w', $h_border_w, $GLOBALS);
1065	49					96	$cell_v_rule_w = find_value($cell_v_rule_w, 'v_rule_w',
1066							'rule_w', $v_border_w, $GLOBALS);
1067	49					135	$cell_h_rule_c = find_value($cell_h_rule_c, 'h_rule_c',
1068							'rule_c', $border_c, $GLOBALS);
1069	49					151	$cell_v_rule_c = find_value($cell_v_rule_c, 'v_rule_c',
1070							'rule_c', $border_c, $GLOBALS);
1071
1072							# Choose colors for this row. may still be 'undef' after this!
1073							# cell, column, row, global color settings always override
1074							# whatever _even/odd sets
1075	49					100	$bg_color = $cell_bg_color;
1076	49					75	$fg_color = $cell_fg_color;
1077	49	50				104	if ($oddeven_default) { # new method with consistent odd/even
1078	49	100				102	if (!defined $bg_color) {
1079	31	100				96	$bg_color = $row_is_odd ? $cell_bg_color_odd : $cell_bg_color_even;
1080							}
1081	49	100				92	if (!defined $fg_color) {
1082	37	100				71	$fg_color = $row_is_odd ? $cell_fg_color_odd : $cell_fg_color_even;
1083							}
1084							# don't toggle odd/even yet, wait til end of row
1085							} else { # old method with inconsistent odd/even
1086	0	0				0	if (!defined $bg_color) {
1087	0	0				0	$bg_color = $row_idx % 2 ? $cell_bg_color_even : $cell_bg_color_odd;
1088							}
1089	0	0				0	if (!defined $fg_color) {
1090	0	0				0	$fg_color = $row_idx % 2 ? $cell_fg_color_even : $cell_fg_color_odd;
1091							}
1092							}
1093							# force fg_color to have a value, but bg_color may remain undef
1094	49		66			150	$fg_color \|\|= $fg_color_default;
1095
1096							## check if so much padding that baseline forced below cell
1097							## bottom, possibly resulting in infinite loop!
1098							#if ($cell_pad_top + $cell_pad_bot + $cell_leading > $cell_height) {
1099							# my $reduce = $cell_pad_top + $cell_pad_bot -
1100							# ($cell_height - $cell_leading);
1101							# carp "Warning! Vertical padding reduced by $reduce to fit cell[$row_idx][$col_idx]";
1102							# $cell_pad_top -= $reduce/2;
1103							# $cell_pad_bot -= $reduce/2;
1104							#}
1105
1106							# Define the font y base position for this line.
1107	49					79	$text_start_y = $cur_y - $cell_pad_top - $cell_font_size;
1108
1109							# VARIOUS WIDTHS:
1110							# $col_min_w->[$col_idx] the minimum needed for a column,
1111							# based on requested min_w and maximum word size (longest
1112							# word just fits). this is the running minimum, not the
1113							# per-row value.
1114							# $col_max_w->[$col_idx] the maximum needed for a column,
1115							# based on requested max_w and total length of text, as if
1116							# the longest entire cell is to be written out as one line.
1117							# this is the running maximum, not the per-row value.
1118							#
1119							# $calc_column_widths->[$col_idx] = calculated column widths
1120							# (at least the minimum requested and maximum word size)
1121							# apportioned across the full requested width. these are the
1122							# column widths you'll actually see drawn (before colspan).
1123							# $actual_column_widths[$row_idx][$col_idx] = calculated width
1124							# for this cell, increased by colspan (cols to right).
1125							#
1126							# $data_row_widths->[$col_idx] = cell content width list for
1127							# a row, first element of row_col_widths. could vary down a
1128							# column due to differing length of content.
1129							# $row_col_widths->[$row_idx] = list of max widths per row,
1130							# which can vary down a column due to differing length of
1131							# content.
1132							# $column_widths->[$col_idx] = list of maximum cell widths
1133							# across this row, used to load up $row_col_widths and
1134							# $h_row_widths (header).
1135
1136							# Initialize cell font object
1137	49					190	$txt->font( $cell_font, $cell_font_size );
1138	49	50				400	$txt->fillcolor($fg_color) if $ink;
1139
1140							# make sure cell's text is never undef
1141	49		33			309	$data_row->[$col_idx] //= $cell_def_text;
1142
1143							# Handle colspan
1144	49					110	my $c_cell_props = $cell_props->[$row_idx][$col_idx];
1145	49					79	my $this_cell_width = $calc_column_widths->[$col_idx];
1146	49	100	66			193	if ($c_cell_props && $c_cell_props->{'colspan'} && $c_cell_props->{'colspan'} > 1) {
			66
1147	1					3	my $colspan = $c_cell_props->{'colspan'};
1148	1					7	for my $offset (1 .. $colspan - 1) {
1149	1	50				5	$this_cell_width += $calc_column_widths->[$col_idx + $offset]
1150							if $calc_column_widths->[$col_idx + $offset];
1151	1					6	$colspanned{$row_idx.'_'.($col_idx + $offset)} = 1;
1152							}
1153							}
1154	49					130	$this_cell_width = max($this_cell_width, $min_col_width);
1155	49					89	$actual_column_widths[$row_idx][$col_idx] = $this_cell_width;
1156
1157	49					72	my %text_options;
1158	49	50				85	if ($cell_underline) {
1159	0					0	$text_options{'-underline'} = $cell_underline;
1160	0					0	$text_options{'-strokecolor'} = $fg_color;
1161							}
1162							# If the content is wider than the specified width,
1163							# we need to add the text as a text block
1164							# Otherwise just use the $page->text() method
1165	49					75	my $content = $data_row->[$col_idx];
1166	49	50	33			186	$content = $cell_def_text if (ref($content) eq '' &&
1167							$content eq '');
1168							# empty content? doesn't seem to do any harm
1169	49	50	33			319	if ( ref($content) eq 'ARRAY') {
		100	66
1170							# it's a markup cell
1171	0					0	$cell_markup = $content->[0];
1172							# if it's "leftover" content, markup is 'pre'
1173
1174	0					0	my ($rc, $next_y, $remainder);
1175							# upper left corner, width, and max height of this column?
1176	0					0	my $ULx = $cur_x + $cell_pad_left;
1177	0					0	my $ULy = $cur_y - $cell_pad_top;
1178	0					0	my $width = $actual_column_widths[$row_idx][$col_idx] -
1179							$cell_pad_right - $cell_pad_left;
1180	0					0	my $max_h = $cur_y - $bottom_margin -
1181							$cell_pad_top - $cell_pad_bot;
1182							($rc, $next_y, $remainder) =
1183							$txt->column($page, $txt, $gfx, $cell_markup,
1184							$content->[1],
1185							'rect'=>[$ULx, $ULy, $width, $max_h],
1186							'font_size'=>$cell_font_size,
1187	0					0	%{$content->[2]});
	0					0
1188	0	0				0	if ($rc) {
1189							# splitting cell
1190	0					0	$actual_row_height = max($actual_row_height,
1191							$cur_y - $bottom_margin);
1192							} else {
1193							# got entire content onto this page
1194	0					0	$actual_row_height = max($actual_row_height,
1195							$cur_y - $next_y + $cell_pad_bot +
1196							($cell_leading - $cell_font_size)*1.0);
1197							}
1198							# 1.0 multiplier is a good-looking fudge factor to add a
1199							# little space between bottom of text and bottom of cell
1200
1201							# at this point, actual_row_height is the used
1202							# height of this row, for purposes of background cell
1203							# color and left rule drawing. current_min_rh is left as
1204							# the height of one line + padding.
1205
1206	0	0				0	if ( $rc ) {
1207	0					0	$leftovers->[$col_idx] = [ 'pre', $remainder,
1208							$content->[2] ];
1209	0					0	$do_leftovers = 1;
1210							}
1211
1212							} elsif ( $content !~ m/(.\n.)/ and
1213							$data_row_widths->[$col_idx] and
1214							$data_row_widths->[$col_idx] <=
1215							$actual_column_widths[$row_idx][$col_idx] ) {
1216							# no embedded newlines (no multiple lines)
1217							# and the content width is <= calculated column width?
1218							# content will fit on one line, use text_* calls
1219	46	50				101	if ($ink) {
1220	46	100				100	if ($cell_justify eq 'right') {
		100
1221							# right justified before right padding
1222	5					30	$txt->translate($cur_x + $actual_column_widths[$row_idx][$col_idx] - $cell_pad_right, $text_start_y);
1223	5					40	$txt->text_right($content, %text_options);
1224							} elsif ($cell_justify eq 'center') {
1225							# center text within the margins (padding)
1226	6					42	$txt->translate($cur_x + $cell_pad_left + ($actual_column_widths[$row_idx][$col_idx] - $cell_pad_left - $cell_pad_right)/2, $text_start_y);
1227	6					45	$txt->text_center($content, %text_options);
1228							} else {
1229							# left justified after left padding
1230							# (text_left alias for text, in PDF::Builder only)
1231	35					106	$txt->translate($cur_x + $cell_pad_left, $text_start_y);
1232	35					268	$txt->text($content, %text_options);
1233							}
1234							}
1235
1236							} else {
1237	3					20	my ($width_of_last_line, $ypos_of_last_line,
1238							$left_over_text)
1239							= $self->text_block(
1240							$txt,
1241							$content,
1242							$row_idx, $col_idx,
1243							# mandatory args
1244							'x' => $cur_x + $cell_pad_left,
1245							'y' => $text_start_y,
1246							'w' => $actual_column_widths[$row_idx][$col_idx] -
1247							$cell_pad_left - $cell_pad_right,
1248							'h' => $cur_y - $bot_margin -
1249							$cell_pad_top - $cell_pad_bot,
1250							# non-mandatory args
1251							'font_size' => $cell_font_size,
1252							'leading' => $cell_leading,
1253							'align' => $cell_justify,
1254							'text_opt' => \%text_options,
1255							);
1256							# Desi - Removed $leading because of
1257							# fixed incorrect ypos bug in text_block
1258	3					26	$actual_row_height = max($actual_row_height,
1259							$cur_y - $ypos_of_last_line + $cell_pad_bot +
1260							($cell_leading - $cell_font_size)*2.5);
1261							# 2.5 multiplier is a good-looking fudge factor to add a
1262							# little space between bottom of text and bottom of cell
1263
1264							# at this point, actual_row_height is the used
1265							# height of this row, for purposes of background cell
1266							# color and left rule drawing. current_min_rh is left as
1267							# the height of one line + padding.
1268
1269	3	50				10	if ( $left_over_text ) {
1270	0					0	$leftovers->[$col_idx] = $left_over_text;
1271	0					0	$do_leftovers = 1;
1272							}
1273							}
1274
1275							# Hook to pass coordinates back - http://www.perlmonks.org/?node_id=754777
1276	49	100				302	if (ref $arg{'cell_render_hook'} eq 'CODE') {
1277	9					31	$arg{'cell_render_hook'}->(
1278							$page,
1279							$first_row,
1280							$row_idx,
1281							$col_idx,
1282							$cur_x,
1283							$cur_y-$actual_row_height,
1284							$actual_column_widths[$row_idx][$col_idx],
1285							$actual_row_height
1286							);
1287							}
1288
1289	49					127	$cur_x += $actual_column_widths[$row_idx][$col_idx];
1290							# otherwise lose track of column-related settings
1291	49					69	$save_bg_color[$col_idx] = $bg_color;
1292	49					77	$save_fg_color[$col_idx] = $fg_color;
1293	49					96	$save_v_rule_w[$col_idx] = $cell_v_rule_w;
1294	49					65	$save_h_rule_w[$col_idx] = $cell_h_rule_w;
1295	49					67	$save_v_rule_c[$col_idx] = $cell_v_rule_c;
1296	49					180	$save_h_rule_c[$col_idx] = $cell_h_rule_c;
1297							} # done looping through columns for this row
1298	19	50				45	if ( $do_leftovers ) {
1299							# leftover text in row to output later as new-ish row?
1300	0					0	unshift @$data, $leftovers;
1301	0					0	unshift @$row_col_widths, $data_row_widths;
1302	0					0	unshift @$rows_height, $current_min_rh;
1303							# if push actual_row_height back onto rows_height, it will be
1304							# far too much in some cases, resulting in excess blank space at bottom.
1305							}
1306	19	50				39	if ($oddeven_default) { # new method with consistent odd/even
1307	19	100	100			62	if ( !($first_row and $do_headers) ) {
1308							# only toggle if not a header
1309	18					37	$row_is_odd = ! $row_is_odd;
1310							}
1311							}
1312
1313							# Draw cell bgcolor
1314							# This has to be done separately from the text loop
1315							# because we do not know the final height of the cell until
1316							# all text has been drawn. Nevertheless, it ($gfx_bg) will
1317							# still be rendered before text ($txt).
1318	19					34	$cur_x = $xbase;
1319	19					62	for (my $col_idx = 0;
1320							$col_idx < scalar(@$data_row);
1321							$col_idx++) {
1322							# restore cell_bg_color, etc.
1323	50					76	$bg_color = $save_bg_color[$col_idx];
1324	50					70	$fg_color = $save_fg_color[$col_idx];
1325	50					60	$cell_v_rule_w = $save_v_rule_w[$col_idx];
1326	50					62	$cell_h_rule_w = $save_h_rule_w[$col_idx];
1327	50					75	$cell_v_rule_c = $save_v_rule_c[$col_idx];
1328	50					67	$cell_h_rule_c = $save_h_rule_c[$col_idx];
1329
1330							# TBD rowspan!
1331	50	50				89	if ($ink) {
1332	50	100	66			169	if (defined $bg_color &&
1333							!$colspanned{$row_idx.'_'.$col_idx}) {
1334	18					64	$gfx_bg->rect( $cur_x, $cur_y-$actual_row_height,
1335							$actual_column_widths[$row_idx][$col_idx], $actual_row_height);
1336	18					138	$gfx_bg->fillcolor($bg_color);
1337	18					109	$gfx_bg->fill();
1338							}
1339
1340							# draw left vertical border of this cell unless leftmost
1341	50	100	66			324	if ($gfx && $cell_v_rule_w && $col_idx &&
			100
			66
1342							!$colspanned{$row_idx.'_'.$col_idx}) {
1343	23					105	$gfx->linewidth($cell_v_rule_w);
1344	23					179	$gfx->strokecolor($cell_v_rule_c);
1345	23					158	$gfx->move($cur_x, $cur_y-$actual_row_height);
1346	23	100				211	$gfx->vline( $cur_y - ($row_idx? 0: $h_border_w/2));
1347	23					134	$gfx->stroke(); # don't confuse different widths and colors
1348							}
1349
1350							# draw bottom horizontal rule of this cell unless bottom
1351							# of page (no more data or not room for at least one line).
1352							# TBD fix up when implement rowspan
1353	50	100	66			240	if ($gfx && $cell_h_rule_w && scalar(@{$data}) &&
	36		100			122
			66
1354							$cur_y-$actual_row_height-$current_min_rh > $bot_margin ) {
1355	15					39	$gfx->linewidth($cell_h_rule_w);
1356	15					113	$gfx->strokecolor($cell_h_rule_c);
1357	15					87	$gfx->move($cur_x, $cur_y-$actual_row_height);
1358	15					97	$gfx->hline( $cur_x + $actual_column_widths[$row_idx][$col_idx] );
1359	15					110	$gfx->stroke(); # don't confuse different widths and colors
1360							}
1361							}
1362
1363	50					189	$cur_x += $calc_column_widths->[$col_idx];
1364							} # End of for (my $col_idx....
1365
1366	19					36	$cur_y -= $actual_row_height;
1367	19	50				46	if (!$ink) {
1368	0	0	0			0	if ($first_row && $do_headers) {
1369							# this was a header row
1370	0					0	$vsizes[1] = $actual_row_height;
1371							} else {
1372							# this was a non-header row
1373	0					0	push @vsizes, $actual_row_height;
1374							}
1375							# if implement footer, it will go in [2]
1376							}
1377
1378	19	50				38	if ($do_leftovers) {
1379							# a row has been split across pages. undo bg toggle
1380	0					0	$row_is_odd = !$row_is_odd;
1381	0					0	$next_top_border = 2; # dashed line
1382							} else {
1383	19					26	$row_idx++;
1384	19					32	$next_top_border = 1; # solid line
1385							}
1386	19					72	$first_row = 0;
1387							} # End of Row_Loop for this page, and possibly whole table
1388
1389							# draw bottom border on this page. first, is this very last row?
1390							# The line overlays and hides any odd business with vertical rules
1391							# in the last row
1392	11	100				20	if (!scalar(@{$data})) { $next_top_border = 0; }
	11					32
	10					18
1393	11	50				27	if ($ink) {
1394	11	100	66			59	if ($gfx && $h_border_w) {
1395	8	50				37	if ($next_top_border == 0) {
		0
1396							# last bottom border, use specified border
1397	8					46	$gfx->linewidth($h_border_w);
1398							} elsif ($next_top_border == 1) {
1399							# solid thin line at start of a row
1400	0					0	$gfx->linewidth($border_w_default);
1401							} else { # == 2
1402							# dashed thin line at continuation in middle of row
1403	0					0	$gfx->linewidth($border_w_default);
1404	0					0	$gfx->linedash($dashed_rule_default);
1405							}
1406							# leave next_top_border for next page top of continued table
1407	8					62	$gfx->strokecolor($border_c);
1408	8					84	$gfx->move( $xbase-$v_border_w/2 , $cur_y );
1409	8					87	$gfx->hline($xbase + $width + $v_border_w/2);
1410	8					51	$gfx->stroke();
1411	8					42	$gfx->linedash();
1412							}
1413
1414	11	50				67	if ($gfx) {
1415	11	100				35	if ($v_border_w) {
1416							# Draw left and right table borders
1417							# These overlay and hide any odd business with horizontal
1418							# rules at the left or right edge
1419	8					30	$gfx->linewidth($v_border_w);
1420	8					57	$gfx->move( $xbase, $table_top_y);
1421	8					51	$gfx->vline( $cur_y );
1422	8					59	$gfx->move( $xbase + $width, $table_top_y);
1423	8					41	$gfx->vline( $cur_y );
1424							}
1425
1426							# draw all the unrendered lines
1427	11					70	$gfx->stroke();
1428							}
1429							}
1430	11					77	$pg_cnt++; # on a spillover page
1431							} # End of while (scalar(@{$data})) next row, adding new page if necessary
1432
1433	10	50				26	if ($ink) {
1434	10					192	return ($page, --$pg_cnt, $cur_y);
1435							} else {
1436							# calculate overall table height as sum of 1..$#vsizes
1437	0					0	for (my $i = 1; $i < @vsizes; $i++) {
1438	0					0	$vsizes[0] += $vsizes[$i];
1439							}
1440							# might need to account for really thick horizontal border rules
1441	0					0	return @vsizes;
1442							}
1443							} # end of table()
1444
1445							############################################################
1446							# find a value that might be set in a default or in a global
1447							# or column/row/cell specific parameter. fixed order of search
1448							# is cell/header properties, column properties, row properties,
1449							# fallback sequences (e.g., padding_left inherits from padding),
1450							# global default
1451							############################################################
1452
1453							sub find_value {
1454	1764			1764	0	2953	my ($cell_val, $name, $fallback, $default, $GLOBALS) = @_;
1455							# $fallback can be '' (will be skipped)
1456
1457	1764					2717	my ($cell_props, $col_props, $row_props, $row_idx, $col_idx, $argref) =
1458							@$GLOBALS;
1459							# $row_idx should be 0 for a header entry
1460	1764					5936	my %arg = %$argref;
1461							# $default should never be undefined, except for specific cases!
1462	1764	50	100			6441	if (!defined $default &&
			100
			100
			100
			100
			100
			100
			66
			66
1463							($name ne 'underline' &&
1464							$name ne 'bg_color' && $name ne 'fg_color' &&
1465							$name ne 'bg_color_even' && $name ne 'bg_color_odd' &&
1466							$name ne 'fg_color_even' && $name ne 'fg_color_odd' &&
1467							$name ne 'min_w' && $name ne 'max_w') ) {
1468	0					0	carp "Error! find_value() default value undefined for '$name'\n";
1469							}
1470
1471							# upon entry, $cell_val is usually either undefined (data row) or
1472							# header property setting (in which case, already set and we're done here)
1473	1764	50				4173	$cell_val = $cell_props->[$row_idx][$col_idx]->{$name} if
1474							!defined $cell_val;
1475	1764	100	100			4658	$cell_val = $cell_props->[$row_idx][$col_idx]->{$fallback} if
1476							!defined $cell_val && $fallback ne '';
1477	1764	100				3310	$cell_val = $col_props->[$col_idx]->{$name} if
1478							!defined $cell_val;
1479	1764	100	100			4397	$cell_val = $col_props->[$col_idx]->{$fallback} if
1480							!defined $cell_val && $fallback ne '';
1481	1764	100				2911	$cell_val = $row_props->[$row_idx]->{$name} if
1482							!defined $cell_val;
1483	1764	100	100			4234	$cell_val = $row_props->[$row_idx]->{$fallback} if
1484							!defined $cell_val && $fallback ne '';
1485	1764	100				2938	$cell_val = $arg{$name} if
1486							!defined $cell_val;
1487	1764	100	100			4252	$cell_val = $arg{$fallback} if
1488							!defined $cell_val && $fallback ne '';
1489
1490							# final court of appeal is the global default (usually defined)
1491	1764	100				2860	if (!defined $cell_val) {
1492	1663					2062	$cell_val = $default;
1493							}
1494
1495	1764					3990	return $cell_val;
1496							} # end of find_value()
1497
1498							############################################################
1499							# text_block - utility method to build multi-paragraph blocks of text
1500							#
1501							# Parameters:
1502							# $text_object the TEXT object used to output to the PDF
1503							# $text the text to be formatted
1504							# %arg settings to control the formatting and
1505							# output.
1506							# mandatory: x, y, w, h (block position and dimensions)
1507							# defaults are provided for:
1508							# font_size (global $font_size_default)
1509							# leading (font_size * global $leading_ratio)
1510							# no defaults for:
1511							# text_opt (such as underline flag and color)
1512							# parspace (extra vertical space before a paragraph)
1513							# hang (text for ?)
1514							# indent (indentation amount)
1515							# fpindent (first paragraph indent amount)
1516							# flindent (first line indent amount)
1517							# align (justification left\|center\|right\|fulljustify\|justify)
1518							#
1519							# $text comes in as one string, possibly with \n embedded.
1520							# split at \n to form 2 or more @paragraphs. each @paragraph
1521							# is a @paragraphs element split on ' ' (list of words to
1522							# fill the available width). one word at a time is moved
1523							# from @paragraph to @line, until the width of the joined
1524							# @line (with ' ' between words) can't be any larger.
1525							# TBD: deal with multiple spaces between words
1526							############################################################
1527
1528							sub text_block {
1529	3			3	1	5	my $self = shift;
1530	3					4	my $text_object = shift;
1531	3					5	my $text = shift; # The text to be displayed
1532	3					5	my $row_idx = shift; # cell row,col for debug
1533	3					4	my $col_idx = shift;
1534	3					15	my %arg = @_; # Additional Arguments
1535
1536	3					19	my ( $align, $xpos, $ypos, $xbase, $ybase, $line_width, $wordspace, $endw , $width, $height) =
1537							( undef , undef, undef, undef , undef , undef , undef , undef , undef , undef );
1538	3					8	my @line = (); # Temp data array with words on one line
1539	3					4	my %width = (); # The width of every unique word in the given text
1540	3					5	my %text_options = %{ $arg{'text_opt'} };
	3					7
1541
1542							# Try to provide backward compatibility. "-" starting key name is optional
1543	3					12	foreach my $key (keys %arg) {
1544	24					29	my $newkey = $key;
1545	24	50				47	if ($newkey =~ s#^-##) {
1546	0					0	$arg{$newkey} = $arg{$key};
1547	0					0	delete $arg{$key};
1548							}
1549							}
1550							#####
1551
1552							#---
1553							# Let's check mandatory parameters with no default values
1554							#---
1555	3		50			9	$xbase = $arg{'x'} \|\| -1;
1556	3		50			7	$ybase = $arg{'y'} \|\| -1;
1557	3		50			8	$width = $arg{'w'} \|\| -1;
1558	3		50			5	$height = $arg{'h'} \|\| -1;
1559	3	50				7	unless ( $xbase > 0 ) {
1560	0					0	carp "Error: Left Edge of Block is NOT defined!\n";
1561	0					0	return (0, $ybase, '');
1562							}
1563	3	50				6	unless ( $ybase > 0 ) {
1564	0					0	carp "Error: Base Line of Block is NOT defined!\n";
1565	0					0	return (0, $ybase, '');
1566							}
1567	3	50				7	unless ( $width > 0 ) {
1568	0					0	carp "Error: Width of Block is NOT defined!\n";
1569	0					0	return (0, $ybase, '');
1570							}
1571	3	50				8	unless ( $height > 0 ) {
1572	0					0	carp "Error: Height of Block is NOT defined!\n";
1573	0					0	return (0, $ybase, '');
1574							}
1575
1576							# Check if any text to display. If called from table(), should have
1577							# default text by the time of the call, so this is really as a failsafe
1578							# for standalone text_block() calls. Note that '' won't work!
1579	3	50	33			12	unless ( defined( $text) and length($text) > 0 ) {
1580							# carp "Warning: No input text found. Use dummy '-'.\n";
1581							# $text = $empty_cell_text;
1582	0					0	$text = ' ';
1583							}
1584
1585							# Strip any and Split the text into paragraphs
1586							# if you're on a platform that uses \r to end a line (old Macs?)...
1587							# we're in text_block() only if long line or \n's seen
1588							# @paragraphs is list of paragraphs (long lines)
1589							# @paragraph is list of words within present paragraph (long line)
1590	3					7	$text =~ s/\r//g;
1591	3					18	my @paragraphs = split(/\n/, $text);
1592
1593							# Width between lines (leading) in points
1594	3		33			10	my $font_size = $arg{'font_size'} \|\| $font_size_default;
1595	3	50	33			24	my $line_space = defined $arg{'leading'} && $arg{'leading'} > 0 ? $arg{'leading'} : undef;
1596	3		33			7	$line_space \|\|= $font_size * $leading_ratio;
1597							# leading must be at least font size
1598	3	50				7	$line_space = $font_size * $leading_ratio if $font_size > $line_space;
1599
1600							# Calculate width of all words
1601	3					12	my $space_width = $text_object->advancewidth("\x20");
1602	3					12	my %word_width;
1603	3					24	my @text_words = split(/\s+/, $text);
1604	3					10	foreach (@text_words) {
1605	13	50				59	next if exists $word_width{$_};
1606	13					23	$word_width{$_} = $text_object->advancewidth($_);
1607							}
1608
1609							# get word list for first paragraph
1610	3					23	my @paragraph = split(' ', shift(@paragraphs));
1611	3					6	my $first_line = 1; # first line of THIS paragraph
1612	3					5	my $paragraph_number = 1;
1613
1614							# Little Init
1615	3					5	$xpos = $xbase;
1616	3					4	$ypos = $ybase;
1617	3					4	$ypos = $ybase + $line_space;
1618							# bottom_border doesn't need to consider pad_bot, as we're only considering
1619							# the space actually available within the cell, already reduced by padding.
1620	3					9	my $bottom_border = $ypos - $height;
1621
1622							# While we can add another line. No handling of widows and orphans.
1623	3					9	while ( $ypos >= $bottom_border + $line_space ) {
1624							# Is there any text to render ?
1625	7	100				14	unless (@paragraph) {
1626							# Finish if nothing left of all the paragraphs in text
1627	3	50				7	last unless scalar @paragraphs; # another paragraph to process?
1628							# Else take one paragraph (long line) from the text
1629	0					0	@paragraph = split(' ', shift( @paragraphs ) );
1630	0					0	$paragraph_number++;
1631
1632							# extra space between paragraphs? only if a previous paragraph
1633	0	0	0			0	$ypos -= $arg{'parspace'} if $arg{'parspace'} and
1634							$paragraph_number > 1;
1635	0	0				0	last unless $ypos >= $bottom_border;
1636							}
1637	4					6	$ypos -= $line_space;
1638	4					7	$xpos = $xbase;
1639
1640							# While there's room on the line, add another word
1641	4					7	@line = ();
1642	4					6	$line_width = 0;
1643							# TBD what exactly is hang supposed to do, interaction with
1644							# indent, flindent, fpindent AND effect on min cell width
1645	4	50	66			76	if ( $first_line && exists $arg{'hang'} ) {
		50	66
		50	33
		50	33
			33
			33
1646							# fixed text to output first, for first line of a paragraph
1647							# TBD Note that hang text is not yet checked for min_col_width or
1648							# max_word_len, and other indents could make line too wide for col!
1649	0					0	my $hang_width = $text_object->advancewidth($arg{'hang'});
1650
1651	0	0				0	$text_object->translate( $xpos, $ypos ) if $ink;
1652	0	0				0	$text_object->text( $arg{'hang'} ) if $ink;
1653
1654	0					0	$xpos += $hang_width;
1655	0					0	$line_width += $hang_width;
1656	0	0				0	$arg{'indent'} += $hang_width if $paragraph_number == 1;
1657							} elsif ( $first_line && exists $arg{'flindent'} &&
1658							$arg{'flindent'} > 0 ) {
1659							# amount to indent on first line of a paragraph
1660	0					0	$xpos += $arg{'flindent'};
1661	0					0	$line_width += $arg{'flindent'};
1662							} elsif ( $paragraph_number == 1 && exists $arg{'fpindent'} &&
1663							$arg{'fpindent'} > 0 ) {
1664							# amount to indent first paragraph's first line TBD ??
1665	0					0	$xpos += $arg{'fpindent'};
1666	0					0	$line_width += $arg{'fpindent'};
1667							} elsif ( exists $arg{'indent'} &&
1668							$arg{'indent'} > 0 ) {
1669							# amount to indent first line of following paragraphs
1670	0					0	$xpos += $arg{'indent'};
1671	0					0	$line_width += $arg{'indent'};
1672							}
1673
1674							# Let's take from paragraph as many words as we can put
1675							# into $width - $indent. repeatedly test with "just one more" word
1676							# from paragraph list, until overflow.
1677							# TBD might be more efficient (as originally intended?) to build
1678							# library of word widths and add them together until "too big",
1679							# back off.
1680							# TBD don't forget to properly handle runs of more than one space.
1681	4					17	while ( @paragraph ) {
1682	14	100				27	if ( !@line ) {
1683							# first time through, @line is empty
1684							# first word in paragraph SHOULD fit!!
1685							# TBD: what if $line_width > 0??? due to indent, etc.?
1686							# add 0.01 as safety
1687	4	50				11	if ( $text_object->advancewidth( $paragraph[0] ) +
1688							$line_width <= $width+0.01 ) {
1689	4					23	push(@line, shift(@paragraph));
1690	4	100				10	next if @paragraph;
1691							} else {
1692							# this should never happen, but just in case, to
1693							# prevent an infinite loop...
1694	0					0	die("!!! Error !!! first word in paragraph for row $row_idx, col $col_idx '$paragraph[0]' doesn't fit into empty line!");
1695							}
1696							} else {
1697							# @line has text in it already
1698	10	100				31	if ( $text_object->advancewidth( join(" ", @line)." " . $paragraph[0] ) +
1699							$line_width <= $width ) {
1700	9					42	push(@line, shift(@paragraph));
1701	9	100				20	next if @paragraph;
1702							}
1703							}
1704	4					21	last;
1705							}
1706	4					16	$line_width += $text_object->advancewidth(join(' ', @line));
1707
1708							# calculate the space width (width to use for a space)
1709	4		50			20	$align = $arg{'align'} \|\| 'left';
1710	4	50	33			20	if ( $align eq 'fulljustify' or
			33
1711							($align eq 'justify' and @paragraph)) {
1712	0	0				0	@line = split(//,$line[0]) if scalar(@line) == 1;
1713	0	0				0	if (scalar(@line) > 1) {
1714	0					0	$wordspace = ($width - $line_width) / (scalar(@line) - 1);
1715							} else {
1716	0					0	$wordspace = 0; # effectively left-aligned for single word
1717							}
1718	0					0	$align = 'justify';
1719							} else {
1720							# not adding extra spacing between words, just real space
1721	4	50				11	$align = 'left' if $align eq 'justify';
1722	4					6	$wordspace = $space_width;
1723							}
1724
1725	4					10	$line_width += $wordspace * (scalar(@line) - 1);
1726
1727	4	50				9	if ( $align eq 'justify') {
1728	0					0	foreach my $word (@line) {
1729	0	0				0	$text_object->translate( $xpos, $ypos ) if $ink;
1730	0	0				0	$text_object->text( $word ) if $ink;
1731	0	0				0	$xpos += ($word_width{$word} + $wordspace) if (@line);
1732							}
1733	0					0	$endw = $width;
1734							} else {
1735							# calculate the left hand position of the line
1736							# if ( $align eq 'right' ) {
1737							# $xpos += $width - $line_width;
1738							# } elsif ( $align eq 'center' ) {
1739							# $xpos += ( $width - $line_width ) / 2;
1740							# }
1741
1742	4	50				8	if ($ink) {
1743							# render the line. TBD This may not work right with indents!
1744	4	50				9	if ($align eq 'right') {
		50
1745	0					0	$text_object->translate( $xpos+$width, $ypos );
1746	0					0	$endw = $text_object->text_right(join(' ', @line), %text_options);
1747							} elsif ($align eq 'center') {
1748	0					0	$text_object->translate( $xpos + $width/2, $ypos );
1749	0					0	$endw = $text_object->text_center(join(' ', @line), %text_options);
1750							} else {
1751	4					11	$text_object->translate( $xpos, $ypos );
1752	4					35	$endw = $text_object->text(join(' ', @line), %text_options);
1753							}
1754							}
1755							}
1756	4					25	$first_line = 0;
1757							} # End of while (fitting within vertical space)
1758
1759							# any leftovers of current paragraph? will return as first new paragraph
1760	3	50				6	unshift(@paragraphs, join(' ',@paragraph)) if scalar(@paragraph);
1761
1762	3					20	return ($endw, $ypos, join("\n", @paragraphs))
1763							} # End of text_block()
1764
1765							1;
1766
1767							__END__