Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

RTF Table function

by ikkon (Monk)
on Aug 29, 2007 at 17:10 UTC ( #635868=perlquestion: print w/ replies, xml ) Need Help??
ikkon has asked for the wisdom of the Perl Monks concerning the following question:

I am using RTF::Writer and I am trying to creat a function that will allow me to make a table without using a bunch of extra lines
I don't get any errors but the rtf doesn't have anything in it

here is my code:
my @tableProp5 = ( widths => [inches(3), inches(4)], #--> width of +each column align => 'l l', ); my @myText = ( [\'\fs20\b this', 'that'], [\'\fs20\b this', 'that'], [\'\fs20\b this', 'that'], [\'\fs20\b this', 'that'], ); RTFTable(@tableProp5, 9, 7, @myText); $fh->close(); sub RTFTable{ my (@tableProps, $headerColor, $bgColor, @Text ) = @_; my $count = 0; my $oDecl5; foreach (@Text) { if($headerColor eq undef || $headerColor eq "" || $headerC +olor == 0 || $count == 0){ $oDecl5 = RTF::Writer::TableRowDecl->new(@tableProps); $oDecl5->add_bgcolors($headerColor); # Adds backgroun +d color using color hash $fh->row($oDecl5, $_); $count++; }else{ $oDecl5 = RTF::Writer::TableRowDecl->new(@tableProps); $oDecl5->add_bgcolors($bgColor); # Adds background co +lor using color hash $fh->row($oDecl5, $_); } } }
some functions and stuff has been leftout to save space, the above code is the problem

I believe its the Text array i am trying to pass not sure if I am doing that correctly or not
Thanks for any help on this matter

If you would like to see the full script:
#!/usr/bin/perl use strict; use RTF::Writer; #--> Declare new rtf object either save to disk or save to string my $fh = RTF::Writer->new_to_file("newTable.rtf"); # $fh = RTF::Writer->new_to_string(\$RTF_obj); #--> MUST write a prolog - font and color table (RGB) #--> Font: when calling font use \f0 (or number of the array, to c +hange font size double the size #--> example: for 12 point font do - \fs24 $fh->prolog( fonts => ['Arial'], colors => [ undef, # color 0 == black [255,0,0], # color 1 == red [0,128,0], # color 2 == green [0,0,255], # color 3 == blue [255,255,0], # color 4 == yellow [255,255,255],# color 5 == white [200,200,200],# color 6 == light gray [187,204,224],# color 7 == table blue [144,172,202],# color 8 == table header bl +ue [102,102,102],# color 9 == gray ], ); #--> Setting up margins (these MUST be here) #----------------------------------------------> my $iMarginLeftInches = my $iMarginRightInches = 500; my $iMarginTop = 500; #--> Need bigger bottom margin for footer to fit: #-------------------------------------------------> my $iMarginBottom = 500; my $iMarginLeft = $iMarginLeftInches; my $iMarginRight = $iMarginRightInches; eval "\$fh->Margt$iMarginTop"; eval "\$fh->Margl$iMarginLeft"; eval "\$fh->Margr$iMarginRight"; eval "\$fh->Margb$iMarginBottom"; my @tableProp5 = ( widths => [inches(3), inches(4)], #--> width of +each column align => 'l l', ); my @myText = ( ['\fs20\b this', 'that'], ['\fs20\b this', 'that'], ['\fs20\b this', 'that'], ['\fs20\b this', 'that'], ); RTFTable(@tableProp5, 9, 7, @myText); $fh->close(); sub RTFTable{ my (@tableProps, $headerColor, $bgColor, @Text ) = @_; my $count = 0; my $oDecl5; foreach my $aref (@Text) { if($headerColor eq undef || $headerColor eq "" || $headerC +olor == 0 || $count == 0){ $oDecl5 = RTF::Writer::TableRowDecl->new(@tableProps); $oDecl5->add_bgcolors($headerColor); # Adds backgroun +d color using color hash $fh->row($oDecl5, @$aref); $count++; }else{ $oDecl5 = RTF::Writer::TableRowDecl->new(@tableProps); $oDecl5->add_bgcolors($bgColor); # Adds background co +lor using color hash $fh->row($oDecl5, $aref); } } } #--> line breaks pass number of lines #--------------------------------------> sub lineBreak{ my $line = q'\par'; $fh->print(\$line); } #--> Creat Table #----------------> sub newtable(){ my(@tableProp, $tableColor, @localData) = @_; my $decl = RTF::Writer::TableRowDecl->new(@tableProp,); $decl->add_bgcolors($tableColor); $fh->row($decl, @$_) for @localData; } #--> Make image #---------------> sub newImage(){ $fh->paragraph( $fh->image( 'filename' => $_[0], ), ); } #--> Inches from twips #----------------------> sub inches{ my ($inches) = @_; my $twips = 1440; $inches = ($inches * $twips); return $inches; } #--> Write text Function #-----------------------> sub writeText(){ my($rtfFormat, $writeText) = @_; $fh->paragraph( \$rtfFormat, # 12pt, bold, italic "$writeText" ); } #--------------------------------------------------------------------- +--------------------------------------------------------------------- +-------# #----------------------------------------------- DO NOT EDIT ANYTHING +BELOW THIS LINE ----------------------------------------------------- +-------# #--------------------------------------------------------------------- +--------------------------------------------------------------------- +-------# BEGIN { no warnings 'redefine'; sub RTF::Writer::close { return unless $_[0][2]; # Already closed?! $_[0]->print(\$_[0][1]) if length $_[0][1]; #$_[0][2]->close(); # Call close directly undef $_[0][2]; # close any objects $_[0][1] = ''; return; } # These are updates to RTF::Writer to allow background colors on # table cells: no warnings 'redefine'; no warnings; # Index 7 was chosen because it is one beyond the last index used by # the standard RTF::Writer::TableRowDecl distribution: my $INDEX_BG = 7; my $INDEX_TS = 8; sub RTF::Writer::TableRowDecl::add_bgcolors { my ($self, @aArg) = @_; my @array; # Install our new list of RTF commands in the object. $self->[$INDEX_BG] = \@array; # See if we got _any_ args: unless (@aArg and grep defined($_), @aArg) { # Default is color 0, which is the document default (probably # 'white' or 'none' or null): @aArg = ('0'); } # unless # Convert arrayref argument to regular array: @aArg = @{$aArg[0]} if ((@aArg == 1) && ref($aArg[0])); foreach my $spec (@aArg) { push @array, "\\clcbpat$spec"; } # foreach # No return value. } # RTF::Writer::TableRowDecl::add_bgcolors sub RTF::Writer::TableRowDecl::add_tabstops { my $self = shift; $self->[$INDEX_TS] = \@_; } # RTF::Writer::TableRowDecl::add_tabstops sub RTF::Writer::TableRowDecl::add_borders { my $self = shift; $self->make_border_decl(@_); } # RTF::Writer::TableRowDecl::add_borders sub RTF::Writer::TableRowDecl::cell_content_init { my $self = shift; my $raAlign = $self->[5] || []; my $raTabs = $self->[$INDEX_TS] || []; my $iMax = @$raAlign; $iMax = @$raTabs if (@$raAlign < @$raTabs); my @aRet; for (1..$iMax) { push @aRet, join('', shift(@$raAlign) || '', shift(@$raTabs) || +''); } # for # print STDERR " cell_content_init is ", Dumper(\@aRet); return @aRet; } # RTF::Writer::TableRowDecl::cell_content_init sub RTF::Writer::TableRowDecl::decl_code { # This function copied from TableRowDecl.pm and 4 lines added (the # 4 lines that contain 'bg'). my $it = shift; return $it->[6] if defined $it->[6]; my $reaches = $it->[0]; my $cell_count = int($_[0] || 0) || scalar @$reaches; if ($cell_count > @$reaches) { # Uncommon case -- we need to ad-hoc pad this decl. $reaches = [@$reaches]; # so we won't mutate the original while (@$reaches < $cell_count) { if (@$reaches == 0) { push @$reaches, $it->[1] + 1440; # sane and noticeable default width, I think: 1 inch, 2.54cm } elsif (@$reaches == 1) { push @$reaches, 2 * $reaches->[0] - $it->[1]; # The left-margin setting } else { push @$reaches, 2 * $reaches->[-1] - $reaches->[-2]; # i.e., last + (last - one_before) # DEBUG and printf "Improvised the width %d based on %d,%d\n +", # $reaches->[-1], $reaches->[-3], $reaches->[-2]; } } # while } # if not enough reaches to fulfill cell_count my @borders = @{ $it->[3] || [] }; push @borders, ($borders[-1]) x ($cell_count - @borders) if @borders > 0 and @borders < $cell_count; my @valign = @{ $it->[4] || [] }; push @valign , ($valign[-1] ) x ($cell_count - @valign ) if @valign > 0 and @valign < $cell_count; # Or should I have it default to a lack of any alignment code? my @bgcolors = @{ $it->[$INDEX_BG] || [] }; push @bgcolors, ($bgcolors[-1]) x ($cell_count - @bgcolors) if @bgcolors > 0 and @bgcolors < $cell_count; # Cache it for next time (and there usually are many next-times): $it->[6] = \join('', sprintf("\\trowd\\trleft%d\\trgaph%d\n", $it->[1], int($it->[2] / 2) ), map ( sprintf("%s%s%s\\cellx%d\n", (shift(@borders ) || ''), (shift(@valign ) || ''), (shift(@bgcolors) || ''), $_, ), # sprintf @$reaches ), # map ); # join # DEBUG and print "Init code:\n", ${ $it->[6] }, "\n\n"; return $it->[6]; } # RTF::Writer::TableRowDecl::decl_code } # end of BEGIN block __END__

Comment on RTF Table function
Select or Download Code
Re: RTF Table function
by andreas1234567 (Vicar) on Aug 29, 2007 at 18:21 UTC
    I believe it is your use of multiple lists as arguments to the RTFTable function that causes this behavior. You cannot use multiple lists as arguments, since Perl does not know where one list ends and another starts. Use references to lists instead. Reading perlref and perlreftut is an excellent start.
    #!/usr/bin/perl use warnings; use strict; use Data::Dumper; use Log::Log4perl qw(:easy); Log::Log4perl->easy_init($DEBUG); my $logger = get_logger(); my @tableProp5 = ( widths => [3*1440, 4*1400], align => 'l l', ); my @myText = ( ['\fs20\b this', 'that'], ['\fs20\b this', 'that'], ['\fs20\b this', 'that'], ['\fs20\b this', 'that'], ); RTFTable(@tableProp5, 9, 7, @myText); sub RTFTable{ my (@tableProps, $headerColor, $bgColor, @Text ) = @_; my $count = 0; my $oDecl5; $logger->debug("tableProps:". Dumper(@tableProps)); $logger->debug("headerColor:". Dumper($headerColor)); $logger->debug("bgColor:". Dumper($bgColor)); $logger->debug("Text:". Dumper(@Text)); } __END__ C:\src\perl\perlmonks\635868>perl 635868.pl 2007/08/29 20:15:44 tableProps:$VAR1 = 'widths'; $VAR2 = [ 4320, 5600 ]; $VAR3 = 'align'; $VAR4 = 'l l'; $VAR5 = 9; $VAR6 = 7; $VAR7 = [ '\\fs20\\b this', 'that' ]; $VAR8 = [ '\\fs20\\b this', 'that' ]; $VAR9 = [ '\\fs20\\b this', 'that' ]; $VAR10 = [ '\\fs20\\b this', 'that' ]; 2007/08/29 20:15:44 headerColor:$VAR1 = undef; 2007/08/29 20:15:44 bgColor:$VAR1 = undef; 2007/08/29 20:15:44 Text:
    As you can see, Perl puts all arguments into the first list. The three last variables headerColor, bgColor, Text are all undefined.
    --
    Andreas
Re: RTF Table function
by ikkon (Monk) on Aug 29, 2007 at 18:37 UTC
    that is exactly the problem, thanks with the help of injunjoel we came up with this that worked well
    my @tableProp5 = ( widths => [inches(3), inches(4)], #--> width of +each column align => 'l l', ); my @myText = ( [\'\fs20\b this', 'that'], [\'\fs20\b this', 'that'], [\'\fs20\b this', 'that'], [\'\fs20\b this', 'that'], ); RTFTable(\@tableProp5, 9, 7,\@myText); $fh->close(); sub RTFTable{ my @tableProps = @{$_[0]}; my $headerColor = $_[1]; my $bgColor = $_[2]; my @Text = @{$_[3]}; my $count = 0; my $oDecl5; foreach my $aref (@Text) { if($headerColor eq undef || $headerColor eq "" || $headerC +olor == 0 || $count == 0){ $oDecl5 = RTF::Writer::TableRowDecl->new(@tableProps); $oDecl5->add_bgcolors($headerColor); # Adds backgroun +d color using color hash $fh->row($oDecl5, @$aref); $count++; }else{ $oDecl5 = RTF::Writer::TableRowDecl->new(@tableProps); $oDecl5->add_bgcolors($bgColor); # Adds background co +lor using color hash $fh->row($oDecl5, @$aref); } } }
    thanks for the help and pointing me in the right direction.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://635868]
Approved by injunjoel
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (7)
As of 2014-07-23 23:32 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (154 votes), past polls