modules/override/PDF/Table.pm

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