modules/override/PDF/Table.pm

   1 package PDF::Table;
   2
   3 use 5.006;
   4 use strict;
   5 use warnings;
   6 our $VERSION = '0.9.3';
   7
   8 use List::Util qw(sum);
   9
  10 ############################################################
  11 #
  12 # new - Constructor
  13 #
  14 # Parameters are meta information about the PDF
  15 #
  16 # $pdf = PDF::Table->new();
  17 #
  18 ############################################################
  19
  20 sub new {
  21   my ($type) = @_;
  22
  23   my $class = ref($type) || $type;
  24   my $self  = {};
  25   bless ($self, $class);
  26   return $self;
  27 }
  28
  29 ############################################################
  30 #
  31 # text_block - utility method to build multi-paragraph blocks of text
  32 #
  33 ############################################################
  34
  35 sub text_block {
  36   my $self        = shift;
  37   my $text_object = shift;
  38   my $text        = shift;          # The text to be displayed
  39   my %arg         = @_;             # Additional Arguments
  40
  41   my  ($align, $xpos, $ypos, $xbase, $ybase, $line_width, $wordspace, $endw , $width, $height)
  42     = (undef , undef, undef, undef , undef , undef      , undef     , undef , undef , undef  );
  43   my @line  = ();          # Temp data array with words on one line
  44   my %width = ();          # The width of every unique word in the givven text
  45
  46   # Try to provide backward compatibility
  47   foreach my $key (keys %arg) {
  48     my $newkey = $key;
  49     if ($newkey =~ s#^-##) {
  50       $arg{$newkey} = $arg{$key};
  51       delete $arg{$key};
  52     }
  53   }
  54   #####
  55
  56   #---
  57   # Lets check mandatory parameters with no default values
  58   #---
  59   $xbase  = $arg{'x'} || -1;
  60   $ybase  = $arg{'y'} || -1;
  61   $width  = $arg{'w'} || -1;
  62   $height = $arg{'h'} || -1;
  63   unless ( $xbase  > 0 ) { print "Error: Left Edge of Block is NOT defined!\n"; return; }
  64   unless ( $ybase  > 0 ) { print "Error: Base Line of Block is NOT defined!\n"; return; }
  65   unless ( $width  > 0 ) { print "Error: Width of Block is NOT defined!\n";     return; }
  66   unless ( $height > 0 ) { print "Error: Height of Block is NOT defined!\n";    return; }
  67   # Check if any text to display
  68   unless ( defined( $text) and length($text) > 0 ) {
  69     print "Warning: No input text found. Trying to add dummy '-' and not to break everything.\n";
  70     $text = '-';
  71   }
  72
  73   # Strip any <CR> and Split the text into paragraphs
  74   $text          =~ s/\r//g;
  75   my @paragraphs =  split(/\n/, $text);
  76
  77   # Width between lines in pixels
  78   my $line_space = defined $arg{'lead'} && $arg{'lead'} > 0 ? $arg{'lead'} : 12;
  79
  80   # Calculate width of all words
  81   my $space_width = $text_object->advancewidth("\x20");
  82   my @words       = split(/\s+/, $text);
  83   foreach (@words) {
  84     next if exists $width{$_};
  85     $width{$_} = $text_object->advancewidth($_);
  86   }
  87
  88   my @paragraph       = split(' ', shift(@paragraphs));
  89   my $first_line      = 1;
  90   my $first_paragraph = 1;
  91
  92   # Little Init
  93   $xpos             = $xbase;
  94   $ypos             = $ybase;
  95   $ypos             = $ybase + $line_space;
  96   my $bottom_border = $ybase - $height;
  97   # While we can add another line
  98   while ( $ypos >= $bottom_border + $line_space ) {
  99     # Is there any text to render ?
 100     unless (@paragraph) {
 101       # Finish if nothing left
 102       last unless scalar @paragraphs;
 103       # Else take one line from the text
 104       @paragraph  = split(' ', shift( @paragraphs ) );
 105
 106       $ypos      -= $arg{'parspace'} if $arg{'parspace'};
 107       last unless $ypos >= $bottom_border;
 108     }
 109     $ypos -= $line_space;
 110     $xpos  = $xbase;
 111
 112     # While there's room on the line, add another word
 113     @line       = ();
 114     $line_width = 0;
 115     if ( $first_line && exists $arg{'hang'} ) {
 116       my $hang_width = $text_object->advancewidth($arg{'hang'});
 117
 118       $text_object->translate( $xpos, $ypos );
 119       $text_object->text( $arg{'hang'} );
 120
 121       $xpos          += $hang_width;
 122       $line_width    += $hang_width;
 123       $arg{'indent'} += $hang_width if $first_paragraph;
 124
 125     } elsif ( $first_line && exists $arg{'flindent'} && $arg{'flindent'} > 0 ) {
 126       $xpos       += $arg{'flindent'};
 127       $line_width += $arg{'flindent'};
 128
 129     } elsif ( $first_paragraph && exists $arg{'fpindent'} && $arg{'fpindent'} > 0 ) {
 130       $xpos       += $arg{'fpindent'};
 131       $line_width += $arg{'fpindent'};
 132
 133     } elsif (exists $arg{'indent'} && $arg{'indent'} > 0 ) {
 134       $xpos       += $arg{'indent'};
 135       $line_width += $arg{'indent'};
 136     }
 137
 138     # Lets take from paragraph as many words as we can put into $width - $indent;. Always take at least one word; otherwise we'd end up in an infinite loop.
 139     while (!scalar(@line) || (@paragraph && ($text_object->advancewidth( join("\x20", @line)."\x20" . $paragraph[0]) + $line_width < $width))) {
 140       push(@line, shift(@paragraph));
 141     }
 142     $line_width += $text_object->advancewidth(join('', @line));
 143
 144     # calculate the space width
 145     if ( $arg{'align'} eq 'fulljustify' or ($arg{'align'} eq 'justify' and @paragraph)) {
 146       @line      = split(//,$line[0]) if (scalar(@line) == 1) ;
 147       $wordspace = ($width - $line_width) / (scalar(@line) - 1);
 148       $align     ='justify';
 149
 150     } else {
 151       $align     = ($arg{'align'} eq 'justify') ? 'left' : $arg{'align'};
 152       $wordspace = $space_width;
 153     }
 154     $line_width += $wordspace * (scalar(@line) - 1);
 155
 156     if ( $align eq 'justify') {
 157       foreach my $word (@line) {
 158         $text_object->translate( $xpos, $ypos );
 159         $text_object->text( $word );
 160         $xpos += ($width{$word} + $wordspace) if (@line);
 161       }
 162       $endw = $width;
 163
 164     } else {
 165       # calculate the left hand position of the line
 166       if ( $align eq 'right' ) {
 167         $xpos += $width - $line_width;
 168
 169       } elsif ( $align eq 'center' ) {
 170         $xpos += ( $width / 2 ) - ( $line_width / 2 );
 171       }
 172
 173       # render the line
 174       $text_object->translate( $xpos, $ypos );
 175       $endw = $text_object->text( join("\x20", @line));
 176     }
 177     $first_line = 0;
 178   }#End of while(
 179
 180   unshift(@paragraphs, join(' ',@paragraph)) if scalar(@paragraph);
 181
 182   return ($endw, $ypos, join("\n", @paragraphs))
 183 }
 184
 185
 186 ############################################################
 187 # table - utility method to build multi-row, multicolumn tables
 188 ############################################################
 189 sub table {
 190   my $self  = shift;
 191   my $pdf   = shift;
 192   my $page  = shift;
 193   my $data  = shift;
 194   my %arg   = @_;
 195
 196   #=====================================
 197   # Mandatory Arguments Section
 198   #=====================================
 199   unless ($pdf and $page and $data) {
 200     print "Error: Mandatory parameter is missing pdf/page/data object!\n";
 201     return;
 202   }
 203   # Try to provide backward compatibility
 204   foreach my $key (keys %arg) {
 205     my $newkey = $key;
 206     if ($newkey =~ s#^-##) {
 207       $arg{$newkey} = $arg{$key};
 208       delete $arg{$key};
 209     }
 210   }
 211   #TODO: Add code for header props compatibility and col_props comp....
 212   #####
 213   my ( $xbase, $ybase, $width, $height ) = ( undef, undef, undef, undef );
 214   # Could be 'int' or 'real' values
 215   $xbase  = $arg{'x'    } || -1;
 216   $ybase  = $arg{'start_y'} || -1;
 217   $width  = $arg{'w'    } || -1;
 218   $height = $arg{'start_h'} || -1;
 219
 220   # Global geometry parameters are also mandatory.
 221   unless ( $xbase  > 0 ) { print "Error: Left Edge of Table is NOT defined!\n"; return; }
 222   unless ( $ybase  > 0 ) { print "Error: Base Line of Table is NOT defined!\n"; return; }
 223   unless ( $width  > 0 ) { print "Error: Width of Table is NOT defined!\n";     return; }
 224   unless ( $height > 0 ) { print "Error: Height of Table is NOT defined!\n";    return; }
 225
 226   # Ensure default values for -next_y and -next_h
 227   my $next_y       = $arg{'next_y'} || $arg{'start_y'} || 0;
 228   my $next_h       = $arg{'next_h'} || $arg{'start_h'} || 0;
 229
 230   # Create Text Object
 231   my $txt          = $page->text;
 232   # Set Default Properties
 233   my $fnt_name     = $arg{'font'}            || $pdf->corefont('Times', -encode => 'utf8');
 234   my $fnt_size     = $arg{'font_size'}       || 12;
 235   my $max_word_len = $arg{'max_word_length'} || 20;
 236
 237   #=====================================
 238   # Table Header Section
 239   #=====================================
 240   # Disable header row into the table
 241   my $header_props;
 242   my $num_header_rows = 0;
 243   my (@header_rows, @header_row_cell_props);
 244   # Check if the user enabled it ?
 245   if (defined $arg{'header_props'} and ref( $arg{'header_props'}) eq 'HASH') {
 246     # Transfer the reference to local variable
 247     $header_props = $arg{'header_props'};
 248     # Check other params and put defaults if needed
 249     $header_props->{'repeat'}     = $header_props->{'repeat'}     || 0;
 250     $header_props->{'font'}       = $header_props->{'font'}       || $fnt_name;
 251     $header_props->{'font_color'} = $header_props->{'font_color'} || '#000066';
 252     $header_props->{'font_size'}  = $header_props->{'font_size'}  || $fnt_size + 2;
 253     $header_props->{'bg_color'}   = $header_props->{'bg_color'}   || '#FFFFAA';
 254
 255     $num_header_rows              = $arg{'num_header_rows'}       || 1;
 256   }
 257   #=====================================
 258   # Other Parameters check
 259   #=====================================
 260
 261   my $lead      = $arg{'lead'}           || $fnt_size;
 262   my $pad_left  = $arg{'padding_left'}   || $arg{'padding'} || 0;
 263   my $pad_right = $arg{'padding_right'}  || $arg{'padding'} || 0;
 264   my $pad_top   = $arg{'padding_top'}    || $arg{'padding'} || 0;
 265   my $pad_bot   = $arg{'padding_bottom'} || $arg{'padding'} || 0;
 266   my $pad_w     = $pad_left + $pad_right;
 267   my $pad_h     = $pad_top  + $pad_bot  ;
 268   my $line_w    = defined $arg{'border'} ? $arg{'border'} : 1 ;
 269
 270   my $background_color_even = $arg{'background_color_even'} || $arg{'background_color'} || undef;
 271   my $background_color_odd  = $arg{'background_color_odd'}  || $arg{'background_color'} || undef;
 272   my $font_color_even       = $arg{'font_color_even'}       || $arg{'font_color'}       || 'black';
 273   my $font_color_odd        = $arg{'font_color_odd'}        || $arg{'font_color'}       || 'black';
 274   my $border_color          = $arg{'border_color'}          || 'black';
 275
 276   my $min_row_h  = $fnt_size + $pad_top + $pad_bot;
 277   my $row_h      = defined ($arg{'row_height'}) && ($arg{'row_height'} > $min_row_h) ? $arg{'row_height'} : $min_row_h;
 278
 279   my $pg_cnt     = 1;
 280   my $cur_y      = $ybase;
 281   my $cell_props = $arg{cell_props} || [];   # per cell properties
 282   my $row_cnt    = $num_header_rows;
 283
 284   #If there is valid data array reference use it!
 285   if (ref $data eq 'ARRAY') {
 286     # Copy the header row if header is enabled
 287     if (defined $header_props) {
 288       map { push @header_rows,           $$data[$_] }       (0..$num_header_rows - 1);
 289       map { push @header_row_cell_props, $$cell_props[$_] } (0..$num_header_rows - 1);
 290     }
 291     # Determine column widths based on content
 292
 293     #  an arrayref whose values are a hashref holding
 294     #  the minimum and maximum width of that column
 295     my $col_props =  $arg{'column_props'} || [];
 296
 297     # An array ref of arrayrefs whose values are
 298     #  the actual widths of the column/row intersection
 299     my $row_props = [];
 300     # An array ref with the widths of the header row
 301     my @header_row_widths;
 302
 303     # Scalars that hold sum of the maximum and minimum widths of all columns
 304     my ( $max_col_w, $min_col_w ) = ( 0,0 );
 305     my ( $row, $col_name, $col_fnt_size, $space_w );
 306
 307     # Hash that will hold the width of every word from input text
 308     my $word_w       = {};
 309     my $rows_counter = 0;
 310
 311     foreach $row ( @{$data} ) {
 312       push(@header_row_widths, []) if ($rows_counter < $num_header_rows);
 313
 314       my $column_widths = []; #holds the width of each column
 315       for( my $j = 0; $j < scalar(@$row) ; $j++ ) {
 316         # look for font information for this column
 317         $col_fnt_size   =  $col_props->[$j]->{'font_size'} || $fnt_size;
 318         if ( !$rows_counter and ref $header_props) {
 319           $txt->font(  $header_props->{'font'}, $header_props->{'font_size'} );
 320
 321         } elsif ( $col_props->[$j]->{'font'} ) {
 322           $txt->font( $col_props->[$j]->{'font'}, $col_fnt_size );
 323
 324         } else {
 325           $txt->font( $fnt_name, $col_fnt_size );
 326         }
 327
 328         # This should fix a bug with very long word like serial numbers etc.
 329         # $myone is used because $1 gets out of scope in while condition
 330         my $myone;
 331         do {
 332           $myone = 0;
 333           # This RegEx will split any word that is longer than {25} symbols
 334           $row->[$j] =~ s#(\b\S{$max_word_len}?)(\S.*?\b)# $1 $2#;
 335           $myone = 1 if ( defined $2 );
 336         } while( $myone );
 337         $row->[$j] =~ s/^\s+//;
 338
 339         $space_w             = $txt->advancewidth( "\x20" );
 340         $column_widths->[$j] = 0;
 341         $max_col_w           = 0;
 342         $min_col_w           = 0;
 343
 344         my @words = split( /\s+/, $row->[$j] );
 345
 346         foreach( @words ) {
 347           unless ( exists $word_w->{$_} ) { # Calculate the width of every word and add the space width to it
 348             $word_w->{$_} = $txt->advancewidth( $_ ) + $space_w;
 349           }
 350           $column_widths->[$j] += $word_w->{$_};
 351           $min_col_w            = $word_w->{$_} if $word_w->{$_} > $min_col_w;
 352           $max_col_w           += $word_w->{$_};
 353         }
 354         $min_col_w             += $pad_w;
 355         $max_col_w             += $pad_w;
 356         $column_widths->[$j]   += $pad_w;
 357
 358         # Keep a running total of the overall min and max widths
 359         $col_props->[$j]->{min_w} = $col_props->[$j]->{min_w} || 0;
 360         $col_props->[$j]->{max_w} = $col_props->[$j]->{max_w} || 0;
 361
 362         if ( $min_col_w > $col_props->[$j]->{min_w} ) { # Calculated Minimum Column Width is more than user-defined
 363           $col_props->[$j]->{min_w}    = $min_col_w ;
 364         }
 365         if ( $max_col_w > $col_props->[$j]->{max_w} ) { # Calculated Maximum Column Width is more than user-defined
 366           $col_props->[$j]->{max_w}    = $max_col_w ;
 367         }
 368       }#End of for(my $j....
 369       $row_props->[$rows_counter] = $column_widths;
 370       # Copy the calculated row properties of header row.
 371       if (($rows_counter < $num_header_rows) && $header_props) {
 372         push(@header_row_widths, [ @{ $column_widths } ]);
 373       }
 374       $rows_counter++;
 375     }
 376     # Calc real column widths and expand table width if needed.
 377     my $calc_column_widths;
 378     ($calc_column_widths, $width) = $self->CalcColumnWidths( $col_props, $width );
 379     my $num_cols  = scalar @{ $calc_column_widths };
 380     my $comp_cnt  = 1;
 381     $rows_counter = 0;
 382
 383     my ( $gfx   , $gfx_bg   , $background_color , $font_color,        );
 384     my ( $bot_marg, $table_top_y, $text_start   , $record,  $record_widths  );
 385
 386     my $remaining_header_rows = $header_props ? $num_header_rows : 0;
 387
 388     # Each iteration adds a new page as neccessary
 389     while(scalar(@{$data})) {
 390       my $page_header;
 391       if ($pg_cnt == 1) {
 392         $table_top_y = $ybase;
 393         $bot_marg = $table_top_y - $height;
 394
 395       } else {
 396         if (ref $arg{'new_page_func'}) {
 397           $page = &{$arg{'new_page_func'}};
 398
 399         } else {
 400           $page = $pdf->page;
 401         }
 402
 403         $table_top_y = $next_y;
 404         $bot_marg = $table_top_y - $next_h;
 405
 406         if ( ref $header_props and $header_props->{'repeat'}) {
 407           foreach my $idx (0 .. $num_header_rows - 1) {
 408             unshift @$data,      [ @{ $header_rows[$idx]      } ];
 409             unshift @$row_props, [ @{ $header_row_widths[$idx] } ];
 410           }
 411           $remaining_header_rows = $num_header_rows;
 412         }
 413       }
 414
 415       # Check for safety reasons
 416       if ( $bot_marg < 0 ) { # This warning should remain i think
 417 #         print "!!! Warning: !!! Incorrect Table Geometry! Setting bottom margin to end of sheet!\n";
 418         $bot_marg = 0;
 419       }
 420
 421       $gfx_bg = $page->gfx;
 422       $txt = $page->text;
 423       $txt->font($fnt_name, $fnt_size);
 424       $gfx = $page->gfx;
 425       $gfx->strokecolor($border_color);
 426       $gfx->linewidth($line_w);
 427
 428       # Draw the top line
 429       $cur_y = $table_top_y;
 430       $gfx->move( $xbase , $cur_y );
 431       $gfx->hline($xbase + $width );
 432
 433       # Each iteration adds a row to the current page until the page is full
 434       #  or there are no more rows to add
 435       while(scalar(@{$data}) and $cur_y-$row_h > $bot_marg) {
 436         # Remove the next item from $data
 437         $record = shift @{$data};
 438         # Added to resolve infite loop bug with returned undef values
 439         for(my $d = 0; $d < scalar(@{$record}) ; $d++) {
 440           $record->[$d] = '-' unless ( defined $record->[$d]);
 441         }
 442
 443         $record_widths = shift @$row_props;
 444         next unless $record;
 445
 446         # Choose colors for this row
 447         $background_color = $rows_counter % 2 ? $background_color_even  : $background_color_odd;
 448         $font_color     = $rows_counter % 2 ? $font_color_even    : $font_color_odd;
 449
 450         if ($remaining_header_rows and ref $header_props) {
 451           $background_color = $header_props->{'bg_color'}
 452         }
 453         $text_start    = $cur_y - $fnt_size - $pad_top;
 454         my $cur_x    = $xbase;
 455         my $leftovers    = undef; # Reference to text that is returned from textblock()
 456         my $do_leftovers = 0;
 457
 458         my ($colspan, @vertical_lines);
 459
 460         # Process every column from current row
 461         for( my $j = 0; $j < scalar( @$record); $j++ ) {
 462           next unless $col_props->[$j]->{max_w};
 463           next unless $col_props->[$j]->{min_w};
 464           $leftovers->[$j] = undef;
 465
 466           # Choose font color
 467           if ( $remaining_header_rows and ref $header_props ) {
 468             $txt->fillcolor( $header_props->{'font_color'} );
 469
 470           } elsif ( $cell_props->[$row_cnt][$j]{font_color} ) {
 471             $txt->fillcolor( $cell_props->[$row_cnt][$j]{font_color} );
 472
 473           } elsif ( $col_props->[$j]->{'font_color'} ) {
 474             $txt->fillcolor( $col_props->[$j]->{'font_color'} );
 475
 476           } else {
 477             $txt->fillcolor($font_color);
 478           }
 479
 480           # Choose font size
 481           if ( $remaining_header_rows and ref $header_props ) {
 482             $col_fnt_size = $header_props->{'font_size'};
 483
 484           } elsif ( $col_props->[$j]->{'font_size'} ) {
 485             $col_fnt_size = $col_props->[$j]->{'font_size'};
 486
 487           } else {
 488             $col_fnt_size = $fnt_size;
 489           }
 490
 491           # Choose font family
 492           if ( $remaining_header_rows and ref $header_props ) {
 493             $txt->font( $header_props->{'font'}, $header_props->{'font_size'});
 494
 495           } elsif ( $col_props->[$j]->{'font'} ) {
 496             $txt->font( $col_props->[$j]->{'font'}, $col_fnt_size);
 497
 498           } else {
 499             $txt->font( $fnt_name, $col_fnt_size);
 500           }
 501           #TODO: Implement Center text align
 502           $col_props->[$j]->{justify} = $col_props->[$j]->{justify} || 'left';
 503
 504           my $this_width;
 505           if (!$remaining_header_rows && $cell_props->[$row_cnt]->[$j]->{colspan}) {
 506             $colspan = $cell_props->[$row_cnt]->[$j]->{colspan};
 507
 508           } elsif ($remaining_header_rows && $header_row_cell_props[$num_header_rows - $remaining_header_rows]->[$j]->{colspan}) {
 509             $colspan = $header_row_cell_props[$num_header_rows - $remaining_header_rows]->[$j]->{colspan};
 510
 511           }
 512
 513           if ($colspan) {
 514             $colspan     = $num_cols - $j if (-1 == $colspan);
 515             my $last_idx = $j + $colspan - 1;
 516             $this_width  = sum @{ $calc_column_widths }[$j..$last_idx];
 517
 518           } else {
 519             $this_width = $calc_column_widths->[$j];
 520           }
 521
 522           # If the content is wider than the specified width, we need to add the text as a text block
 523           if ($record->[$j] !~ m#(.\n.)# and  $record_widths->[$j] and ($record_widths->[$j] < $this_width)) {
 524             my $space = $pad_left;
 525             if ($col_props->[$j]->{justify} eq 'right') {
 526               $space = $this_width -($txt->advancewidth($record->[$j]) + $pad_right);
 527             }
 528             $txt->translate( $cur_x + $space, $text_start );
 529             $txt->text( $record->[$j] );
 530           } else { # Otherwise just use the $page->text() method
 531             my($width_of_last_line, $ypos_of_last_line, $left_over_text) =
 532               $self->text_block($txt,
 533                                 $record->[$j],
 534                                 'x'     => $cur_x + $pad_left,
 535                                 'y'     => $text_start,
 536                                 'w'     => $this_width - $pad_w,
 537                                 'h'     => $cur_y - $bot_marg - $pad_top - $pad_bot,
 538                                 'align' => $col_props->[$j]->{justify},
 539                                 'lead'  => $lead
 540               );
 541             # Desi - Removed $lead because of fixed incorrect ypos bug in text_block
 542             my $this_row_h = $cur_y - ( $ypos_of_last_line - $pad_bot );
 543             $row_h = $this_row_h if $this_row_h > $row_h;
 544             if ( $left_over_text ) {
 545               $leftovers->[$j] = $left_over_text;
 546               $do_leftovers    = 1;
 547             }
 548           }
 549           $cur_x += $calc_column_widths->[$j];
 550
 551           push @vertical_lines, (!$colspan || (1 >= $colspan)) ? 1 : 0;
 552           $colspan-- if ($colspan);
 553         }
 554
 555         if ( $do_leftovers ) {
 556           unshift @$data, $leftovers;
 557           unshift @$row_props, $record_widths;
 558           $rows_counter--;
 559         }
 560
 561         # Draw cell bgcolor
 562         # This has to be separately from the text loop
 563         #  because we do not know the final height of the cell until all text has been drawn
 564         $cur_x = $xbase;
 565         for(my $j =0;$j < scalar(@$record);$j++) {
 566           if (  $cell_props->[$row_cnt][$j]->{'background_color'} ||
 567                 $col_props->[$j]->{'background_color'} ||
 568                 $background_color ) {
 569             $gfx_bg->rect( $cur_x, $cur_y-$row_h, $calc_column_widths->[$j], $row_h);
 570             if ( $cell_props->[$row_cnt][$j]->{'background_color'} && !$remaining_header_rows ) {
 571               $gfx_bg->fillcolor($cell_props->[$row_cnt][$j]->{'background_color'});
 572
 573             } elsif ( $col_props->[$j]->{'background_color'} && !$remaining_header_rows  ) {
 574               $gfx_bg->fillcolor($col_props->[$j]->{'background_color'});
 575
 576             } else {
 577               $gfx_bg->fillcolor($background_color);
 578             }
 579             $gfx_bg->fill();
 580           }
 581
 582           $cur_x += $calc_column_widths->[$j];
 583
 584           if ($line_w && $vertical_lines[$j] && ($j != (scalar(@{ $record }) - 1))) {
 585             $gfx->move($cur_x, $cur_y);
 586             $gfx->vline($cur_y - $row_h);
 587             $gfx->fillcolor($border_color);
 588           }
 589         }#End of for(my $j....
 590
 591         $cur_y -= $row_h;
 592         $row_h  = $min_row_h;
 593         $gfx->move(  $xbase , $cur_y );
 594         $gfx->hline( $xbase + $width );
 595         $rows_counter++;
 596         if ($remaining_header_rows) {
 597           $remaining_header_rows--;
 598         } else {
 599           $row_cnt++ unless $do_leftovers;
 600         }
 601       }# End of while(scalar(@{$data}) and $cur_y-$row_h > $bot_marg)
 602
 603       # Draw vertical lines
 604       if ($line_w) {
 605         $gfx->move($xbase, $table_top_y);
 606         $gfx->vline($cur_y);
 607         $gfx->move($xbase + sum(@{ $calc_column_widths }[0..$num_cols - 1]), $table_top_y);
 608         $gfx->vline($cur_y);
 609         $gfx->fillcolor($border_color);
 610         $gfx->stroke();
 611       }
 612       $pg_cnt++;
 613     }# End of while(scalar(@{$data}))
 614   }# End of if (ref $data eq 'ARRAY')
 615
 616   return ($page,--$pg_cnt,$cur_y);
 617 }
 618
 619
 620 # calculate the column widths
 621 sub CalcColumnWidths {
 622   my $self    = shift;
 623   my $col_props   = shift;
 624   my $avail_width = shift;
 625   my $min_width   = 0;
 626
 627   my $calc_widths ;
 628   for(my $j = 0; $j < scalar( @$col_props); $j++) {
 629     $min_width += $col_props->[$j]->{min_w};
 630   }
 631
 632   # I think this is the optimal variant when good view can be guaranateed
 633   if ($avail_width < $min_width) {
 634 #     print "!!! Warning !!!\n Calculated Mininal width($min_width) > Table width($avail_width).\n",
 635 #       ' Expanding table width to:',int($min_width)+1,' but this could lead to unexpected results.',"\n",
 636 #       ' Possible solutions:',"\n",
 637 #       '  0)Increase table width.',"\n",
 638 #       '  1)Decrease font size.',"\n",
 639 #       '  2)Choose a more narrow font.',"\n",
 640 #       '  3)Decrease "max_word_length" parameter.',"\n",
 641 #       '  4)Rotate page to landscape(if it is portrait).',"\n",
 642 #       '  5)Use larger paper size.',"\n",
 643 #       '!!! --------- !!!',"\n";
 644     $avail_width = int( $min_width) + 1;
 645
 646   }
 647
 648   my $span = 0;
 649   # Calculate how much can be added to every column to fit the available width
 650   $span = ($avail_width - $min_width) / scalar( @$col_props);
 651   for (my $j = 0; $j < scalar(@$col_props); $j++ ) {
 652     $calc_widths->[$j] = $col_props->[$j]->{min_w} + $span;
 653   }
 654
 655   return ($calc_widths,$avail_width);
 656 }
 657 1;
 658
 659 __END__
 660
 661 =pod
 662
 663 =head1 NAME
 664
 665 PDF::Table - A utility class for building table layouts in a PDF::API2 object.
 666
 667 =head1 SYNOPSIS
 668
 669  use PDF::API2;
 670  use PDF::Table;
 671
 672  my $pdftable = new PDF::Table;
 673  my $pdf = new PDF::API2(-file => "table_of_lorem.pdf");
 674  my $page = $pdf->page;
 675
 676  # some data to layout
 677  my $some_data =[
 678     ["1 Lorem ipsum dolor",
 679     "Donec odio neque, faucibus vel",
 680     "consequat quis, tincidunt vel, felis."],
 681     ["Nulla euismod sem eget neque.",
 682     "Donec odio neque",
 683     "Sed eu velit."],
 684     #... and so on
 685  ];
 686
 687  $left_edge_of_table = 50;
 688  # build the table layout
 689  $pdftable->table(
 690      # required params
 691      $pdf,
 692      $page,
 693      $some_data,
 694      x => $left_edge_of_table,
 695      w => 495,
 696      start_y => 750,
 697      next_y  => 700,
 698      start_h => 300,
 699      next_h  => 500,
 700      # some optional params
 701      padding => 5,
 702      padding_right => 10,
 703      background_color_odd  => "gray",
 704      background_color_even => "lightblue", #cell background color for even rows
 705   );
 706
 707  # do other stuff with $pdf
 708  $pdf->saveas();
 709 ...
 710
 711 =head1 EXAMPLE
 712
 713 For a complete working example or initial script look into distribution`s 'examples' folder.
 714
 715
 716 =head1 DESCRIPTION
 717
 718 This class is a utility for use with the PDF::API2 module from CPAN.
 719 It can be used to display text data in a table layout within the PDF.
 720 The text data must be in a 2d array (such as returned by a DBI statement handle fetchall_arrayref() call).
 721 The PDF::Table will automatically add as many new pages as necessary to display all of the data.
 722 Various layout properties, such as font, font size, and cell padding and background color can be specified for each column and/or for even/odd rows.
 723 Also a (non)repeated header row with different layout properties can be specified.
 724
 725 See the METHODS section for complete documentation of every parameter.
 726
 727 =head1  METHODS
 728
 729 =head2 new
 730
 731 =over
 732
 733 Returns an instance of the class. There are no parameters.
 734
 735 =back
 736
 737 =head2 table($pdf, $page_obj, $data, %opts)
 738
 739 =over
 740
 741 The main method of this class.
 742 Takes a PDF::API2 instance, a page instance, some data to build the table and formatting options.
 743 The formatting options should be passed as named parameters.
 744 This method will add more pages to the pdf instance as required based on the formatting options and the amount of data.
 745
 746 =back
 747
 748 =over
 749
 750 The return value is a 3 item list where
 751 The first item is the PDF::API2::Page instance that the table ends on,
 752 The second item is the count of pages that the table spans, and
 753 The third item is the y position of the table bottom.
 754
 755 =back
 756
 757 =over
 758
 759 =item Example:
 760
 761  ($end_page, $pages_spanned, $table_bot_y) = $pdftable->table(
 762      $pdf,               # A PDF::API2 instance
 763      $page_to_start_on,  # A PDF::API2::Page instance created with $page_to_start_on = $pdf->page();
 764      $data,              # 2D arrayref of text strings
 765      x  => $left_edge_of_table,    #X - coordinate of upper left corner
 766      w  => 570, # width of table.
 767      start_y => $initial_y_position_on_first_page,
 768      next_y  => $initial_y_position_on_every_new_page,
 769      start_h => $table_height_on_first_page,
 770      next_h  => $table_height_on_every_new_page,
 771      #OPTIONAL PARAMS BELOW
 772      max_word_length=> 20,   # add a space after every 20th symbol in long words like serial numbers
 773      padding        => 5,    # cell padding
 774      padding_top    => 10,   # top cell padding, overides padding
 775      padding_right  => 10,   # right cell padding, overides padding
 776      padding_left   => 10,   # left cell padding, overides padding
 777      padding_bottom => 10,   # bottom padding, overides -padding
 778      border         => 1,    # border width, default 1, use 0 for no border
 779      border_color   => 'red',# default black
 780      font           => $pdf->corefont("Helvetica", -encoding => "utf8"), # default font
 781      font_size      => 12,
 782      font_color_odd => 'purple',
 783      font_color_even=> 'black',
 784      background_color_odd  => 'gray',         #cell background color for odd rows
 785      background_color_even => 'lightblue',     #cell background color for even rows
 786      new_page_func  => $code_ref,  # see section TABLE SPANNING
 787      header_props   => $hdr_props, # see section HEADER ROW PROPERTIES
 788      column_props   => $col_props, # see section COLUMN PROPERTIES
 789      cell_props     => $row_props, # see section CELL PROPERTIES
 790  )
 791
 792 =back
 793
 794 =over
 795
 796 =item HEADER ROW PROPERTIES
 797
 798 If the 'header_props' parameter is used, it should be a hashref.
 799 It is your choice if it will be anonymous inline hash or predefined one.
 800 Also as you can see there is no data variable for the content because the module asumes that the first table row will become the header row. It will copy this row and put it on every new page if 'repeat' param is set.
 801
 802 =back
 803
 804     $hdr_props =
 805     {
 806         # This param could be a pdf core font or user specified TTF.
 807         #  See PDF::API2 FONT METHODS for more information
 808         font       => $pdf->corefont("Times", -encoding => "utf8"),
 809         font_size  => 10,
 810         font_color => '#006666',
 811         bg_color   => 'yellow',
 812         repeat     => 1,    # 1/0 eq On/Off  if the header row should be repeated to every new page
 813     };
 814
 815 =over
 816
 817 =item COLUMN PROPERTIES
 818
 819 If the 'column_props' parameter is used, it should be an arrayref of hashrefs,
 820 with one hashref for each column of the table. The columns are counted from left to right so the hash reference at $col_props[0] will hold properties for the first column from left to right.
 821 If you DO NOT want to give properties for a column but to give for another just insert and empty hash reference into the array for the column that you want to skip. This will cause the counting to proceed as expected and the properties to be applyed at the right columns.
 822
 823 Each hashref can contain any of the keys shown below:
 824
 825 =back
 826
 827   $col_props = [
 828     {},# This is an empty hash so the next one will hold the properties for the second row from left to right.
 829     {
 830         min_w => 100,       # Minimum column width.
 831         justify => 'right', # One of left|right ,
 832         font => $pdf->corefont("Times", -encoding => "latin1"),
 833         font_size => 10,
 834         font_color=> 'blue',
 835         background_color => '#FFFF00',
 836     },
 837     # etc.
 838   ];
 839
 840 =over
 841
 842 If the 'min_w' parameter is used for 'col_props', have in mind that it can be overwritten
 843 by the calculated minimum cell witdh if the userdefined value is less that calculated.
 844 This is done for safety reasons.
 845 In cases of a conflict between column formatting and odd/even row formatting,
 846 the former will override the latter.
 847
 848 =back
 849
 850 =over
 851
 852 =item CELL PROPERTIES
 853
 854 If the 'cell_props' parameter is used, it should be an arrayref with arrays of hashrefs
 855 (of the same dimension as the data array) with one hashref for each cell of the table.
 856 Each hashref can contain any of keys shown here:
 857
 858 =back
 859
 860   $cell_props = [
 861     [ #This array is for the first row. If header_props is defined it will overwrite this settings.
 862       {#Row 1 cell 1
 863         background_color => '#AAAA00',
 864         font_color       => 'blue',
 865       },
 866       # etc.
 867     ],
 868     [ #Row 2
 869       {#Row 2 cell 1
 870         background_color => '#CCCC00',
 871         font_color       => 'blue',
 872       },
 873       {#Row 2 cell 2
 874         background_color => '#CCCC00',
 875         font_color       => 'blue',
 876       },
 877       # etc.
 878     ],
 879   # etc.
 880   ];
 881
 882 =over
 883
 884 In case of a conflict between column, odd/even and cell formating, cell formating will overwrite the other two.
 885 In case of a conflict between header row cell formating, header formating will win.
 886
 887 =back
 888
 889 =over
 890
 891
 892
 893 =item TABLE SPANNING
 894
 895 If used the parameter 'new_page_func' must be a function reference which when executed will create a new page and will return the object back to the module.
 896 For example you can use it to put Page Title, Page Frame, Page Numbers and other staff that you need.
 897 Also if you need some different type of paper size and orientation than the default A4-Portrait for example B2-Landscape you can use this function ref to set it up for you. For more info about creating pages refer to PDF::API2 PAGE METHODS Section.
 898 Dont forget that your function must return a page object created with PDF::API2 page() method.
 899
 900 =back
 901
 902 =head2 text_block( $txtobj, $string, x => $x, y => $y, w => $width, h => $height)
 903
 904 =over
 905
 906 Utility method to create a block of text. The block may contain multiple paragraphs.
 907 It is mainly used internaly but you can use it from outside for placing formated text anywhere on the sheet.
 908
 909 =back
 910
 911 =over
 912
 913 =item Example:
 914
 915 =back
 916
 917 =over
 918
 919  # PDF::API2 objects
 920  my $page = $pdf->page;
 921  my $txt = $page->text;
 922
 923 =back
 924
 925 =over
 926
 927  ($width_of_last_line, $ypos_of_last_line, $left_over_text) = $pdftable->text_block(
 928     $txt,
 929     $text_to_place,
 930     #X,Y - coordinates of upper left corner
 931     x        => $left_edge_of_block,
 932     y        => $y_position_of_first_line,
 933     w        => $width_of_block,
 934     h        => $height_of_block,
 935     #OPTIONAL PARAMS
 936     lead     => $font_size | $distance_between_lines,
 937     align    => "left|right|center|justify|fulljustify",
 938     hang     => $optional_hanging_indent,
 939     Only one of the subsequent 3params can be given.
 940     They override each other.-parspace is the weightest
 941     parspace => $optional_vertical_space_before_first_paragraph,
 942     flindent => $optional_indent_of_first_line,
 943     fpindent => $optional_indent_of_first_paragraph,
 944
 945     indent   => $optional_indent_of_text_to_every_non_first_line,
 946  );
 947
 948
 949 =back
 950
 951 =head1 AUTHOR
 952
 953 Daemmon Hughes
 954
 955 =head1 DEVELOPMENT
 956
 957 ALL IMPROVEMENTS and BUGS Since Ver: 0.02
 958
 959 Desislav Kamenov
 960
 961 =head1 VERSION
 962
 963 0.9.3
 964
 965 =head1 COPYRIGHT AND LICENSE
 966
 967 Copyright (C) 2006 by Daemmon Hughes, portions Copyright 2004 Stone
 968 Environmental Inc. (www.stone-env.com) All Rights Reserved.
 969
 970 This library is free software; you can redistribute it and/or modify
 971 it under the same terms as Perl itself, either Perl version 5.8.4 or,
 972 at your option, any later version of Perl 5 you may have available.
 973
 974 =head1 PLUGS
 975
 976 by Daemmon Hughes
 977
 978 Much of the work on this module was sponsered by
 979 Stone Environmental Inc. (www.stone-env.com).
 980
 981 The text_block() method is a slightly modified copy of the one from
 982 Rick Measham's PDF::API2 tutorial at
 983 http://pdfapi2.sourceforge.net/cgi-bin/view/Main/YourFirstDocument
 984 update: The tutorial is no longer available. Please visit http://pdfapi2.sourceforge.net .
 985
 986 by Desislav Kamenov
 987
 988 The development of this module is sponsored by SEEBURGER AG (www.seeburger.com)
 989
 990 Thanks to my friends Krasimir Berov and Alex Kantchev for helpful tips and QA during development.
 991
 992 =head1 SEE ALSO
 993
 994 L<PDF::API2>
 995
 996 =cut