File Coverage

blib/lib/PDF/Table.pm

Criterion	Covered	Total	%
statement	552	705	78.3
branch	183	318	57.5
condition	162	293	55.2
subroutine	17	17	100.0
pod	3	9	33.3
total	917	1342	68.3

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