File Coverage

blib/lib/PDF/Table.pm
Criterion Covered Total %
statement 553 712 77.6
branch 185 324 57.1
condition 165 299 55.1
subroutine 17 17 100.0
pod 3 9 33.3
total 923 1361 67.8


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   505150 use 5.010;
  4         16  
5 4     4   25 use strict;
  4         10  
  4         126  
6 4     4   18 use warnings;
  4         7  
  4         315  
7              
8             package PDF::Table;
9              
10             # portions (c) copyright 2004 Stone Environmental Inc.
11             # (c) copyright 2006 Daemmon Hughes
12             # (c) copyright 2020 - 2025 by Phil M. Perry
13            
14 4     4   22 use Carp;
  4         13  
  4         331  
15 4     4   24 use List::Util qw[min max]; # core
  4         6  
  4         333  
16              
17 4     4   2311 use PDF::Table::ColumnWidth;
  4         40  
  4         172  
18 4     4   2010 use PDF::Table::Settings;
  4         13  
  4         38921  
19             # can't move text_block() b/c many globals referenced
20              
21             our $VERSION = '1.007'; # fixed, read by Makefile.PL
22             our $LAST_UPDATE = '1.007'; # 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 546164 my $type = shift(@_);
74 7   33     45 my $class = ref($type) || $type;
75 7         14 my $self = {};
76 7         15 bless ($self, $class);
77              
78             # Pass all the rest to init for validation and initialization
79 7         30 $self->_init(@_);
80              
81 7         52 return $self;
82             }
83              
84             sub _init {
85 7     7   17 my ($self, $pdf, $page, $data, %options ) = @_;
86              
87             # Check and set default values
88 7         26 $self->set_defaults();
89              
90             # Check and set mandatory parameters
91 7         25 $self->set_pdf($pdf);
92 7         24 $self->set_page($page);
93 7         20 $self->set_data($data);
94 7         22 $self->set_options(\%options);
95              
96 7         10 return;
97             }
98              
99             sub set_defaults {
100 7     7 0 11 my $self = shift;
101              
102 7         39 $self->{'font_size'} = $font_size_default;
103 7         29 $min_col_width = max($min_col_width, 1); # minimum width
104 7         11 return;
105             }
106              
107             sub set_pdf {
108 7     7 0 78 my ($self, $pdf) = @_;
109 7         17 $self->{'pdf'} = $pdf;
110 7         21 return;
111             }
112              
113             sub set_page {
114 7     7 0 52 my ($self, $page) = @_;
115 7 50 33     51 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         19 $self->{'page'} = $page;
128 7         27 return;
129             }
130              
131             sub set_data {
132 7     7 0 15 my ($self, $data) = @_;
133             # TODO: implement
134 7         10 return;
135             }
136              
137             sub set_options {
138 7     7 0 15 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 6092 my $self = shift;
153 14         44 my $pdf = shift;
154 14         23 my $page = shift;
155 14         25 my $data = shift;
156 14         86 my %arg = @_;
157              
158             #=====================================
159             # Mandatory Arguments Section
160             #=====================================
161 13 50 33     99 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     327 croak "Error: Invalid PDF object received."
168             unless (ref($pdf) eq 'PDF::API2' ||
169             ref($pdf) eq 'PDF::Builder');
170 12 100 66     249 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     458 croak "Error: Invalid data received."
174             unless ((ref($data) eq 'ARRAY') && scalar(@$data));
175 10 50       27 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     47 $arg{'cell_render_hook' } ||= undef;
185              
186             # $ink is whether or not to output PDF, as opposed to sizing
187 10 50       37 $ink = $arg{'ink'} if defined $arg{'ink'}; # 1 yes, 0 no (size)
188 10         12 my @vsizes;
189              
190             # Validate settings key
191 10         367 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         42 foreach my $key (keys %arg) {
262             # Provide backward compatibility
263 90 50       169 $arg{$key} = delete $arg{"-$key"} if $key =~ s/^-//;
264              
265             croak "Error: Invalid setting key '$key' received."
266 90 50       171 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     42 $xbase = $arg{'x'} || -1;
274 10   50     33 $ybase = $arg{'y'} || $arg{'start_y'} || -1;
275 10   50     40 $width = $arg{'w'} || -1;
276 10   50     38 $height = $arg{'h'} || $arg{'start_h'} || -1;
277              
278             # Global geometry parameters are also mandatory.
279 10 50       27 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       53 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       34 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       29 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         16 my $bottom_margin = $ybase - $height;
296              
297 10         15 my $pg_cnt = 1;
298 10         18 my $cur_y = $ybase;
299 10   100     38 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     26 my $next_y = $arg{'next_y'} || undef;
309 10   50     21 my $next_h = $arg{'next_h'} || undef;
310 10   50     33 my $size = $arg{'size'} || undef;
311              
312             # Create Text Object
313 10         37 my $txt = $page->text(); # $ink==0 still needs for font size, etc.
314             # doing sizing or actual output?
315 10 50       147 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         19 my $header_props = undef;
330 10         52 my $do_headers = 0; # not doing headers
331              
332             # Check if the user enabled it ?
333 10 100 66     31 if (defined $arg{'header_props'} and ref( $arg{'header_props'}) eq 'HASH') {
334             # Transfer the reference to local variable
335 1         1 $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         1 $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         16 my $header_row = undef;
345             # Copy the header row (text) if header is enabled
346 10 100       43 @$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     34 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     59 my $row_props = $arg{'row_props'} || [];
356              
357             # deprecated setting (globals) names, copy to new names
358 10         54 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         50 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     79 my $fnt_obj = $arg{'font' } ||
368             $pdf->corefont('Times-Roman',-encode => 'latin1');
369 10   66     116 my $fnt_size = $arg{'font_size' } || $font_size_default;
370 10         27 my $min_leading = $fnt_size * $leading_ratio;
371 10   33     48 my $leading = $arg{'leading'} || $min_leading;
372 10 50       74 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       40 my $border_w = defined $arg{'border_w'}? $arg{'border_w'}: 1;
379 10   66     64 my $h_border_w = $arg{'h_border_w'} || $border_w;
380 10   66     34 my $v_border_w = $arg{'v_border_w'} || $border_w;
381              
382             # non-geometry global settings
383 10   66     42 my $border_c = $arg{'border_c'} || $fg_color_default;
384             # global fallback values for find_value() call
385 10   50     37 my $underline = $arg{'underline' } ||
386             undef; # merely stating undef is the intended default
387 10   66     47 my $max_word_len = $arg{'max_word_length' } || $max_wordlen_default;
388 10   33     35 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         23 my $row_col_widths = [];
393             # An array ref with the widths of the header row
394 10         12 my $h_row_widths = [];
395              
396             # Scalars that hold sum of the maximum and minimum widths of all columns
397 10         22 my ( $max_col_w, $min_col_w ) = ( 0,0 );
398 10         16 my ( $row, $space_w );
399              
400 10         17 my $word_widths = {};
401 10         17 my $rows_height = [];
402 10         13 my $first_row = 1;
403 10         18 my $is_header_row = 0;
404              
405             # per-cell values
406 10         28 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         25 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         15 my $col_min_width = []; # holds the running width of each column
425 10         13 my $col_max_content = []; # min and max (min_w & longest word,
426             # length of content)
427 10         15 my $max_w = []; # each column's max_w, if defined
428 10         25 for ( my $row_idx = 0; $row_idx < scalar(@$data) ; $row_idx++ ) {
429 19         34 $GLOBALS->[3] = $row_idx;
430 19         30 my $column_widths = []; # holds the width of each column
431             # initialize the height for this row
432 19         34 $rows_height->[$row_idx] = 0;
433              
434 19         30 for ( my $col_idx = 0;
435 69         242 $col_idx < scalar(@{$data->[$row_idx]});
436             $col_idx++ ) {
437 50         70 $GLOBALS->[4] = $col_idx;
438             # initialize min and max column content widths to 0
439 50 100       129 $col_min_width->[$col_idx]=0 if !defined $col_min_width->[$col_idx];
440 50 100       105 $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         74 my $bad_markup = '';
445 50 50       121 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         72 $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       98 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     141 if ( !$row_idx && $do_headers ) {
493             # header row
494 3         14 $is_header_row = 1;
495 3         4 $GLOBALS->[3] = 0;
496 3         4 $cell_font = $header_props->{'font'};
497 3         3 $cell_font_size = $header_props->{'font_size'};
498 3         5 $cell_leading = $header_props->{'leading'};
499 3         4 $cell_height = $header_props->{'min_rh'};
500             $cell_pad_top = $header_props->{'padding_top'} ||
501 3   33     8 $header_props->{'padding'};
502             $cell_pad_right = $header_props->{'padding_right'} ||
503 3   33     7 $header_props->{'padding'};
504             $cell_pad_bot = $header_props->{'padding_bottom'} ||
505 3   33     5 $header_props->{'padding'};
506             $cell_pad_left = $header_props->{'padding_left'} ||
507 3   33     6 $header_props->{'padding'};
508 3         3 $cell_max_word_len = $header_props->{'max_word_length'};
509 3         4 $cell_min_w = $header_props->{'min_w'};
510 3         3 $cell_max_w = $header_props->{'max_w'};
511 3         4 $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         60 $is_header_row = 0;
528 47         65 $cell_font = undef;
529 47         58 $cell_font_size = undef;
530 47         96 $cell_leading = undef;
531 47         49 $cell_height = undef;
532 47         54 $cell_pad_top = undef;
533 47         61 $cell_pad_right = undef;
534 47         52 $cell_pad_bot = undef;
535 47         53 $cell_pad_left = undef;
536 47         62 $cell_max_word_len = undef;
537 47         50 $cell_min_w = undef;
538 47         59 $cell_max_w = undef;
539 47         92 $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         118 $cell_font = find_value($cell_font,
561             'font', '', $fnt_obj, $GLOBALS);
562 50         95 $cell_font_size = find_value($cell_font_size,
563             'font_size', '', 0, $GLOBALS);
564 50 100       115 if ($cell_font_size == 0) {
565 22 50       51 if ($is_header_row) {
566 0         0 $cell_font_size = $fnt_size + 2;
567             } else {
568 22         33 $cell_font_size = $fnt_size;
569             }
570             }
571 50         96 $cell_leading = find_value($cell_leading, 'leading',
572             '', -1, $GLOBALS);
573 50         96 $cell_height = find_value($cell_height,
574             'min_rh', '', 0, $GLOBALS);
575 50         86 $cell_pad_top = find_value($cell_pad_top, 'padding_top',
576             'padding', $padding_default,
577             $GLOBALS);
578 50         99 $cell_pad_right = find_value($cell_pad_right, 'padding_right',
579             'padding', $padding_default,
580             $GLOBALS);
581 50         82 $cell_pad_bot = find_value($cell_pad_bot, 'padding_bottom',
582             'padding', $padding_default,
583             $GLOBALS);
584 50         87 $cell_pad_left = find_value($cell_pad_left, 'padding_left',
585             'padding', $padding_default,
586             $GLOBALS);
587 50         93 $cell_max_word_len = find_value($cell_max_word_len, 'max_word_len',
588             '', $max_word_len, $GLOBALS);
589 50         96 $cell_min_w = find_value($cell_min_w, 'min_w',
590             '', undef, $GLOBALS);
591 50         132 $cell_max_w = find_value($cell_max_w, 'max_w',
592             '', undef, $GLOBALS);
593 50 50 33     174 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         91 $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         100 my $min_leading = $cell_font_size * $leading_ratio;
625 50 50       97 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         198 $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         489 $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     273 if ( $cell_max_word_len > 0 && $data->[$row_idx][$col_idx] &&
      66        
651             ref($data->[$row_idx][$col_idx]) eq '') {
652 48         586 $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         145 $space_w = $txt->advancewidth( "\x20" );
657             # font/size can change for each cell, so space width can vary
658 50         213 $column_widths->[$col_idx] = 0; # per-row basis
659 50         78 $max_col_w = 0;
660 50         61 $min_col_w = 0;
661              
662 50         70 my @words;
663 50 100       188 @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         100 foreach ( @words ) {
679 60 100       131 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         109 $word_widths->{$_} = $txt->advancewidth($_);
683             }
684              
685             # minimum width is longest word or fragment
686 60         286 $min_col_w = max($min_col_w, $word_widths->{$_});
687             # maximum width is total text in cell
688 60 100       114 if ($max_col_w) {
689             # already have text, so add a space first
690             # note that multiple spaces between words become one!
691 12         29 $max_col_w += $space_w;
692             } else {
693             # first word, so no space [before]
694             }
695 60         109 $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         97 $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         198 $min_col_w += $cell_pad_left + $cell_pad_right;
707 50 50       106 $min_col_w = max($min_col_w, $cell_min_w) if defined $cell_min_w;
708 50         74 $max_col_w += $cell_pad_left + $cell_pad_right;
709 50         88 $max_col_w = max($min_col_w, $max_col_w);
710 50         95 $col_min_width->[$col_idx] = max($col_min_width->[$col_idx],
711             $min_col_w);
712 50         115 $col_max_content->[$col_idx] = max($col_max_content->[$col_idx],
713             $max_col_w);
714              
715 50 100       102 if (!defined $max_w->[$col_idx]) { $max_w->[$col_idx] = -1; }
  27         47  
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         125 $column_widths->[$col_idx] = $col_max_content->[$col_idx];
719              
720             } # (End of cols) for (my $col_idx....
721              
722 19         48 $row_col_widths->[$row_idx] = $column_widths;
723              
724             # Copy the calculated row properties of header row.
725 19 100 100     92 @$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         15 my $calc_column_widths;
731 10         24 my $em_size = $txt->advancewidth('M');
732 10         43 my $ex_size = $txt->advancewidth('x');
733              
734 10 50       47 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         84 ($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         17 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         16 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         16 my $next_top_border = 0;
752              
753 10         17 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         13 while (scalar(@{$data})) { # still row(s) remaining to output
  21         55  
758 11         19 my ($page_header, $columns_number);
759              
760 11 100       26 if ($pg_cnt == 1) {
761             # on first page output
762 10         15 $table_top_y = $ybase;
763 10         28 $bot_margin = $table_top_y - $height;
764              
765             # Check for safety reasons
766 10 50       25 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       4 if (ref $arg{'new_page_func'}) {
775 0         0 $page = &{ $arg{'new_page_func'} };
  0         0  
776             } else {
777 1         4 $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       28 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       3 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       3 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       3 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         19 my $min_height = $rows_height->[0];
836 11 50 100     79 $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       30 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       47 $gfx_bg = $page->gfx() if $ink;
858 11         154 $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       40 $gfx = $page->gfx() if $ink; # for borders, rules, etc.
865 11 50       165 $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     130 if ($ink && $h_border_w) {
870 8 50       20 if ($next_top_border == 0) {
    0          
871             # first top border (page 1), use specified border
872 8         21 $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         98 $gfx->move( $xbase-$v_border_w/2 , $cur_y );
882 8         74 $gfx->hline($xbase + $width + $v_border_w/2);
883 8         101 $gfx->stroke();
884 8         47 $gfx->linedash();
885             }
886              
887 11         82 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     17 while (scalar(@{$data}) and $cur_y-$rows_height->[0] > $bot_margin) {
  30         114  
894             # Remove the next item from $data
895 19         33 my $data_row = shift @{$data};
  19         34  
896              
897             # Get max columns number to know later how many vertical lines to draw
898 19         31 $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         30 my $current_min_rh = shift @$rows_height;
903 19         40 my $actual_row_height = $current_min_rh;
904              
905             # Row cell widths
906 19         27 my $data_row_widths = shift @$row_col_widths;
907              
908             # remember, don't have cell_ stuff yet, just row items ($row_idx)!
909 19         27 my $cur_x = $xbase;
910 19         30 my $leftovers = undef; # Reference to text that is returned from text_block()
911 19         25 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         48 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         48 for ( my $col_idx = 0; $col_idx < $columns_number; $col_idx++ ) {
919 50         87 $GLOBALS->[3] = $row_idx;
920 50         72 $GLOBALS->[4] = $col_idx;
921             # now have each cell[$row_idx][$col_idx]
922 50 100       157 next if $colspanned{$row_idx.'_'.$col_idx};
923 49         90 $leftovers->[$col_idx] = undef;
924              
925             # look for font information for this cell
926 49         80 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     135 if ($first_row and $do_headers) {
932 3         6 $is_header_row = 1;
933 3         6 $GLOBALS->[3] = 0;
934 3         6 $cell_font = $header_props->{'font'};
935 3         7 $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     13 $header_props->{'padding'};
940             $cell_pad_right = $header_props->{'padding_right'} ||
941 3   33     12 $header_props->{'padding'};
942             $cell_pad_bot = $header_props->{'padding_bottom'} ||
943 3   33     12 $header_props->{'padding'};
944             $cell_pad_left = $header_props->{'padding_left'} ||
945 3   33     12 $header_props->{'padding'};
946 3         5 $cell_max_word_len = $header_props->{'max_word_length'};
947 3         4 $cell_min_w = $header_props->{'min_w'};
948 3         7 $cell_max_w = $header_props->{'max_w'};
949 3         4 $cell_underline = $header_props->{'underline'};
950 3         24 $cell_def_text = $header_props->{'default_text'};
951 3         6 $cell_justify = $header_props->{'justify'};
952 3         6 $cell_bg_color = $header_props->{'bg_color'};
953 3         5 $cell_fg_color = $header_props->{'fg_color'};
954 3         6 $cell_bg_color_even= undef;
955 3         5 $cell_bg_color_odd = undef;
956 3         5 $cell_fg_color_even= undef;
957 3         5 $cell_fg_color_odd = undef;
958 3         6 $cell_h_rule_w = $header_props->{'h_rule_w'};
959 3         5 $cell_v_rule_w = $header_props->{'v_rule_w'};
960 3         6 $cell_h_rule_c = $header_props->{'h_rule_c'};
961 3         6 $cell_v_rule_c = $header_props->{'v_rule_c'};
962             } else {
963             # not header row, so initialize to undefined
964 46         66 $is_header_row = 0;
965 46         61 $cell_font = undef;
966 46         57 $cell_font_size = undef;
967 46         56 $cell_leading = undef;
968 46         56 $cell_height = undef;
969 46         60 $cell_pad_top = undef;
970 46         66 $cell_pad_right = undef;
971 46         53 $cell_pad_bot = undef;
972 46         54 $cell_pad_left = undef;
973 46         58 $cell_max_word_len = undef;
974 46         56 $cell_min_w = undef;
975 46         60 $cell_max_w = undef;
976 46         53 $cell_underline = undef;
977 46         51 $cell_def_text = undef;
978 46         67 $cell_justify = undef;
979 46         56 $cell_bg_color = undef;
980 46         53 $cell_fg_color = undef;
981 46         53 $cell_bg_color_even= undef;
982 46         66 $cell_bg_color_odd = undef;
983 46         59 $cell_fg_color_even= undef;
984 46         51 $cell_fg_color_odd = undef;
985 46         51 $cell_h_rule_w = undef;
986 46         52 $cell_v_rule_w = undef;
987 46         61 $cell_h_rule_c = undef;
988 46         64 $cell_v_rule_c = undef;
989             }
990              
991             # Get the most specific value if none was already set from header_props
992 49         103 $cell_font = find_value($cell_font,
993             'font', '', $fnt_obj, $GLOBALS);
994 49         101 $cell_font_size = find_value($cell_font_size,
995             'font_size', '', 0, $GLOBALS);
996 49 100       98 if ($cell_font_size == 0) {
997 21 50       43 if ($is_header_row) {
998 0         0 $cell_font_size = $fnt_size + 2;
999             } else {
1000 21         33 $cell_font_size = $fnt_size;
1001             }
1002             }
1003 49         777 $cell_leading = find_value($cell_leading, 'leading',
1004             'leading', -1, $GLOBALS);
1005 49 50       108 if ($cell_leading <= 0) {
1006 49         79 $cell_leading = $cell_font_size * $leading_ratio;
1007             }
1008 49         105 $cell_height = find_value($cell_height,
1009             'min_rh', '', 0, $GLOBALS);
1010 49         95 $cell_pad_top = find_value($cell_pad_top, 'padding_top',
1011             'padding', $padding_default,
1012             $GLOBALS);
1013 49         90 $cell_pad_right = find_value($cell_pad_right, 'padding_right',
1014             'padding', $padding_default,
1015             $GLOBALS);
1016 49         92 $cell_pad_bot = find_value($cell_pad_bot, 'padding_bottom',
1017             'padding', $padding_default,
1018             $GLOBALS);
1019 49         86 $cell_pad_left = find_value($cell_pad_left, 'padding_left',
1020             'padding', $padding_default,
1021             $GLOBALS);
1022 49         94 $cell_max_word_len = find_value($cell_max_word_len,
1023             'max_word_len', '',
1024             $max_word_len, $GLOBALS);
1025 49         120 $cell_min_w = find_value($cell_min_w, 'min_w',
1026             '', undef, $GLOBALS);
1027 49         105 $cell_max_w = find_value($cell_max_w, 'max_w',
1028             '', undef, $GLOBALS);
1029 49 50 33     134 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         93 $cell_underline = find_value($cell_underline,
1033             'underline', '', $underline,
1034             $GLOBALS);
1035 49         91 $cell_def_text = find_value($cell_def_text, 'default_text',
1036             '', $default_text, $GLOBALS);
1037 49         98 $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       101 if ($is_header_row) {
1042 3         8 $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         82 $cell_bg_color = find_value($cell_bg_color, 'bg_color',
1051             '', undef, $GLOBALS);
1052 46         87 $cell_fg_color = find_value($cell_fg_color, 'fg_color',
1053             '', undef, $GLOBALS);
1054 46         79 $cell_bg_color_even = find_value($cell_bg_color_even,
1055             'bg_color_even', '', undef, $GLOBALS);
1056 46         100 $cell_bg_color_odd = find_value($cell_bg_color_odd,
1057             'bg_color_odd', '', undef, $GLOBALS);
1058 46         84 $cell_fg_color_even = find_value($cell_fg_color_even,
1059             'fg_color_even', '', undef, $GLOBALS);
1060 46         88 $cell_fg_color_odd = find_value($cell_fg_color_odd,
1061             'fg_color_odd', '', undef, $GLOBALS);
1062             }
1063 49         91 $cell_h_rule_w = find_value($cell_h_rule_w, 'h_rule_w',
1064             'rule_w', $h_border_w, $GLOBALS);
1065 49         130 $cell_v_rule_w = find_value($cell_v_rule_w, 'v_rule_w',
1066             'rule_w', $v_border_w, $GLOBALS);
1067 49         108 $cell_h_rule_c = find_value($cell_h_rule_c, 'h_rule_c',
1068             'rule_c', $border_c, $GLOBALS);
1069 49         88 $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         95 $bg_color = $cell_bg_color;
1076 49         86 $fg_color = $cell_fg_color;
1077 49 50       92 if ($oddeven_default) { # new method with consistent odd/even
1078 49 100       133 if (!defined $bg_color) {
1079 31 100       71 $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       67 $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     174 $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         82 $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         201 $txt->font( $cell_font, $cell_font_size );
1138 49 50       507 $txt->fillcolor($fg_color) if $ink;
1139              
1140             # make sure cell's text is never undef
1141 49   33     285 $data_row->[$col_idx] //= $cell_def_text;
1142              
1143             # Handle colspan
1144 49 100       107 my $c_cell_props = $is_header_row ?
1145             $cell_props->[0][$col_idx] :
1146             $cell_props->[$row_idx][$col_idx];
1147 49         81 my $this_cell_width = $calc_column_widths->[$col_idx];
1148 49 100 66     199 if ($c_cell_props && $c_cell_props->{'colspan'} && $c_cell_props->{'colspan'} > 1) {
      66        
1149 1         3 my $colspan = $c_cell_props->{'colspan'};
1150 1         4 for my $offset (1 .. $colspan - 1) {
1151 1 50       6 $this_cell_width += $calc_column_widths->[$col_idx + $offset]
1152             if $calc_column_widths->[$col_idx + $offset];
1153 1 50       3 if ($is_header_row) {
1154 0         0 $colspanned{'0_'.($col_idx + $offset)} = 1;
1155             } else {
1156 1         6 $colspanned{$row_idx.'_'.($col_idx + $offset)} = 1;
1157             }
1158             }
1159             }
1160 49         148 $this_cell_width = max($this_cell_width, $min_col_width);
1161 49         101 $actual_column_widths[$row_idx][$col_idx] = $this_cell_width;
1162              
1163 49         70 my %text_options;
1164 49 50       116 if ($cell_underline) {
1165 0         0 $text_options{'-underline'} = $cell_underline;
1166 0         0 $text_options{'-strokecolor'} = $fg_color;
1167             }
1168             # If the content is wider than the specified width,
1169             # we need to add the text as a text block
1170             # Otherwise just use the $page->text() method
1171 49         79 my $content = $data_row->[$col_idx];
1172 49 50 33     174 $content = $cell_def_text if (ref($content) eq '' &&
1173             $content eq '');
1174             # empty content? doesn't seem to do any harm
1175 49 50 33     314 if ( ref($content) eq 'ARRAY') {
    100 66        
1176             # it's a markup cell
1177 0         0 $cell_markup = $content->[0];
1178             # if it's "leftover" content, markup is 'pre'
1179            
1180 0         0 my ($rc, $next_y, $remainder);
1181             # upper left corner, width, and max height of this column?
1182 0         0 my $ULx = $cur_x + $cell_pad_left;
1183 0         0 my $ULy = $cur_y - $cell_pad_top;
1184 0         0 my $width = $actual_column_widths[$row_idx][$col_idx] -
1185             $cell_pad_right - $cell_pad_left;
1186 0         0 my $max_h = $cur_y - $bottom_margin -
1187             $cell_pad_top - $cell_pad_bot;
1188             ($rc, $next_y, $remainder) =
1189             $txt->column($page, $txt, $gfx, $cell_markup,
1190             $content->[1],
1191             'rect'=>[$ULx, $ULy, $width, $max_h],
1192             'font_size'=>$cell_font_size,
1193 0         0 %{$content->[2]});
  0         0  
1194 0 0       0 if ($rc) {
1195             # splitting cell
1196 0         0 $actual_row_height = max($actual_row_height,
1197             $cur_y - $bottom_margin);
1198             } else {
1199             # got entire content onto this page
1200 0         0 $actual_row_height = max($actual_row_height,
1201             $cur_y - $next_y + $cell_pad_bot +
1202             ($cell_leading - $cell_font_size)*1.0);
1203             }
1204             # 1.0 multiplier is a good-looking fudge factor to add a
1205             # little space between bottom of text and bottom of cell
1206              
1207             # at this point, actual_row_height is the used
1208             # height of this row, for purposes of background cell
1209             # color and left rule drawing. current_min_rh is left as
1210             # the height of one line + padding.
1211              
1212 0 0       0 if ( $rc ) {
1213 0         0 $leftovers->[$col_idx] = [ 'pre', $remainder,
1214             $content->[2] ];
1215 0         0 $do_leftovers = 1;
1216             }
1217              
1218             } elsif ( $content !~ m/(.\n.)/ and
1219             $data_row_widths->[$col_idx] and
1220             $data_row_widths->[$col_idx] <=
1221             $actual_column_widths[$row_idx][$col_idx] ) {
1222             # no embedded newlines (no multiple lines)
1223             # and the content width is <= calculated column width?
1224             # content will fit on one line, use text_* calls
1225 46 50       113 if ($ink) {
1226 46 100       162 if ($cell_justify eq 'right') {
    100          
1227             # right justified before right padding
1228 5         19 $txt->translate($cur_x + $actual_column_widths[$row_idx][$col_idx] - $cell_pad_right, $text_start_y);
1229 5         45 $txt->text_right($content, %text_options);
1230             } elsif ($cell_justify eq 'center') {
1231             # center text within the margins (padding)
1232 6         32 $txt->translate($cur_x + $cell_pad_left + ($actual_column_widths[$row_idx][$col_idx] - $cell_pad_left - $cell_pad_right)/2, $text_start_y);
1233 6         64 $txt->text_center($content, %text_options);
1234             } else {
1235             # left justified after left padding
1236             # (text_left alias for text, in PDF::Builder only)
1237 35         136 $txt->translate($cur_x + $cell_pad_left, $text_start_y);
1238 35         245 $txt->text($content, %text_options);
1239             }
1240             }
1241            
1242             } else {
1243 3         23 my ($width_of_last_line, $ypos_of_last_line,
1244             $left_over_text)
1245             = $self->text_block(
1246             $txt,
1247             $content,
1248             $row_idx, $col_idx,
1249             # mandatory args
1250             'x' => $cur_x + $cell_pad_left,
1251             'y' => $text_start_y,
1252             'w' => $actual_column_widths[$row_idx][$col_idx] -
1253             $cell_pad_left - $cell_pad_right,
1254             'h' => $cur_y - $bot_margin -
1255             $cell_pad_top - $cell_pad_bot,
1256             # non-mandatory args
1257             'font_size' => $cell_font_size,
1258             'leading' => $cell_leading,
1259             'align' => $cell_justify,
1260             'text_opt' => \%text_options,
1261             );
1262             # Desi - Removed $leading because of
1263             # fixed incorrect ypos bug in text_block
1264 3         13 $actual_row_height = max($actual_row_height,
1265             $cur_y - $ypos_of_last_line + $cell_pad_bot +
1266             ($cell_leading - $cell_font_size)*2.5);
1267             # 2.5 multiplier is a good-looking fudge factor to add a
1268             # little space between bottom of text and bottom of cell
1269              
1270             # at this point, actual_row_height is the used
1271             # height of this row, for purposes of background cell
1272             # color and left rule drawing. current_min_rh is left as
1273             # the height of one line + padding.
1274              
1275 3 50       8 if ( $left_over_text ) {
1276 0         0 $leftovers->[$col_idx] = $left_over_text;
1277 0         0 $do_leftovers = 1;
1278             }
1279             }
1280              
1281             # Hook to pass coordinates back - http://www.perlmonks.org/?node_id=754777
1282 49 100       321 if (ref $arg{'cell_render_hook'} eq 'CODE') {
1283 9         67 $arg{'cell_render_hook'}->(
1284             $page,
1285             $first_row,
1286             $row_idx,
1287             $col_idx,
1288             $cur_x,
1289             $cur_y-$actual_row_height,
1290             $actual_column_widths[$row_idx][$col_idx],
1291             $actual_row_height
1292             );
1293             }
1294              
1295 49         139 $cur_x += $actual_column_widths[$row_idx][$col_idx];
1296             # otherwise lose track of column-related settings
1297 49         81 $save_bg_color[$col_idx] = $bg_color;
1298 49         72 $save_fg_color[$col_idx] = $fg_color;
1299 49         3510 $save_v_rule_w[$col_idx] = $cell_v_rule_w;
1300 49         73 $save_h_rule_w[$col_idx] = $cell_h_rule_w;
1301 49         84 $save_v_rule_c[$col_idx] = $cell_v_rule_c;
1302 49         177 $save_h_rule_c[$col_idx] = $cell_h_rule_c;
1303             } # done looping through columns for this row
1304 19 50       63 if ( $do_leftovers ) {
1305             # leftover text in row to output later as new-ish row?
1306 0         0 unshift @$data, $leftovers;
1307 0         0 unshift @$row_col_widths, $data_row_widths;
1308 0         0 unshift @$rows_height, $current_min_rh;
1309             # if push actual_row_height back onto rows_height, it will be
1310             # far too much in some cases, resulting in excess blank space at bottom.
1311             }
1312 19 50       52 if ($oddeven_default) { # new method with consistent odd/even
1313 19 100 100     61 if ( !($first_row and $do_headers) ) {
1314             # only toggle if not a header
1315 18         38 $row_is_odd = ! $row_is_odd;
1316             }
1317             }
1318              
1319             # Draw cell bgcolor
1320             # This has to be done separately from the text loop
1321             # because we do not know the final height of the cell until
1322             # all text has been drawn. Nevertheless, it ($gfx_bg) will
1323             # still be rendered before text ($txt).
1324 19         34 $cur_x = $xbase;
1325 19         56 for (my $col_idx = 0;
1326             $col_idx < scalar(@$data_row);
1327             $col_idx++) {
1328             # restore cell_bg_color, etc.
1329 50         84 $bg_color = $save_bg_color[$col_idx];
1330 50         70 $fg_color = $save_fg_color[$col_idx];
1331 50         70 $cell_v_rule_w = $save_v_rule_w[$col_idx];
1332 50         62 $cell_h_rule_w = $save_h_rule_w[$col_idx];
1333 50         70 $cell_v_rule_c = $save_v_rule_c[$col_idx];
1334 50         66 $cell_h_rule_c = $save_h_rule_c[$col_idx];
1335              
1336             # TBD rowspan!
1337 50 50       86 if ($ink) {
1338 50 50 66     209 if (defined $bg_color &&
      66        
      33        
1339             $bg_color ne 'transparent' && $bg_color ne 'trans' &&
1340             !$colspanned{$row_idx.'_'.$col_idx}) {
1341 18         58 $gfx_bg->rect( $cur_x, $cur_y-$actual_row_height,
1342             $actual_column_widths[$row_idx][$col_idx], $actual_row_height);
1343 18         141 $gfx_bg->fillcolor($bg_color);
1344 18         111 $gfx_bg->fill();
1345             }
1346              
1347             # draw left vertical border of this cell unless leftmost
1348 50 100 66     313 if ($gfx && $cell_v_rule_w && $col_idx &&
      100        
      66        
1349             !$colspanned{$row_idx.'_'.$col_idx}) {
1350 23         60 $gfx->linewidth($cell_v_rule_w);
1351 23         127 $gfx->strokecolor($cell_v_rule_c);
1352 23         151 $gfx->move($cur_x, $cur_y-$actual_row_height);
1353 23 100       217 $gfx->vline( $cur_y - ($row_idx? 0: $h_border_w/2));
1354 23         122 $gfx->stroke(); # don't confuse different widths and colors
1355             }
1356              
1357             # draw bottom horizontal rule of this cell unless bottom
1358             # of page (no more data or not room for at least one line).
1359             # TBD fix up when implement rowspan
1360 50 100 66     301 if ($gfx && $cell_h_rule_w && scalar(@{$data}) &&
  36   100     129  
      66        
1361             $cur_y-$actual_row_height-$current_min_rh > $bot_margin ) {
1362 15         46 $gfx->linewidth($cell_h_rule_w);
1363 15         120 $gfx->strokecolor($cell_h_rule_c);
1364 15         141 $gfx->move($cur_x, $cur_y-$actual_row_height);
1365 15         125 $gfx->hline( $cur_x + $actual_column_widths[$row_idx][$col_idx] );
1366 15         84 $gfx->stroke(); # don't confuse different widths and colors
1367             }
1368             }
1369              
1370 50         196 $cur_x += $calc_column_widths->[$col_idx];
1371             } # End of for (my $col_idx....
1372              
1373 19         32 $cur_y -= $actual_row_height;
1374 19 50       63 if (!$ink) {
1375 0 0 0     0 if ($first_row && $do_headers) {
1376             # this was a header row
1377 0         0 $vsizes[1] = $actual_row_height;
1378             } else {
1379             # this was a non-header row
1380 0         0 push @vsizes, $actual_row_height;
1381             }
1382             # if implement footer, it will go in [2]
1383             }
1384              
1385 19 50       54 if ($do_leftovers) {
1386             # a row has been split across pages. undo bg toggle
1387 0         0 $row_is_odd = !$row_is_odd;
1388 0         0 $next_top_border = 2; # dashed line
1389             } else {
1390 19         24 $row_idx++;
1391 19         35 $next_top_border = 1; # solid line
1392             }
1393 19         85 $first_row = 0;
1394             } # End of Row_Loop for this page, and possibly whole table
1395              
1396             # draw bottom border on this page. first, is this very last row?
1397             # The line overlays and hides any odd business with vertical rules
1398             # in the last row
1399 11 100       18 if (!scalar(@{$data})) { $next_top_border = 0; }
  11         25  
  10         16  
1400 11 50       46 if ($ink) {
1401 11 100 66     46 if ($gfx && $h_border_w) {
1402 8 50       20 if ($next_top_border == 0) {
    0          
1403             # last bottom border, use specified border
1404 8         34 $gfx->linewidth($h_border_w);
1405             } elsif ($next_top_border == 1) {
1406             # solid thin line at start of a row
1407 0         0 $gfx->linewidth($border_w_default);
1408             } else { # == 2
1409             # dashed thin line at continuation in middle of row
1410 0         0 $gfx->linewidth($border_w_default);
1411 0         0 $gfx->linedash($dashed_rule_default);
1412             }
1413             # leave next_top_border for next page top of continued table
1414 8         48 $gfx->strokecolor($border_c);
1415 8         49 $gfx->move( $xbase-$v_border_w/2 , $cur_y );
1416 8         55 $gfx->hline($xbase + $width + $v_border_w/2);
1417 8         48 $gfx->stroke();
1418 8         43 $gfx->linedash();
1419             }
1420              
1421 11 50       55 if ($gfx) {
1422 11 100       42 if ($v_border_w) {
1423             # Draw left and right table borders
1424             # These overlay and hide any odd business with horizontal
1425             # rules at the left or right edge
1426 8         31 $gfx->linewidth($v_border_w);
1427 8         42 $gfx->move( $xbase, $table_top_y);
1428 8         71 $gfx->vline( $cur_y );
1429 8         48 $gfx->move( $xbase + $width, $table_top_y);
1430 8         43 $gfx->vline( $cur_y );
1431             }
1432              
1433             # draw all the unrendered lines
1434 11         45 $gfx->stroke();
1435             }
1436             }
1437 11         68 $pg_cnt++; # on a spillover page
1438             } # End of while (scalar(@{$data})) next row, adding new page if necessary
1439              
1440 10 50       36 if ($ink) {
1441 10         247 return ($page, --$pg_cnt, $cur_y);
1442             } else {
1443             # calculate overall table height as sum of 1..$#vsizes
1444 0         0 for (my $i = 1; $i < @vsizes; $i++) {
1445 0         0 $vsizes[0] += $vsizes[$i];
1446             }
1447             # might need to account for really thick horizontal border rules
1448 0         0 return @vsizes;
1449             }
1450             } # end of table()
1451              
1452             ############################################################
1453             # find a value that might be set in a default or in a global
1454             # or column/row/cell specific parameter. fixed order of search
1455             # is cell/header properties, column properties, row properties,
1456             # fallback sequences (e.g., padding_left inherits from padding),
1457             # global default
1458             ############################################################
1459              
1460             sub find_value {
1461 1764     1764 0 3252 my ($cell_val, $name, $fallback, $default, $GLOBALS) = @_;
1462             # $fallback can be '' (will be skipped)
1463              
1464 1764         3097 my ($cell_props, $col_props, $row_props, $row_idx, $col_idx, $argref) =
1465             @$GLOBALS;
1466             # $row_idx should be 0 for a header entry
1467 1764         6669 my %arg = %$argref;
1468             # $default should never be undefined, except for specific cases!
1469 1764 50 100     7335 if (!defined $default &&
      100        
      100        
      100        
      100        
      100        
      100        
      66        
      66        
1470             ($name ne 'underline' &&
1471             $name ne 'bg_color' && $name ne 'fg_color' &&
1472             $name ne 'bg_color_even' && $name ne 'bg_color_odd' &&
1473             $name ne 'fg_color_even' && $name ne 'fg_color_odd' &&
1474             $name ne 'min_w' && $name ne 'max_w') ) {
1475 0         0 carp "Error! find_value() default value undefined for '$name'\n";
1476             }
1477              
1478             # upon entry, $cell_val is usually either undefined (data row) or
1479             # header property setting (in which case, already set and we're done here)
1480 1764 50       3380 $cell_val = $cell_props->[$row_idx][$col_idx]->{$name} if
1481             !defined $cell_val;
1482 1764 100 100     4943 $cell_val = $cell_props->[$row_idx][$col_idx]->{$fallback} if
1483             !defined $cell_val && $fallback ne '';
1484 1764 100       3301 $cell_val = $col_props->[$col_idx]->{$name} if
1485             !defined $cell_val;
1486 1764 100 100     4631 $cell_val = $col_props->[$col_idx]->{$fallback} if
1487             !defined $cell_val && $fallback ne '';
1488 1764 100       3193 $cell_val = $row_props->[$row_idx]->{$name} if
1489             !defined $cell_val;
1490 1764 100 100     4683 $cell_val = $row_props->[$row_idx]->{$fallback} if
1491             !defined $cell_val && $fallback ne '';
1492 1764 100       3342 $cell_val = $arg{$name} if
1493             !defined $cell_val;
1494 1764 100 100     4687 $cell_val = $arg{$fallback} if
1495             !defined $cell_val && $fallback ne '';
1496              
1497             # final court of appeal is the global default (usually defined)
1498 1764 100       2900 if (!defined $cell_val) {
1499 1663         2132 $cell_val = $default;
1500             }
1501              
1502 1764         4616 return $cell_val;
1503             } # end of find_value()
1504              
1505             ############################################################
1506             # text_block - utility method to build multi-paragraph blocks of text
1507             #
1508             # Parameters:
1509             # $text_object the TEXT object used to output to the PDF
1510             # $text the text to be formatted
1511             # %arg settings to control the formatting and
1512             # output.
1513             # mandatory: x, y, w, h (block position and dimensions)
1514             # defaults are provided for:
1515             # font_size (global $font_size_default)
1516             # leading (font_size * global $leading_ratio)
1517             # no defaults for:
1518             # text_opt (such as underline flag and color)
1519             # parspace (extra vertical space before a paragraph)
1520             # hang (text for ?)
1521             # indent (indentation amount)
1522             # fpindent (first paragraph indent amount)
1523             # flindent (first line indent amount)
1524             # align (justification left|center|right|fulljustify|justify)
1525             #
1526             # $text comes in as one string, possibly with \n embedded.
1527             # split at \n to form 2 or more @paragraphs. each @paragraph
1528             # is a @paragraphs element split on ' ' (list of words to
1529             # fill the available width). one word at a time is moved
1530             # from @paragraph to @line, until the width of the joined
1531             # @line (with ' ' between words) can't be any larger.
1532             # TBD: deal with multiple spaces between words
1533             ############################################################
1534              
1535             sub text_block {
1536 3     3 1 6 my $self = shift;
1537 3         6 my $text_object = shift;
1538 3         4 my $text = shift; # The text to be displayed
1539 3         6 my $row_idx = shift; # cell row,col for debug
1540 3         13 my $col_idx = shift;
1541 3         15 my %arg = @_; # Additional Arguments
1542              
1543 3         9 my ( $align, $xpos, $ypos, $xbase, $ybase, $line_width, $wordspace, $endw , $width, $height) =
1544             ( undef , undef, undef, undef , undef , undef , undef , undef , undef , undef );
1545 3         5 my @line = (); # Temp data array with words on one line
1546 3         7 my %width = (); # The width of every unique word in the given text
1547 3         3 my %text_options = %{ $arg{'text_opt'} };
  3         7  
1548              
1549             # Try to provide backward compatibility. "-" starting key name is optional
1550 3         13 foreach my $key (keys %arg) {
1551 24         31 my $newkey = $key;
1552 24 50       48 if ($newkey =~ s#^-##) {
1553 0         0 $arg{$newkey} = $arg{$key};
1554 0         0 delete $arg{$key};
1555             }
1556             }
1557             #####
1558              
1559             #---
1560             # Let's check mandatory parameters with no default values
1561             #---
1562 3   50     10 $xbase = $arg{'x'} || -1;
1563 3   50     8 $ybase = $arg{'y'} || -1;
1564 3   50     8 $width = $arg{'w'} || -1;
1565 3   50     7 $height = $arg{'h'} || -1;
1566 3 50       7 unless ( $xbase > 0 ) {
1567 0         0 carp "Error: Left Edge of Block is NOT defined!\n";
1568 0         0 return (0, $ybase, '');
1569             }
1570 3 50       9 unless ( $ybase > 0 ) {
1571 0         0 carp "Error: Base Line of Block is NOT defined!\n";
1572 0         0 return (0, $ybase, '');
1573             }
1574 3 50       11 unless ( $width > 0 ) {
1575 0         0 carp "Error: Width of Block is NOT defined!\n";
1576 0         0 return (0, $ybase, '');
1577             }
1578 3 50       9 unless ( $height > 0 ) {
1579 0         0 carp "Error: Height of Block is NOT defined!\n";
1580 0         0 return (0, $ybase, '');
1581             }
1582              
1583             # Check if any text to display. If called from table(), should have
1584             # default text by the time of the call, so this is really as a failsafe
1585             # for standalone text_block() calls. Note that '' won't work!
1586 3 50 33     12 unless ( defined( $text) and length($text) > 0 ) {
1587             # carp "Warning: No input text found. Use dummy '-'.\n";
1588             # $text = $empty_cell_text;
1589 0         0 $text = ' ';
1590             }
1591              
1592             # Strip any <CR> and Split the text into paragraphs
1593             # if you're on a platform that uses \r to end a line (old Macs?)...
1594             # we're in text_block() only if long line or \n's seen
1595             # @paragraphs is list of paragraphs (long lines)
1596             # @paragraph is list of words within present paragraph (long line)
1597 3         5 $text =~ s/\r//g;
1598 3         10 my @paragraphs = split(/\n/, $text);
1599              
1600             # Width between lines (leading) in points
1601 3   33     9 my $font_size = $arg{'font_size'} || $font_size_default;
1602 3 50 33     14 my $line_space = defined $arg{'leading'} && $arg{'leading'} > 0 ? $arg{'leading'} : undef;
1603 3   33     7 $line_space ||= $font_size * $leading_ratio;
1604             # leading must be at least font size
1605 3 50       7 $line_space = $font_size * $leading_ratio if $font_size > $line_space;
1606              
1607             # Calculate width of all words
1608 3         14 my $space_width = $text_object->advancewidth("\x20");
1609 3         13 my %word_width;
1610 3         9 my @text_words = split(/\s+/, $text);
1611 3         11 foreach (@text_words) {
1612 13 50       49 next if exists $word_width{$_};
1613 13         20 $word_width{$_} = $text_object->advancewidth($_);
1614             }
1615              
1616             # get word list for first paragraph
1617 3         22 my @paragraph = split(' ', shift(@paragraphs));
1618 3         7 my $first_line = 1; # first line of THIS paragraph
1619 3         4 my $paragraph_number = 1;
1620              
1621             # Little Init
1622 3         5 $xpos = $xbase;
1623 3         5 $ypos = $ybase;
1624 3         4 $ypos = $ybase + $line_space;
1625             # bottom_border doesn't need to consider pad_bot, as we're only considering
1626             # the space actually available within the cell, already reduced by padding.
1627 3         5 my $bottom_border = $ypos - $height;
1628              
1629             # While we can add another line. No handling of widows and orphans.
1630 3         9 while ( $ypos >= $bottom_border + $line_space ) {
1631             # Is there any text to render ?
1632 7 100       12 unless (@paragraph) {
1633             # Finish if nothing left of all the paragraphs in text
1634 3 50       8 last unless scalar @paragraphs; # another paragraph to process?
1635             # Else take one paragraph (long line) from the text
1636 0         0 @paragraph = split(' ', shift( @paragraphs ) );
1637 0         0 $paragraph_number++;
1638              
1639             # extra space between paragraphs? only if a previous paragraph
1640 0 0 0     0 $ypos -= $arg{'parspace'} if $arg{'parspace'} and
1641             $paragraph_number > 1;
1642 0 0       0 last unless $ypos >= $bottom_border;
1643             }
1644 4         7 $ypos -= $line_space;
1645 4         5 $xpos = $xbase;
1646              
1647             # While there's room on the line, add another word
1648 4         8 @line = ();
1649 4         4 $line_width = 0;
1650             # TBD what exactly is hang supposed to do, interaction with
1651             # indent, flindent, fpindent AND effect on min cell width
1652 4 50 66     44 if ( $first_line && exists $arg{'hang'} ) {
    50 66        
    50 33        
    50 33        
      33        
      33        
1653             # fixed text to output first, for first line of a paragraph
1654             # TBD Note that hang text is not yet checked for min_col_width or
1655             # max_word_len, and other indents could make line too wide for col!
1656 0         0 my $hang_width = $text_object->advancewidth($arg{'hang'});
1657              
1658 0 0       0 $text_object->translate( $xpos, $ypos ) if $ink;
1659 0 0       0 $text_object->text( $arg{'hang'} ) if $ink;
1660              
1661 0         0 $xpos += $hang_width;
1662 0         0 $line_width += $hang_width;
1663 0 0       0 $arg{'indent'} += $hang_width if $paragraph_number == 1;
1664             } elsif ( $first_line && exists $arg{'flindent'} &&
1665             $arg{'flindent'} > 0 ) {
1666             # amount to indent on first line of a paragraph
1667 0         0 $xpos += $arg{'flindent'};
1668 0         0 $line_width += $arg{'flindent'};
1669             } elsif ( $paragraph_number == 1 && exists $arg{'fpindent'} &&
1670             $arg{'fpindent'} > 0 ) {
1671             # amount to indent first paragraph's first line TBD ??
1672 0         0 $xpos += $arg{'fpindent'};
1673 0         0 $line_width += $arg{'fpindent'};
1674             } elsif ( exists $arg{'indent'} &&
1675             $arg{'indent'} > 0 ) {
1676             # amount to indent first line of following paragraphs
1677 0         0 $xpos += $arg{'indent'};
1678 0         0 $line_width += $arg{'indent'};
1679             }
1680              
1681             # Let's take from paragraph as many words as we can put
1682             # into $width - $indent. repeatedly test with "just one more" word
1683             # from paragraph list, until overflow.
1684             # TBD might be more efficient (as originally intended?) to build
1685             # library of word widths and add them together until "too big",
1686             # back off.
1687             # TBD don't forget to properly handle runs of more than one space.
1688 4         13 while ( @paragraph ) {
1689 14 100       20 if ( !@line ) {
1690             # first time through, @line is empty
1691             # first word in paragraph SHOULD fit!!
1692             # TBD: what if $line_width > 0??? due to indent, etc.?
1693             # add 0.01 as safety
1694 4 50       11 if ( $text_object->advancewidth( $paragraph[0] ) +
1695             $line_width <= $width+0.01 ) {
1696 4         19 push(@line, shift(@paragraph));
1697 4 100       11 next if @paragraph;
1698             } else {
1699             # this should never happen, but just in case, to
1700             # prevent an infinite loop...
1701 0         0 die("!!! Error !!! first word in paragraph for row $row_idx, col $col_idx '$paragraph[0]' doesn't fit into empty line!");
1702             }
1703             } else {
1704             # @line has text in it already
1705 10 100       36 if ( $text_object->advancewidth( join(" ", @line)." " . $paragraph[0] ) +
1706             $line_width <= $width ) {
1707 9         38 push(@line, shift(@paragraph));
1708 9 100       21 next if @paragraph;
1709             }
1710             }
1711 4         8 last;
1712             }
1713 4         13 $line_width += $text_object->advancewidth(join(' ', @line));
1714              
1715             # calculate the space width (width to use for a space)
1716 4   50     18 $align = $arg{'align'} || 'left';
1717 4 50 33     25 if ( $align eq 'fulljustify' or
      33        
1718             ($align eq 'justify' and @paragraph)) {
1719 0 0       0 @line = split(//,$line[0]) if scalar(@line) == 1;
1720 0 0       0 if (scalar(@line) > 1) {
1721 0         0 $wordspace = ($width - $line_width) / (scalar(@line) - 1);
1722             } else {
1723 0         0 $wordspace = 0; # effectively left-aligned for single word
1724             }
1725 0         0 $align = 'justify';
1726             } else {
1727             # not adding extra spacing between words, just real space
1728 4 50       13 $align = 'left' if $align eq 'justify';
1729 4         5 $wordspace = $space_width;
1730             }
1731              
1732 4         8 $line_width += $wordspace * (scalar(@line) - 1);
1733              
1734 4 50       8 if ( $align eq 'justify') {
1735 0         0 foreach my $word (@line) {
1736 0 0       0 $text_object->translate( $xpos, $ypos ) if $ink;
1737 0 0       0 $text_object->text( $word ) if $ink;
1738 0 0       0 $xpos += ($word_width{$word} + $wordspace) if (@line);
1739             }
1740 0         0 $endw = $width;
1741             } else {
1742             # calculate the left hand position of the line
1743             # if ( $align eq 'right' ) {
1744             # $xpos += $width - $line_width;
1745             # } elsif ( $align eq 'center' ) {
1746             # $xpos += ( $width - $line_width ) / 2;
1747             # }
1748              
1749 4 50       9 if ($ink) {
1750             # render the line. TBD This may not work right with indents!
1751 4 50       10 if ($align eq 'right') {
    50          
1752 0         0 $text_object->translate( $xpos+$width, $ypos );
1753 0         0 $endw = $text_object->text_right(join(' ', @line), %text_options);
1754             } elsif ($align eq 'center') {
1755 0         0 $text_object->translate( $xpos + $width/2, $ypos );
1756 0         0 $endw = $text_object->text_center(join(' ', @line), %text_options);
1757             } else {
1758 4         11 $text_object->translate( $xpos, $ypos );
1759 4         37 $endw = $text_object->text(join(' ', @line), %text_options);
1760             }
1761             }
1762             }
1763 4         23 $first_line = 0;
1764             } # End of while (fitting within vertical space)
1765              
1766             # any leftovers of current paragraph? will return as first new paragraph
1767 3 50       6 unshift(@paragraphs, join(' ',@paragraph)) if scalar(@paragraph);
1768              
1769 3         21 return ($endw, $ypos, join("\n", @paragraphs))
1770             } # End of text_block()
1771              
1772             1;
1773              
1774             __END__
1775              
1776             =pod
1777              
1778             For documentation, see Table/Table.pod. A copy of table.html is included in
1779             the library for your convenience, or you can use a tool such as pod2html to
1780             create the HTML.