1 rizwank 1.1 # Plugin for TWiki Collaboration Platform, http://TWiki.org/
2 #
3 # Copyright (C) 2001-2003 John Talintyre, jet@cheerful.com
4 # Copyright (C) 2001-2004 Peter Thoeny, peter@thoeny.com
5 #
6 # This program is free software; you can redistribute it and/or
7 # modify it under the terms of the GNU General Public License
8 # as published by the Free Software Foundation; either version 2
9 # of the License, or (at your option) any later version.
10 #
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details, published at
15 # http://www.gnu.org/copyleft/gpl.html
16 #
17 # =========================
18 #
19 #
20 # Allow sorting of tables, plus setting of background colour for headings and data cells
21 # see TWiki.TablePlugin for details of use
22 rizwank 1.1
23
24 # =========================
25 package TWiki::Plugins::TablePlugin;
26
27 use Time::Local;
28
29
30 # =========================
31 use vars qw(
32 $web $topic $user $installWeb $VERSION $debug $translationToken
33 $insideTABLE $tableCount @curTable $sortCol $requestedTable $up
34 $doBody $doAttachments $currTablePre $tableWidth @columnWidths
35 $tableBorder $tableFrame $tableRules $cellPadding $cellSpacing
36 @headerAlign @dataAlign $vAlign
37 $headerBg $headerColor $doSort $twoCol @dataBg @dataColor @isoMonth
38 $headerRows $footerRows
39 @fields $upchar $downchar $diamondchar $url $curTablePre
40 @isoMonth %mon2num $initSort $initDirection $pluginAttrs $prefsAttrs
41 @rowspan
42 );
43 rizwank 1.1
44 $VERSION = '1.013'; # 01 Aug 2004
45 $translationToken = "\0";
46 $currTablePre = "";
47 $upchar = "";
48 $downchar = "";
49 $diamondchar = "";
50 @isoMonth = ( "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" );
51 { my $count = 0;
52 %mon2num = map { $_ => $count++ } @isoMonth;
53 }
54 @fields = ( "text", "attributes", "th td X", "numbers", "dates" );
55 # X means a spanned cell
56
57 # =========================
58 sub initPlugin
59 {
60 ( $topic, $web, $user, $installWeb ) = @_;
61
62 # check for Plugins.pm versions
63 if( $TWiki::Plugins::VERSION < 1 ) {
64 rizwank 1.1 &TWiki::Func::writeWarning( "Version mismatch between TablePlugin and Plugins.pm" );
65 return 0;
66 }
67
68 # Get plugin debug flag
69 $debug = &TWiki::Func::getPreferencesFlag( "TABLEPLUGIN_DEBUG" );
70
71 $insideTABLE = 0;
72 $tableCount = 0;
73
74 $twoCol = 1;
75
76 my $cgi = &TWiki::Func::getCgiQuery();
77 if( ! $cgi ) {
78 return 0;
79 }
80
81 my $plist = $cgi->query_string();
82 $plist =~ s/\;/\&/go;
83 $plist =~ s/\&?sortcol.*up=[0-9]+\&?//go;
84 $plist .= "\&" if $plist;
85 rizwank 1.1 $url = $cgi->url . $cgi->path_info() . "?" . $plist;
86 $url =~ s/\&/\&/go;
87
88 $sortCol = $cgi->param( 'sortcol' );
89 $requestedTable = $cgi->param( 'table' );
90 $up = $cgi->param( 'up' );
91
92 $doBody = 0;
93 $doAttachments = 0;
94 my $tmp = &TWiki::Func::getPreferencesValue( "TABLEPLUGIN_SORT" );
95 if( ! $tmp || $tmp =~ /^all$/oi ) {
96 $doBody = 1;
97 $doAttachments = 1;
98 } elsif( $tmp =~ /^attachments$/oi ) {
99 $doAttachments =1;
100 }
101
102 $pluginAttrs = TWiki::Func::getPreferencesValue( "TABLEPLUGIN_TABLEATTRIBUTES" );
103 $prefsAttrs = TWiki::Func::getPreferencesValue( "TABLEATTRIBUTES" );
104 setDefaults();
105
106 rizwank 1.1 # Plugin correctly initialized
107 &TWiki::Func::writeDebug( "- TWiki::Plugins::TablePlugin::initPlugin( $web.$topic ) is OK" ) if $debug;
108 return 1;
109 }
110
111 # =========================
112 sub outsidePREHandler
113 {
114 ### my ( $text ) = @_; # do not uncomment, use $_[0] instead
115
116 #&TWiki::Func::writeDebug( "- TablePlugin::outsidePREHandler( $web.$topic )" ) if $debug;
117
118 # Table of format: | cell | cell |
119 # PTh 25 Jan 2001: Forgiving syntax, allow trailing white space
120 $_[0] =~ s/%TABLE{(.*)}%/handleTableAttrs($1)/eo;
121 if( $_[0] =~ /^(\s*)\|.*\|\s*$/ ) {
122 $_[0] =~ s/^(\s*)\|(.*)/&processTR($1,$2)/eo;
123 $insideTABLE = 1;
124 } elsif( $insideTABLE ) {
125 $_[0] = &emitTable() . "$_[0]";
126 $insideTABLE = 0;
127 rizwank 1.1 undef $initSort;
128 }
129
130 # This handler is called by getRenderedVersion, in loop outside of <PRE> tag.
131 # This is the place to define customized rendering rules.
132 # Note: This is an expensive function to comment out.
133 # Consider startRenderingHandler instead
134 }
135
136 # =========================
137 sub endRenderingHandler
138 {
139 ### my ( $text ) = @_; # do not uncomment, use $_[0] instead
140
141 #&TWiki::Func::writeDebug( "- TablePlugin::endRenderingHandler( $web.$topic )" ) if $debug;
142
143 # This handler is called by getRenderedVersion just after the line loop
144 if( $insideTABLE ) {
145 $_[0] .= emitTable();
146 $insideTABLE = 0;
147 undef $initSort;
148 rizwank 1.1 }
149 if( $_[0] =~/tablepluginfixlinkcolor/ ) {
150 $_[0] =~ s/(<font )tablepluginfixlinkcolor.*?(color=\")([^\"]*)(\">.*?<\/font>)/&fixLinkColor("$1$2$3$4",$3)/geo;
151 }
152 }
153
154 # =========================
155 sub setDefaults
156 {
157 $doSort = $doBody;
158 $tableBorder = 1;
159 $tableFrame = "";
160 $tableRules = "";
161 $cellSpacing = 1;
162 $cellPadding = 0;
163 $tableWidth = "";
164 @columnWidths = ( );
165 $headerRows = 1;
166 $footerRows = 0;
167 @headerAlign = ( );
168 @dataAlign = ( );
169 rizwank 1.1 $vAlign = "";
170 $headerBg = "#99CCCC";
171 $headerColor = "";
172 @dataBg = ( "#FFFFCC", "#FFFFFF" );
173 @dataColor = ( );
174 undef $initSort;
175
176 handleTableAttrs( $pluginAttrs ); # Plugin setting
177 handleTableAttrs( $prefsAttrs ); # Preferences setting
178 }
179
180 # =========================
181 # Table attributes defined as a Plugin setting, a preferences setting
182 # e.g. in WebPreferences or as a %TABLE{...}% setting
183 sub handleTableAttrs
184 {
185 my( $args ) = @_;
186
187 return "" if( $args =~/^\s*$/ );
188
189 #Defines which column to initially sort : ShawnBradford 20020221
190 rizwank 1.1 my $tmp = TWiki::Func::extractNameValuePair( $args, "initsort" );
191 $initSort = $tmp if ( $tmp );
192
193 #Defines which direction to sort the column set by initsort : ShawnBradford 20020221
194 $tmp = TWiki::Func::extractNameValuePair( $args, "initdirection" );
195 $initDirection = 0 if( $tmp =~/^down$/i );
196 $initDirection = 1 if( $tmp =~/^up$/i );
197
198 $tmp = TWiki::Func::extractNameValuePair( $args, "sort" );
199 $tmp = "0" if( $tmp =~ /^off$/oi );
200 $doSort = $tmp if( $tmp ne "" );
201
202 $tmp = TWiki::Func::extractNameValuePair( $args, "tableborder" );
203 $tableBorder = $tmp if( $tmp ne "" );
204
205 $tmp = TWiki::Func::extractNameValuePair( $args, "tableframe" );
206 $tableFrame = $tmp if( $tmp ne "" );
207
208 $tmp = TWiki::Func::extractNameValuePair( $args, "tablerules" );
209 $tableRules = $tmp if( $tmp ne "" );
210
211 rizwank 1.1 $tmp = TWiki::Func::extractNameValuePair( $args, "cellpadding" );
212 $cellPadding = $tmp if( $tmp ne "" );
213
214 $tmp = TWiki::Func::extractNameValuePair( $args, "cellspacing" );
215 $cellSpacing = $tmp if( $tmp ne "" );
216
217 $tmp = TWiki::Func::extractNameValuePair( $args, "headeralign" );
218 @headerAlign = split( /,\s*/, $tmp ) if( $tmp );
219
220 $tmp = TWiki::Func::extractNameValuePair( $args, "dataalign" );
221 @dataAlign = split( /,\s*/, $tmp ) if( $tmp );
222
223 $tmp = TWiki::Func::extractNameValuePair( $args, "tablewidth" );
224 $tableWidth = $tmp if( $tmp );
225
226 $tmp = TWiki::Func::extractNameValuePair( $args, "columnwidths" );
227 @columnWidths = split ( /, */, $tmp ) if( $tmp );
228
229 $tmp = TWiki::Func::extractNameValuePair( $args, "headerrows" );
230 $headerRows = $tmp if( $tmp ne "" );
231 $headerRows = 1 if( $headerRows < 1 );
232 rizwank 1.1
233 $tmp = TWiki::Func::extractNameValuePair( $args, "footerrows" );
234 $footerRows = $tmp if( $tmp ne "" );
235
236 $tmp = TWiki::Func::extractNameValuePair( $args, "valign" );
237 $vAlign = $tmp if( $tmp );
238
239 $tmp = TWiki::Func::extractNameValuePair( $args, "headerbg" );
240 $headerBg = $tmp if( $tmp );
241
242 $tmp = TWiki::Func::extractNameValuePair( $args, "headercolor" );
243 $headerColor = $tmp if( $tmp );
244
245 $tmp = TWiki::Func::extractNameValuePair( $args, "databg" );
246 @dataBg = split( /,\s*/, $tmp ) if( $tmp );
247
248 $tmp = TWiki::Func::extractNameValuePair( $args, "datacolor" );
249 @dataColor = split( /,\s*/, $tmp ) if( $tmp );
250
251 return "$currTablePre<nop>";
252 }
253 rizwank 1.1
254 # =========================
255 # Convert text to number and date if possible
256 sub getTypes
257 {
258 my( $text ) = @_;
259
260 $text =~ s/ / /go;
261
262 my $num = undef;
263 my $date = undef;
264 if( $text =~ /^\s*$/ ) {
265 $num = 0;
266 $date = 0;
267 }
268
269 if( $text =~ m|^\s*([0-9]{1,2})[-\s/]*([A-Z][a-z][a-z])[-\s/]*([0-9]{4})\s*-\s*([0-9][0-9]):([0-9][0-9])| ) {
270 # "31 Dec 2003 - 23:59", "31-Dec-2003 - 23:59", "31 Dec 2003 - 23:59 - any suffix"
271 $date = timegm(0, $5, $4, $1, $mon2num{$2}, $3 - 1900);
272 } elsif( $text =~ m|^\s*([0-9]{1,2})[-\s/]([A-Z][a-z][a-z])[-\s/]([0-9]{2,4})\s*$| ) {
273 # "31 Dec 2003", "31 Dec 03", "31-Dec-2003", "31/Dec/2003"
274 rizwank 1.1 my $year = $3;
275 $year += 1900 if( length( $year ) == 2 && $year > 80 );
276 $year += 2000 if( length( $year ) == 2 );
277 $date = timegm( 0, 0, 0, $1, $mon2num{$2}, $year - 1900 );
278 } elsif ( $text =~ /^\s*[0-9]+(\.[0-9]+)?\s*$/ ) {
279 $num = $text;
280 }
281
282 return( $num, $date );
283 }
284
285 # =========================
286 sub processTR {
287 my ( $thePre, $theRow ) = @_;
288
289 $currTablePre = $thePre || "";
290 my $attr = "";
291 my $span = 0;
292 my $l1 = 0;
293 my $l2 = 0;
294 if( ! $insideTABLE ) {
295 rizwank 1.1 @curTable = ();
296 @rowspan = ();
297 $tableCount++;
298 }
299 $theRow =~ s/\t/ /go; # change tabs to space
300 $theRow =~ s/\s*$//o; # remove trailing spaces
301 $theRow =~ s/(\|\|+)/$translationToken . length($1) . "\|"/geo; # calc COLSPAN
302 my $colCount = 0;
303 my @row = ();
304 $span = 0;
305 my $value = "";
306 foreach( split( /\|/, $theRow ) ) {
307 $colCount++;
308 $attr = "";
309 $span = 1;
310 #AS 25-5-01 Fix to avoid matching also single columns
311 if ( s/$translationToken([0-9]+)// ) {
312 $span = $1;
313 $attr = " colspan=\"$span\"" ;
314 }
315 s/^\s+$/ /o;
316 rizwank 1.1 /^(\s*).*?(\s*)$/;
317 $l1 = length( $1 || "" );
318 $l2 = length( $2 || "" );
319 if( $l1 >= 2 ) {
320 if( $l2 <= 1 ) {
321 $attr .= ' align="right"';
322 } else {
323 $attr .= ' align="center"';
324 }
325 }
326 if( defined $columnWidths[$colCount-1] && $columnWidths[$colCount-1] && $span <= 2 ) {
327 $attr .= ' width="' . $columnWidths[$colCount-1] . '"';
328 }
329 if( /^\s*\^\s*$/ ) { # row span above
330 $rowspan[$colCount-1]++;
331 push @row, [ $value, "", "X" ];
332 } else {
333 for (my $col = $colCount-1; $col < ($colCount+$span-1); $col++) {
334 if( defined($rowspan[$col]) && $rowspan[$col] ) {
335 my $nRows = scalar(@curTable);
336 my $rspan = $rowspan[$col]+1;
337 rizwank 1.1 $curTable[$nRows-$rspan][$col][1] .= " rowspan=\"$rspan\"";
338 undef($rowspan[$col]);
339 }
340 }
341 if( /^\s*\*(.*)\*\s*$/ ) {
342 $value = $1;
343 if( @headerAlign ) {
344 my $align = @headerAlign[($colCount - 1) % ($#headerAlign + 1) ];
345 $attr .= " align=\"$align\""; # override $attr
346 }
347
348 $attr .= " valign=\"$vAlign\"" if $vAlign;
349 $attr .= " class=\"twikiFirstCol\"" if $colCount == 1;
350 push @row, [ $value, "$attr", "th" ];
351 } else {
352 if( /^\s*(.*?)\s*$/ ) { # strip white spaces
353 $_ = $1;
354 }
355 $value = $_;
356 if( @dataAlign ) {
357 my $align = @dataAlign[($colCount - 1) % ($#dataAlign + 1) ];
358 rizwank 1.1 $attr .= " align=\"$align\""; # override $attr
359 }
360 $attr .= " valign=\"$vAlign\"" if $vAlign;
361 $attr .= " class=\"twikiFirstCol\"" if $colCount == 1;
362 push @row, [ $value, "$attr", "td" ];
363 }
364 }
365 while( $span > 1 ) {
366 push @row, [ $value, "", "X" ];
367 $colCount++;
368 $span--;
369 }
370 }
371 push @curTable, \@row;
372 return "$currTablePre<nop>"; # Avoid TWiki converting empty lines to new paras
373 }
374
375 # =========================
376 # Do sort?
377 sub doIt
378 {
379 rizwank 1.1 my( $header ) = @_;
380
381 # Attachments table?
382 if( $header->[0]->[0] =~ /FileAttachment/ ) {
383 return $doAttachments;
384 }
385
386 my $doIt = $doSort;
387 if( $doSort ) {
388 # All cells in header are headings?
389 foreach my $cell ( @$header ) {
390 if( $cell->[2] ne "th" ) {
391 $doIt = 0;
392 last;
393 }
394 }
395 }
396
397 return $doIt;
398 }
399
400 rizwank 1.1 # =========================
401 # Is a colum a date (4), number (3) or text (0)?
402 sub colType
403 {
404 my( $col ) = @_;
405 my $isDate = 1;
406 my $isNum = 1;
407 my $num = "";
408 my $date = "";
409 foreach my $row ( @curTable ) {
410 ( $num, $date ) = getTypes( $row->[$col]->[0] );
411 $isDate = 0 if( ! defined( $date ) );
412 $isNum = 0 if( ! defined( $num ) );
413 last if( !$isDate && !$isNum );
414 $row->[$col]->[4] = $date;
415 $row->[$col]->[3] = $num;
416 }
417
418 if( $isDate ) {
419 return 4;
420 } elsif( $isNum ) {
421 rizwank 1.1 return 3;
422 } else {
423 return 0;
424 }
425 }
426
427
428 # =========================
429 sub stripHtml
430 {
431 my( $text ) = @_;
432 $text =~ s/\ / /go; # convert space
433 $text =~ s/\[\[[^\]]+\]\[([^\]]+)\]\]/$1/go; # extract label from [[...][...]] link
434 $text =~ s/<[^>]+>//go; # strip HTML
435 $text =~ s/^ *//go; # strip leading space space
436 $text = lc( $text ); # convert to lower case
437 return $text;
438 }
439
440 # =========================
441 sub emitTable
442 rizwank 1.1 {
443 #Validate headerrows/footerrows and modify if out of range
444 if ( $headerRows > @curTable ) {
445 $headerRows = @curTable; # limit header to size of table!
446 }
447 if ( $headerRows + $footerRows > @curTable ) {
448 $footerRows = @curTable - $headerRows; # and footer to whatever is left
449 }
450 my $direction = $up ? 0 : 1;
451 my $doIt = doIt( $curTable[$headerRows-1] );
452 my $text = "$currTablePre<table border=\"$tableBorder\"";
453 $text .= " frame=\"$tableFrame\"" if( $tableFrame );
454 $text .= " cellspacing=\"$cellSpacing\" cellpadding=\"$cellPadding\"";
455 $text .= " rules=\"$tableRules\"" if( $tableRules );
456 $text .= " width=\"$tableWidth\"" if( $tableWidth );
457 $text .= ">\n";
458 my $type = "";
459 my $attr = "";
460 my $stype = "";
461
462 #Flush out any remaining rowspans
463 rizwank 1.1 for (my $i = 0; $i < @rowspan; $i++) {
464 if( defined($rowspan[$i]) && $rowspan[$i] ) {
465 my $nRows = scalar(@curTable);
466 my $rspan = $rowspan[$i]+1;
467 my $row = $nRows - $rspan;
468 $curTable[$row][$i][1] .= " rowspan=\"$rspan\"";
469 }
470 }
471
472 #Added to aid initial sorting direction and column : ShawnBradford 20020221
473 if ( defined( $sortCol ) ) {
474 undef $initSort;
475 } elsif( defined( $initSort ) ) {
476 $sortCol = $initSort - 1;
477 $up = $initDirection;
478 $direction = $up ? 0 : 1;
479 $requestedTable = $tableCount;
480 }
481
482 if( ( (defined( $sortCol ) && defined( $requestedTable ) && $requestedTable eq $tableCount ) )
483 || ( defined( $initSort ) ) ) {
484 rizwank 1.1
485 # DG 08 Aug 2002: Allow multi-line headers
486 my @header = splice( @curTable, 0, $headerRows );
487 # DG 08 Aug 2002: Skip sorting any trailers as well
488 my @trailer = ();
489 if ( $footerRows && scalar( @curTable ) > $footerRows ) {
490 @trailer = splice( @curTable, -$footerRows );
491 }
492
493 $stype = colType( $sortCol );
494 &TWiki::Func::writeDebug( "- TWiki::Plugins::TablePlugin sorting col $sortCol as $fields[$stype]" ) if $debug;
495 if( $stype ) {
496 if( $up ) {
497 @curTable = sort { $b->[$sortCol]->[$stype] <=> $a->[$sortCol]->[$stype] } @curTable;
498 } else {
499 @curTable = sort { $a->[$sortCol]->[$stype] <=> $b->[$sortCol]->[$stype] } @curTable;
500 }
501
502 } else {
503 if( $up ) {
504 # efficient way of sorting stripped HTML text
505 rizwank 1.1 @curTable = map { $_->[0] }
506 sort { $b->[1] cmp $a->[1] }
507 map { [ $_, stripHtml( $_->[$sortCol]->[0] ) ] } @curTable;
508 } else {
509 @curTable = map { $_->[0] }
510 sort { $a->[1] cmp $b->[1] }
511 map { [ $_, stripHtml( $_->[$sortCol]->[0] ) ] } @curTable;
512 }
513 }
514 # DG 08 Aug 2002: Cleanup after the header/trailer splicing
515 # this is probably awfully inefficient - but how big is a table?
516 @curTable = ( @header, @curTable, @trailer );
517 }
518 my $rowCount = 0;
519 my $dataColorCount = 0;
520 my $resetCountNeeded = 0;
521 my $arrow = "";
522 my $color = "";
523 foreach my $row ( @curTable ) {
524 $text .= "$currTablePre<tr>";
525 my $colCount = 0;
526 rizwank 1.1 foreach my $fcell ( @$row ) {
527 $arrow = "";
528 next if( $fcell->[2] eq "X" ); # data was there so sort could work with col spanning
529 $type = $fcell->[2];
530 my $cell = $fcell->[0];
531 my $attr = $fcell->[1];
532 if( $type eq "th" ) {
533 # reset data color count to start with first color after each table heading
534 $dataColorCount = 0 if( $resetCountNeeded );
535 $resetCountNeeded = 0;
536 if( ! $upchar ) {
537 # Added arrow images for up and down S. Bradford 20011018
538 # PTh 13 Nov 2001: Modfied and moved to TablePlugin attachment
539 $upchar = "<img src=\"%PUBURL%/$installWeb/TablePlugin/up.gif\""
540 . " alt=\"up\" />";
541 $upchar = &TWiki::Func::expandCommonVariables( $upchar, $topic );
542 $downchar = "<img src=\"%PUBURL%/$installWeb/TablePlugin/down.gif\""
543 . " alt=\"down\" />";
544 $downchar = &TWiki::Func::expandCommonVariables( $downchar, $topic );
545 $diamondchar = "<img src=\"%PUBURL%/$installWeb/TablePlugin/diamond.gif\""
546 . " border=\"0\" alt=\"sort\" />";
547 rizwank 1.1 $diamondchar = &TWiki::Func::expandCommonVariables( $diamondchar, $topic );
548 }
549
550 # DG: allow headers without b.g too (consistent and yes, I use this)
551 $attr .= " bgcolor=\"$headerBg\"" unless( $headerBg =~ /none/i );
552 my $dir = 0;
553 $dir = $direction if( defined( $sortCol ) && $colCount == $sortCol );
554 if( defined( $sortCol ) && $colCount == $sortCol && $stype ne "" ) {
555 $arrow = "<a name=\"sorted_table\"><span title=\"$fields[$stype] ";
556 if( $dir == 0 ) {
557 $arrow .= "sorted ascending\">$upchar</span></a>";
558 $attr .= " class=\"twikiSortedAscendingCol\"";
559 } else {
560 $arrow .= "sorted descending\">$downchar</span></a>";
561 $attr .= " class=\"twikiSortedDescendingCol\"";
562 }
563 }
564 $color = "";
565 $color = "<font tablepluginfixlinkcolor=\"on\" color=\"$headerColor\">" if( $headerColor );
566 if( $doIt && $rowCount == $headerRows - 1 ) {
567 if( $cell =~ /\[\[|href/o ) {
568 rizwank 1.1 $cell = "$color $cell</font>" if( $color );
569 $cell .= " <a href=\"" . $url
570 . "sortcol=$colCount&table=$tableCount&up=$dir#sorted_table\" "
571 . "title=\"Sort by this column\">$diamondchar</a>$arrow";
572 } else {
573 $cell = "<a href=\"" . $url
574 . "sortcol=$colCount&table=$tableCount&up=$dir#sorted_table\" "
575 . "title=\"Sort by this column\">$color $cell";
576 $cell .= "</font>" if( $color );
577 $cell .= "</a> $arrow";
578 }
579 } else {
580 $cell = " *$color$cell";
581 $cell .= "</font>" if( $color );
582 $cell .= "* ";
583 }
584
585 } else {
586 $resetCountNeeded = 1 if( $colCount == 0 );
587 if( @dataBg ) {
588 $color = $dataBg[$dataColorCount % ($#dataBg + 1) ];
589 rizwank 1.1 $attr .= " bgcolor=\"$color\"" unless( $color =~ /none/i );
590 }
591 $color = "";
592 if( @dataColor ) {
593 $color = $dataColor[$dataColorCount % ($#dataColor + 1) ];
594 if( $color =~ /^(|none)$/i ) {
595 $color = "";
596 } else {
597 $color = "<font color=\"$color\">";
598 }
599 }
600 $cell = "$color $cell ";
601 $cell .= "</font>" if( $color );
602 }
603 $text .= "<$type$attr>$cell";
604 $text .= "</$type>";
605 $colCount++;
606 }
607 $text .= "</tr>\n";
608 $rowCount++;
609 $dataColorCount++;
610 rizwank 1.1 }
611 $text .= "$currTablePre</table>\n";
612 setDefaults();
613 return $text;
614 }
615
616 # =========================
617 sub fixLinkColor
618 {
619 my( $text, $color ) = @_;
620 # Hack to solve color problem of links produced after table rendering
621 $color = "<font color=\"$color\">";
622 $text =~ s|(<a href=\".*?\">)(.*?)(</a>)|</font>$1$color$2</font>$3$color|go;
623 $text =~ s|$color\s*</font>||go;
624 return $text;
625 }
626
627 # =========================
628 1;
|