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