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