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