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;
 139     while ( @paragraph and $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
 338         $space_w             = $txt->advancewidth( "\x20" );
 339         $column_widths->[$j] = 0;
 340         $max_col_w           = 0;
 341         $min_col_w           = 0;
 342
 343         my @words = split( /\s+/, $row->[$j] );
 344
 345         foreach( @words ) {
 346           unless ( exists $word_w->{$_} ) { # Calculate the width of every word and add the space width to it
 347             $word_w->{$_} = $txt->advancewidth( $_ ) + $space_w;
 348           }
 349           $column_widths->[$j] += $word_w->{$_};
 350           $min_col_w            = $word_w->{$_} if $word_w->{$_} > $min_col_w;
 351           $max_col_w           += $word_w->{$_};
 352         }
 353         $min_col_w             += $pad_w;
 354         $max_col_w             += $pad_w;
 355         $column_widths->[$j]   += $pad_w;
 356
 357         # Keep a running total of the overall min and max widths
 358         $col_props->[$j]->{min_w} = $col_props->[$j]->{min_w} || 0;
 359         $col_props->[$j]->{max_w} = $col_props->[$j]->{max_w} || 0;
 360
 361         if ( $min_col_w > $col_props->[$j]->{min_w} ) { # Calculated Minimum Column Width is more than user-defined
 362           $col_props->[$j]->{min_w}    = $min_col_w ;
 363         }
 364         if ( $max_col_w > $col_props->[$j]->{max_w} ) { # Calculated Maximum Column Width is more than user-defined
 365           $col_props->[$j]->{max_w}    = $max_col_w ;
 366         }
 367       }#End of for(my $j....
 368       $row_props->[$rows_counter] = $column_widths;
 369       # Copy the calculated row properties of header row.
 370       if (($rows_counter < $num_header_rows) && $header_props) {
 371         push(@header_row_widths, [ @{ $column_widths } ]);
 372       }
 373       $rows_counter++;
 374     }
 375     # Calc real column widths and expand table width if needed.
 376     my $calc_column_widths;
 377     ($calc_column_widths, $width) = $self->CalcColumnWidths( $col_props, $width );
 378     my $num_cols  = scalar @{ $calc_column_widths };
 379     my $comp_cnt  = 1;
 380     $rows_counter = 0;
 381
 382     my ( $gfx   , $gfx_bg   , $background_color , $font_color,        );
 383     my ( $bot_marg, $table_top_y, $text_start   , $record,  $record_widths  );
 384
 385     my $remaining_header_rows = $header_props ? $num_header_rows : 0;
 386
 387     # Each iteration adds a new page as neccessary
 388     while(scalar(@{$data})) {
 389       my $page_header;
 390       if ($pg_cnt == 1) {
 391         $table_top_y = $ybase;
 392         $bot_marg = $table_top_y - $height;
 393
 394       } else {
 395         if (ref $arg{'new_page_func'}) {
 396           $page = &{$arg{'new_page_func'}};
 397
 398         } else {
 399           $page = $pdf->page;
 400         }
 401
 402         $table_top_y = $next_y;
 403         $bot_marg = $table_top_y - $next_h;
 404
 405         if ( ref $header_props and $header_props->{'repeat'}) {
 406           foreach my $idx (0 .. $num_header_rows - 1) {
 407             unshift @$data,      [ @{ $header_rows[$idx]      } ];
 408             unshift @$row_props, [ @{ $header_row_widths[$idx] } ];
 409           }
 410           $remaining_header_rows = $num_header_rows;
 411         }
 412       }
 413
 414       # Check for safety reasons
 415       if ( $bot_marg < 0 ) { # This warning should remain i think
 416 #         print "!!! Warning: !!! Incorrect Table Geometry! Setting bottom margin to end of sheet!\n";
 417         $bot_marg = 0;
 418       }
 419
 420       $gfx_bg = $page->gfx;
 421       $txt = $page->text;
 422       $txt->font($fnt_name, $fnt_size);
 423       $gfx = $page->gfx;
 424       $gfx->strokecolor($border_color);
 425       $gfx->linewidth($line_w);
 426
 427       # Draw the top line
 428       $cur_y = $table_top_y;
 429       $gfx->move( $xbase , $cur_y );
 430       $gfx->hline($xbase + $width );
 431
 432       # Each iteration adds a row to the current page until the page is full
 433       #  or there are no more rows to add
 434       while(scalar(@{$data}) and $cur_y-$row_h > $bot_marg) {
 435         # Remove the next item from $data
 436         $record = shift @{$data};
 437         # Added to resolve infite loop bug with returned undef values
 438         for(my $d = 0; $d < scalar(@{$record}) ; $d++) {
 439           $record->[$d] = '-' unless ( defined $record->[$d]);
 440         }
 441
 442         $record_widths = shift @$row_props;
 443         next unless $record;
 444
 445         # Choose colors for this row
 446         $background_color = $rows_counter % 2 ? $background_color_even  : $background_color_odd;
 447         $font_color     = $rows_counter % 2 ? $font_color_even    : $font_color_odd;
 448
 449         if ($remaining_header_rows and ref $header_props) {
 450           $background_color = $header_props->{'bg_color'}
 451         }
 452         $text_start    = $cur_y - $fnt_size - $pad_top;
 453         my $cur_x    = $xbase;
 454         my $leftovers    = undef; # Reference to text that is returned from textblock()
 455         my $do_leftovers = 0;
 456
 457         my ($colspan, @vertical_lines);
 458
 459         # Process every column from current row
 460         for( my $j = 0; $j < scalar( @$record); $j++ ) {
 461           next unless $col_props->[$j]->{max_w};
 462           next unless $col_props->[$j]->{min_w};
 463           $leftovers->[$j] = undef;
 464
 465           # Choose font color
 466           if ( $remaining_header_rows and ref $header_props ) {
 467             $txt->fillcolor( $header_props->{'font_color'} );
 468
 469           } elsif ( $cell_props->[$row_cnt][$j]{font_color} ) {
 470             $txt->fillcolor( $cell_props->[$row_cnt][$j]{font_color} );
 471
 472           } elsif ( $col_props->[$j]->{'font_color'} ) {
 473             $txt->fillcolor( $col_props->[$j]->{'font_color'} );
 474
 475           } else {
 476             $txt->fillcolor($font_color);
 477           }
 478
 479           # Choose font size
 480           if ( $remaining_header_rows and ref $header_props ) {
 481             $col_fnt_size = $header_props->{'font_size'};
 482
 483           } elsif ( $col_props->[$j]->{'font_size'} ) {
 484             $col_fnt_size = $col_props->[$j]->{'font_size'};
 485
 486           } else {
 487             $col_fnt_size = $fnt_size;
 488           }
 489
 490           # Choose font family
 491           if ( $remaining_header_rows and ref $header_props ) {
 492             $txt->font( $header_props->{'font'}, $header_props->{'font_size'});
 493
 494           } elsif ( $col_props->[$j]->{'font'} ) {
 495             $txt->font( $col_props->[$j]->{'font'}, $col_fnt_size);
 496
 497           } else {
 498             $txt->font( $fnt_name, $col_fnt_size);
 499           }
 500           #TODO: Implement Center text align
 501           $col_props->[$j]->{justify} = $col_props->[$j]->{justify} || 'left';
 502
 503           my $this_width;
 504           if (!$remaining_header_rows && $cell_props->[$row_cnt]->[$j]->{colspan}) {
 505             $colspan = $cell_props->[$row_cnt]->[$j]->{colspan};
 506
 507           } elsif ($remaining_header_rows && $header_row_cell_props[$num_header_rows - $remaining_header_rows]->[$j]->{colspan}) {
 508             $colspan = $header_row_cell_props[$num_header_rows - $remaining_header_rows]->[$j]->{colspan};
 509
 510           }
 511
 512           if ($colspan) {
 513             $colspan     = $num_cols - $j if (-1 == $colspan);
 514             my $last_idx = $j + $colspan - 1;
 515             $this_width  = sum @{ $calc_column_widths }[$j..$last_idx];
 516
 517           } else {
 518             $this_width = $calc_column_widths->[$j];
 519           }
 520
 521           # If the content is wider than the specified width, we need to add the text as a text block
 522           if ($record->[$j] !~ m#(.\n.)# and  $record_widths->[$j] and ($record_widths->[$j] < $this_width)) {
 523             my $space = $pad_left;
 524             if ($col_props->[$j]->{justify} eq 'right') {
 525               $space = $this_width -($txt->advancewidth($record->[$j]) + $pad_right);
 526             }
 527             $txt->translate( $cur_x + $space, $text_start );
 528             $txt->text( $record->[$j] );
 529           } else { # Otherwise just use the $page->text() method
 530             my($width_of_last_line, $ypos_of_last_line, $left_over_text) =
 531               $self->text_block($txt,
 532                                 $record->[$j],
 533                                 'x'     => $cur_x + $pad_left,
 534                                 'y'     => $text_start,
 535                                 'w'     => $this_width - $pad_w,
 536                                 'h'     => $cur_y - $bot_marg - $pad_top - $pad_bot,
 537                                 'align' => $col_props->[$j]->{justify},
 538                                 'lead'  => $lead
 539               );
 540             # Desi - Removed $lead because of fixed incorrect ypos bug in text_block
 541             my $this_row_h = $cur_y - ( $ypos_of_last_line - $pad_bot );
 542             $row_h = $this_row_h if $this_row_h > $row_h;
 543             if ( $left_over_text ) {
 544               $leftovers->[$j] = $left_over_text;
 545               $do_leftovers    = 1;
 546             }
 547           }
 548           $cur_x += $calc_column_widths->[$j];
 549
 550           push @vertical_lines, (!$colspan || (1 >= $colspan)) ? 1 : 0;
 551           $colspan-- if ($colspan);
 552         }
 553
 554         if ( $do_leftovers ) {
 555           unshift @$data, $leftovers;
 556           unshift @$row_props, $record_widths;
 557           $rows_counter--;
 558         }
 559
 560         # Draw cell bgcolor
 561         # This has to be separately from the text loop
 562         #  because we do not know the final height of the cell until all text has been drawn
 563         $cur_x = $xbase;
 564         for(my $j =0;$j < scalar(@$record);$j++) {
 565           if (  $cell_props->[$row_cnt][$j]->{'background_color'} ||
 566                 $col_props->[$j]->{'background_color'} ||
 567                 $background_color ) {
 568             $gfx_bg->rect( $cur_x, $cur_y-$row_h, $calc_column_widths->[$j], $row_h);
 569             if ( $cell_props->[$row_cnt][$j]->{'background_color'} && !$remaining_header_rows ) {
 570               $gfx_bg->fillcolor($cell_props->[$row_cnt][$j]->{'background_color'});
 571
 572             } elsif ( $col_props->[$j]->{'background_color'} && !$remaining_header_rows  ) {
 573               $gfx_bg->fillcolor($col_props->[$j]->{'background_color'});
 574
 575             } else {
 576               $gfx_bg->fillcolor($background_color);
 577             }
 578             $gfx_bg->fill();
 579           }
 580
 581           $cur_x += $calc_column_widths->[$j];
 582
 583           if ($line_w && $vertical_lines[$j] && ($j != (scalar(@{ $record }) - 1))) {
 584             $gfx->move($cur_x, $cur_y);
 585             $gfx->vline($cur_y - $row_h);
 586             $gfx->fillcolor($border_color);
 587           }
 588         }#End of for(my $j....
 589
 590         $cur_y -= $row_h;
 591         $row_h  = $min_row_h;
 592         $gfx->move(  $xbase , $cur_y );
 593         $gfx->hline( $xbase + $width );
 594         $rows_counter++;
 595         if ($remaining_header_rows) {
 596           $remaining_header_rows--;
 597         } else {
 598           $row_cnt++;
 599         }
 600       }# End of while(scalar(@{$data}) and $cur_y-$row_h > $bot_marg)
 601
 602       # Draw vertical lines
 603       if ($line_w) {
 604         $gfx->move($xbase, $table_top_y);
 605         $gfx->vline($cur_y);
 606         $gfx->move($xbase + sum(@{ $calc_column_widths }[0..$num_cols - 1]), $table_top_y);
 607         $gfx->vline($cur_y);
 608         $gfx->fillcolor($border_color);
 609         $gfx->stroke();
 610       }
 611       $pg_cnt++;
 612     }# End of while(scalar(@{$data}))
 613   }# End of if (ref $data eq 'ARRAY')
 614
 615   return ($page,--$pg_cnt,$cur_y);
 616 }
 617
 618
 619 # calculate the column widths
 620 sub CalcColumnWidths {
 621   my $self    = shift;
 622   my $col_props   = shift;
 623   my $avail_width = shift;
 624   my $min_width   = 0;
 625
 626   my $calc_widths ;
 627   for(my $j = 0; $j < scalar( @$col_props); $j++) {
 628     $min_width += $col_props->[$j]->{min_w};
 629   }
 630
 631   # I think this is the optimal variant when good view can be guaranateed
 632   if ($avail_width < $min_width) {
 633 #     print "!!! Warning !!!\n Calculated Mininal width($min_width) > Table width($avail_width).\n",
 634 #       ' Expanding table width to:',int($min_width)+1,' but this could lead to unexpected results.',"\n",
 635 #       ' Possible solutions:',"\n",
 636 #       '  0)Increase table width.',"\n",
 637 #       '  1)Decrease font size.',"\n",
 638 #       '  2)Choose a more narrow font.',"\n",
 639 #       '  3)Decrease "max_word_length" parameter.',"\n",
 640 #       '  4)Rotate page to landscape(if it is portrait).',"\n",
 641 #       '  5)Use larger paper size.',"\n",
 642 #       '!!! --------- !!!',"\n";
 643     $avail_width = int( $min_width) + 1;
 644
 645   }
 646
 647   my $span = 0;
 648   # Calculate how much can be added to every column to fit the available width
 649   $span = ($avail_width - $min_width) / scalar( @$col_props);
 650   for (my $j = 0; $j < scalar(@$col_props); $j++ ) {
 651     $calc_widths->[$j] = $col_props->[$j]->{min_w} + $span;
 652   }
 653
 654   return ($calc_widths,$avail_width);
 655 }
 656 1;
 657
 658 __END__
 659
 660 =pod
 661
 662 =head1 NAME
 663
 664 PDF::Table - A utility class for building table layouts in a PDF::API2 object.
 665
 666 =head1 SYNOPSIS
 667
 668  use PDF::API2;
 669  use PDF::Table;
 670
 671  my $pdftable = new PDF::Table;
 672  my $pdf = new PDF::API2(-file => "table_of_lorem.pdf");
 673  my $page = $pdf->page;
 674
 675  # some data to layout
 676  my $some_data =[
 677     ["1 Lorem ipsum dolor",
 678     "Donec odio neque, faucibus vel",
 679     "consequat quis, tincidunt vel, felis."],
 680     ["Nulla euismod sem eget neque.",
 681     "Donec odio neque",
 682     "Sed eu velit."],
 683     #... and so on
 684  ];
 685
 686  $left_edge_of_table = 50;
 687  # build the table layout
 688  $pdftable->table(
 689      # required params
 690      $pdf,
 691      $page,
 692      $some_data,
 693      x => $left_edge_of_table,
 694      w => 495,
 695      start_y => 750,
 696      next_y  => 700,
 697      start_h => 300,
 698      next_h  => 500,
 699      # some optional params
 700      padding => 5,
 701      padding_right => 10,
 702      background_color_odd  => "gray",
 703      background_color_even => "lightblue", #cell background color for even rows
 704   );
 705
 706  # do other stuff with $pdf
 707  $pdf->saveas();
 708 ...
 709
 710 =head1 EXAMPLE
 711
 712 For a complete working example or initial script look into distribution`s 'examples' folder.
 713
 714
 715 =head1 DESCRIPTION
 716
 717 This class is a utility for use with the PDF::API2 module from CPAN.
 718 It can be used to display text data in a table layout within the PDF.
 719 The text data must be in a 2d array (such as returned by a DBI statement handle fetchall_arrayref() call).
 720 The PDF::Table will automatically add as many new pages as necessary to display all of the data.
 721 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.
 722 Also a (non)repeated header row with different layout properties can be specified.
 723
 724 See the METHODS section for complete documentation of every parameter.
 725
 726 =head1  METHODS
 727
 728 =head2 new
 729
 730 =over
 731
 732 Returns an instance of the class. There are no parameters.
 733
 734 =back
 735
 736 =head2 table($pdf, $page_obj, $data, %opts)
 737
 738 =over
 739
 740 The main method of this class.
 741 Takes a PDF::API2 instance, a page instance, some data to build the table and formatting options.
 742 The formatting options should be passed as named parameters.
 743 This method will add more pages to the pdf instance as required based on the formatting options and the amount of data.
 744
 745 =back
 746
 747 =over
 748
 749 The return value is a 3 item list where
 750 The first item is the PDF::API2::Page instance that the table ends on,
 751 The second item is the count of pages that the table spans, and
 752 The third item is the y position of the table bottom.
 753
 754 =back
 755
 756 =over
 757
 758 =item Example:
 759
 760  ($end_page, $pages_spanned, $table_bot_y) = $pdftable->table(
 761      $pdf,               # A PDF::API2 instance
 762      $page_to_start_on,  # A PDF::API2::Page instance created with $page_to_start_on = $pdf->page();
 763      $data,              # 2D arrayref of text strings
 764      x  => $left_edge_of_table,    #X - coordinate of upper left corner
 765      w  => 570, # width of table.
 766      start_y => $initial_y_position_on_first_page,
 767      next_y  => $initial_y_position_on_every_new_page,
 768      start_h => $table_height_on_first_page,
 769      next_h  => $table_height_on_every_new_page,
 770      #OPTIONAL PARAMS BELOW
 771      max_word_length=> 20,   # add a space after every 20th symbol in long words like serial numbers
 772      padding        => 5,    # cell padding
 773      padding_top    => 10,   # top cell padding, overides padding
 774      padding_right  => 10,   # right cell padding, overides padding
 775      padding_left   => 10,   # left cell padding, overides padding
 776      padding_bottom => 10,   # bottom padding, overides -padding
 777      border         => 1,    # border width, default 1, use 0 for no border
 778      border_color   => 'red',# default black
 779      font           => $pdf->corefont("Helvetica", -encoding => "utf8"), # default font
 780      font_size      => 12,
 781      font_color_odd => 'purple',
 782      font_color_even=> 'black',
 783      background_color_odd  => 'gray',         #cell background color for odd rows
 784      background_color_even => 'lightblue',     #cell background color for even rows
 785      new_page_func  => $code_ref,  # see section TABLE SPANNING
 786      header_props   => $hdr_props, # see section HEADER ROW PROPERTIES
 787      column_props   => $col_props, # see section COLUMN PROPERTIES
 788      cell_props     => $row_props, # see section CELL PROPERTIES
 789  )
 790
 791 =back
 792
 793 =over
 794
 795 =item HEADER ROW PROPERTIES
 796
 797 If the 'header_props' parameter is used, it should be a hashref.
 798 It is your choice if it will be anonymous inline hash or predefined one.
 799 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.
 800
 801 =back
 802
 803     $hdr_props =
 804     {
 805         # This param could be a pdf core font or user specified TTF.
 806         #  See PDF::API2 FONT METHODS for more information
 807         font       => $pdf->corefont("Times", -encoding => "utf8"),
 808         font_size  => 10,
 809         font_color => '#006666',
 810         bg_color   => 'yellow',
 811         repeat     => 1,    # 1/0 eq On/Off  if the header row should be repeated to every new page
 812     };
 813
 814 =over
 815
 816 =item COLUMN PROPERTIES
 817
 818 If the 'column_props' parameter is used, it should be an arrayref of hashrefs,
 819 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.
 820 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.
 821
 822 Each hashref can contain any of the keys shown below:
 823
 824 =back
 825
 826   $col_props = [
 827     {},# This is an empty hash so the next one will hold the properties for the second row from left to right.
 828     {
 829         min_w => 100,       # Minimum column width.
 830         justify => 'right', # One of left|right ,
 831         font => $pdf->corefont("Times", -encoding => "latin1"),
 832         font_size => 10,
 833         font_color=> 'blue',
 834         background_color => '#FFFF00',
 835     },
 836     # etc.
 837   ];
 838
 839 =over
 840
 841 If the 'min_w' parameter is used for 'col_props', have in mind that it can be overwritten
 842 by the calculated minimum cell witdh if the userdefined value is less that calculated.
 843 This is done for safety reasons.
 844 In cases of a conflict between column formatting and odd/even row formatting,
 845 the former will override the latter.
 846
 847 =back
 848
 849 =over
 850
 851 =item CELL PROPERTIES
 852
 853 If the 'cell_props' parameter is used, it should be an arrayref with arrays of hashrefs
 854 (of the same dimension as the data array) with one hashref for each cell of the table.
 855 Each hashref can contain any of keys shown here:
 856
 857 =back
 858
 859   $cell_props = [
 860     [ #This array is for the first row. If header_props is defined it will overwrite this settings.
 861       {#Row 1 cell 1
 862         background_color => '#AAAA00',
 863         font_color       => 'blue',
 864       },
 865       # etc.
 866     ],
 867     [ #Row 2
 868       {#Row 2 cell 1
 869         background_color => '#CCCC00',
 870         font_color       => 'blue',
 871       },
 872       {#Row 2 cell 2
 873         background_color => '#CCCC00',
 874         font_color       => 'blue',
 875       },
 876       # etc.
 877     ],
 878   # etc.
 879   ];
 880
 881 =over
 882
 883 In case of a conflict between column, odd/even and cell formating, cell formating will overwrite the other two.
 884 In case of a conflict between header row cell formating, header formating will win.
 885
 886 =back
 887
 888 =over
 889
 890
 891
 892 =item TABLE SPANNING
 893
 894 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.
 895 For example you can use it to put Page Title, Page Frame, Page Numbers and other staff that you need.
 896 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.
 897 Dont forget that your function must return a page object created with PDF::API2 page() method.
 898
 899 =back
 900
 901 =head2 text_block( $txtobj, $string, x => $x, y => $y, w => $width, h => $height)
 902
 903 =over
 904
 905 Utility method to create a block of text. The block may contain multiple paragraphs.
 906 It is mainly used internaly but you can use it from outside for placing formated text anywhere on the sheet.
 907
 908 =back
 909
 910 =over
 911
 912 =item Example:
 913
 914 =back
 915
 916 =over
 917
 918  # PDF::API2 objects
 919  my $page = $pdf->page;
 920  my $txt = $page->text;
 921
 922 =back
 923
 924 =over
 925
 926  ($width_of_last_line, $ypos_of_last_line, $left_over_text) = $pdftable->text_block(
 927     $txt,
 928     $text_to_place,
 929     #X,Y - coordinates of upper left corner
 930     x        => $left_edge_of_block,
 931     y        => $y_position_of_first_line,
 932     w        => $width_of_block,
 933     h        => $height_of_block,
 934     #OPTIONAL PARAMS
 935     lead     => $font_size | $distance_between_lines,
 936     align    => "left|right|center|justify|fulljustify",
 937     hang     => $optional_hanging_indent,
 938     Only one of the subsequent 3params can be given.
 939     They override each other.-parspace is the weightest
 940     parspace => $optional_vertical_space_before_first_paragraph,
 941     flindent => $optional_indent_of_first_line,
 942     fpindent => $optional_indent_of_first_paragraph,
 943
 944     indent   => $optional_indent_of_text_to_every_non_first_line,
 945  );
 946
 947
 948 =back
 949
 950 =head1 AUTHOR
 951
 952 Daemmon Hughes
 953
 954 =head1 DEVELOPMENT
 955
 956 ALL IMPROVEMENTS and BUGS Since Ver: 0.02
 957
 958 Desislav Kamenov
 959
 960 =head1 VERSION
 961
 962 0.9.3
 963
 964 =head1 COPYRIGHT AND LICENSE
 965
 966 Copyright (C) 2006 by Daemmon Hughes, portions Copyright 2004 Stone
 967 Environmental Inc. (www.stone-env.com) All Rights Reserved.
 968
 969 This library is free software; you can redistribute it and/or modify
 970 it under the same terms as Perl itself, either Perl version 5.8.4 or,
 971 at your option, any later version of Perl 5 you may have available.
 972
 973 =head1 PLUGS
 974
 975 by Daemmon Hughes
 976
 977 Much of the work on this module was sponsered by
 978 Stone Environmental Inc. (www.stone-env.com).
 979
 980 The text_block() method is a slightly modified copy of the one from
 981 Rick Measham's PDF::API2 tutorial at
 982 http://pdfapi2.sourceforge.net/cgi-bin/view/Main/YourFirstDocument
 983
 984 by Desislav Kamenov
 985
 986 The development of this module is sponsored by SEEBURGER AG (www.seeburger.com)
 987
 988 Thanks to my friends Krasimir Berov and Alex Kantchev for helpful tips and QA during development.
 989
 990 =head1 SEE ALSO
 991
 992 L<PDF::API2>
 993
 994 =cut