1package HTML::Table; 2use strict; 3use warnings; 4 5use vars qw($VERSION $AUTOLOAD); 6$VERSION = '2.08_1'; 7 8use overload '""' => \&getTable, 9 fallback => undef; 10 11=head1 NAME 12 13HTML::Table - produces HTML tables 14 15=head1 SYNOPSIS 16 17 use HTML::Table; 18 19 $table1 = new HTML::Table($rows, $cols); 20 or 21 $table1 = new HTML::Table(-rows=>26, 22 -cols=>2, 23 -align=>'center', 24 -rules=>'rows', 25 -border=>0, 26 -bgcolor=>'blue', 27 -width=>'50%', 28 -spacing=>0, 29 -padding=>0, 30 -style=>'color: blue', 31 -class=>'myclass', 32 -evenrowclass=>'even', 33 -oddrowclass=>'odd', 34 -head=> ['head1', 'head2'], 35 -data=> [ ['1:1', '1:2'], ['2:1', '2:2'] ] ); 36 or 37 $table1 = new HTML::Table( [ ['1:1', '1:2'], ['2:1', '2:2'] ] ); 38 39 $table1->setCell($cellrow, $cellcol, 'This is Cell 1'); 40 $table1->setCellBGColor('blue'); 41 $table1->setCellColSpan(1, 1, 2); 42 $table1->setRowHead(1); 43 $table1->setColHead(1); 44 45 $table1->print; 46 47 $table2 = new HTML::Table; 48 $table2->addRow(@cell_values); 49 $table2->addCol(@cell_values2); 50 51 $table1->setCell(1,1, "$table2->getTable"); 52 $table1->print; 53 54=head1 REQUIRES 55 56Perl5.002 57 58=head1 EXPORTS 59 60Nothing 61 62=head1 DESCRIPTION 63 64HTML::Table is used to generate HTML tables for 65CGI scripts. By using the methods provided fairly 66complex tables can be created, manipulated, then printed 67from Perl scripts. The module also greatly simplifies 68creating tables within tables from Perl. It is possible 69to create an entire table using the methods provided and 70never use an HTML tag. 71 72HTML::Table also allows for creating dynamically sized 73tables via its addRow and addCol methods. These methods 74automatically resize the table if passed more cell values 75than will fit in the current table grid. 76 77Methods are provided for nearly all valid table, row, and 78cell tags specified for HTML 3.0. 79 80A Japanese translation of the documentation is available at: 81 82 http://member.nifty.ne.jp/hippo2000/perltips/html/table.htm 83 84 85=head1 METHODS 86 87 [] indicate optional parameters. default value will 88 be used if no value is specified 89 90 row_num indicates that a row number is required. 91 Rows are numbered from 1. To refer to the last row use the value -1. 92 93 col_num indicates that a col number is required. 94 Cols are numbered from 1. To refer to the last col use the value -1. 95 96 97=head2 Sections 98 99=over 4 100 101From version 2.07 onwards HTML::Table supports table sections (THEAD, TFOOT & TBODY). 102 103Each section can have its own attributes (id, class, etc) set, and will contain 1 or more 104rows. Section numbering starts at 0, only tbody is allowed to have more than one section. 105 106Methods for manipultaing sections and their data are available and have the general form: 107 108 setSectionCell ( section, section_num, row_num, col_num, data ); 109 110 For example, the following adds a row to the first body section: 111 112 addSectionRow ( 'tbody', 0, "Cell 1", "Cell 2", "Cell 3" ); 113 114For backwards compatibility, methods with Section in their name will default to manipulating 115the first body section. 116 117 For example, the following sets the class for the first row in the 118 first body section: 119 120 setRowClass ( 1, 'row_class' ); 121 122 Which is semantically equivalent to: 123 124 setSectionRowClass ( 'tbody', 0, 1, 'row_class' ); 125 126=back 127 128=head2 Creation 129 130=over 4 131 132=item new HTML::Table([num_rows, num_cols]) 133 134Creates a new HTML table object. If rows and columns 135are specified, the table will be initialized to that 136size. Row and Column numbers start at 1,1. 0,0 is 137considered an empty table. 138 139=item new HTML::Table([-rows=>num_rows, 140 -cols=>num_cols, 141 -border=>border_width, 142 -align=>table_alignment, 143 -style=>table_style, 144 -class=>table_class, 145 -evenrowclass=>'even', 146 -oddrowclass=>'odd', 147 -bgcolor=>back_colour, 148 -width=>table_width, 149 -spacing=>cell_spacing, 150 -padding=>cell_padding]) 151 152Creates a new HTML table object. If rows and columns 153are specified, the table will be initialized to that 154size. Row and Column numbers start at 1,1. 0,0 is 155considered an empty table. 156 157If evenrowclass or oddrowclass is specified, these 158classes will be applied to even and odd rows, 159respectively, unless those rows have a specific class 160applied to it. 161 162=back 163 164=head2 Table Level Methods 165 166=over 4 167 168=item setBorder([pixels]) 169 170Sets the table Border Width 171 172=item setWidth([pixels|percentofscreen]) 173 174Sets the table width 175 176 $table->setWidth(500); 177 or 178 $table->setWidth('100%'); 179 180=item setCellSpacing([pixels]) 181 182=item setCellPadding([pixels]) 183 184=item setCaption("CaptionText" [, top|bottom]) 185 186=item setBGColor([colorname|colortriplet]) 187 188=item autoGrow([1|true|on|anything|0|false|off|no|disable]) 189 190Switches on (default) or off automatic growing of the table 191if row or column values passed to setCell exceed current 192table size. 193 194=item setAlign ( [ left , center , right ] ) 195 196=item setRules ( [ rows , cols , all, both , groups ] ) 197 198=item setStyle ( 'css style' ) 199 200Sets the table style attribute. 201 202=item setClass ( 'css class' ) 203 204Sets the table class attribute. 205 206=item setEvenRowClass ( 'css class' ) 207 208Sets the class attribute of even rows in the table. 209 210=item setOddRowClass ( 'css class' ) 211 212Sets the class attribute of odd rows in the table. 213 214=item setAttr ( 'user attribute' ) 215 216Sets a user defined attribute for the table. Useful for when 217HTML::Table hasn't implemented a particular attribute yet 218 219=item sort ( [sort_col_num, sort_type, sort_order, num_rows_to_skip] ) 220 221 or 222 sort( -sort_col => sort_col_num, 223 -sort_type => sort_type, 224 -sort_order => sort_order, 225 -skip_rows => num_rows_to_skip, 226 -strip_html => strip_html, 227 -strip_non_numeric => strip_non_numeric, 228 -presort_func => \&filter_func ) 229 230 sort_type in { ALPHA | NUMERIC }, 231 sort_order in { ASC | DESC }, 232 strip_html in { 0 | 1 }, defaults to 1, 233 strip_non_numeric in { 0 | 1 }, defaults to 1 234 235 Sort all rows on a given column (optionally skipping table header rows 236 by specifiying num_rows_to_skip). 237 238 By default sorting ignores HTML Tags and  , setting the strip_html parameter to 0 239 disables this behaviour. 240 241 By default numeric Sorting ignores non numeric chararacters, setting the strip_non_numeric 242 parameter to 0 disables this behaviour. 243 244 You can provide your own pre-sort function, useful for pre-processing the cell contents 245 before sorting for example dates. 246 247 248=item getTableRows 249 250Returns the number of rows in the table. 251 252=item getTableCols 253 254Returns the number of columns in the table. 255 256=item getStyle 257 258Returns the table's style attribute. 259 260=back 261 262=head2 Section Level Methods 263 264=over 4 265 266=item setSectionId ( [tbody|thead|tfoot], section_num, 'id' ) 267 268Sets the id attribute for the section. 269 270=item setSectionClass ( [tbody|thead|tfoot], section_num, 'class' ) 271 272Sets the class attribute for the section. 273 274=item setSectionStyle ( [tbody|thead|tfoot], section_num, 'style' ) 275 276Sets the style attribute for the section. 277 278=item setSectionAlign ( [tbody|thead|tfoot], section_num, [center|right|left] ) 279 280Sets the horizontal alignment for the section. 281 282=item setSectionValign ( [tbody|thead|tfoot], section_num, [center|top|bottom|middle|baseline] ) 283 284Sets the vertical alignment for the section. 285 286=item setSectionAttr ( [tbody|thead|tfoot], section_num, 'user attribute' ) 287 288Sets a user defined attribute for the cell. Useful for when 289HTML::Table hasn't implemented a particular attribute yet 290 291=back 292 293=head2 Cell Level Methods 294 295=over 4 296 297=item setCell(row_num, col_num, "content") 298 299Sets the content of a table cell. This could be any 300string, even another table object via the getTable method. 301If the row and/or column numbers are outside the existing table 302boundaries extra rows and/or columns are created automatically. 303 304=item setSectionCell([tbody|thead|tfoot], section_num, row_num, col_num, "content") 305 306Same as setCell, but able to specify which section to act on. 307 308=item setCellAlign(row_num, col_num, [center|right|left]) 309 310Sets the horizontal alignment for the cell. 311 312=item setSectionCellAlign([tbody|thead|tfoot], section_num, row_num, col_num, [center|right|left]) 313 314Same as setCellAlign, but able to specify which section to act on. 315 316=item setCellVAlign(row_num, col_num, [center|top|bottom|middle|baseline]) 317 318Sets the vertical alignment for the cell. 319 320=item setSectionCellVAlign([tbody|thead|tfoot], section_num, row_num, col_num, [center|top|bottom|middle|baseline]) 321 322Same as setCellVAlign, but able to specify which section to act on. 323 324=item setCellWidth(row_num, col_num, [pixels|percentoftable]) 325 326Sets the width of the cell. 327 328=item setSectionCellWidth([tbody|thead|tfoot], section_num, row_num, col_num, [pixels|percentoftable]) 329 330Same as setCellWidth, but able to specify which section to act on. 331 332=item setCellHeight(row_num, col_num, [pixels]) 333 334Sets the height of the cell. 335 336=item setSectionCellHeight([tbody|thead|tfoot], section_num, row_num, col_num, [pixels]) 337 338Same as setCellHeight, but able to specify which section to act on. 339 340=item setCellHead(row_num, col_num, [0|1]) 341 342Sets cell to be of type head (Ie <th></th>) 343 344=item setSectionCellHead([tbody|thead|tfoot], section_num, row_num, col_num, [0|1]) 345 346Same as setCellHead, but able to specify which section to act on. 347 348=item setCellNoWrap(row_num, col_num, [0|1]) 349 350Sets the NoWrap attribute of the cell. 351 352=item setSectionCellNoWrap([tbody|thead|tfoot], section_num, row_num, col_num, [0|1]) 353 354Same as setCellNoWrap, but able to specify which section to act on. 355 356=item setCellBGColor(row_num, col_num, [colorname|colortriplet]) 357 358Sets the background colour for the cell. 359 360=item setSectionCellBGColor([tbody|thead|tfoot], section_num, row_num, col_num, [colorname|colortriplet]) 361 362Same as setCellBGColor, but able to specify which section to act on. 363 364=item setCellRowSpan(row_num, col_num, num_cells) 365 366Causes the cell to overlap a number of cells below it. 367If the overlap number is greater than number of cells 368below the cell, a false value will be returned. 369 370=item setSectionCellRowSpan([tbody|thead|tfoot], section_num, row_num, col_num, num_cells) 371 372Same as setCellRowSpan, but able to specify which section to act on. 373 374=item setCellColSpan(row_num, col_num, num_cells) 375 376Causes the cell to overlap a number of cells to the right. 377If the overlap number is greater than number of cells to 378the right of the cell, a false value will be returned. 379 380=item setSectionCellColSpan([tbody|thead|tfoot], section_num, row_num, col_num, num_cells) 381 382Same as setCellColSpan, but able to specify which section to act on. 383 384=item setCellSpan(row_num, col_num, num_rows, num_cols) 385 386Joins the block of cells with the starting cell specified. 387The joined area will be num_cols wide and num_rows deep. 388 389=item setSectionCellSpan([tbody|thead|tfoot], section_num, row_num, col_num, num_rows, num_cols) 390 391Same as setCellSpan, but able to specify which section to act on. 392 393=item setCellFormat(row_num, col_num, start_string, end_string) 394 395Start_string should be a string of valid HTML, which is output before 396the cell contents, end_string is valid HTML that is output after the cell contents. 397This enables formatting to be applied to the cell contents. 398 399 $table->setCellFormat(1, 2, '<b>', '</b>'); 400 401=item setSectionCellFormat([tbody|thead|tfoot], section_num, row_num, col_num, start_string, end_string) 402 403Same as setCellFormat, but able to specify which section to act on. 404 405=item setCellStyle (row_num, col_num, 'css style') 406 407Sets the cell style attribute. 408 409=item setSectionCellStyle([tbody|thead|tfoot], section_num, row_num, col_num, 'css style') 410 411Same as setCellStyle, but able to specify which section to act on. 412 413=item setCellClass (row_num, col_num, 'css class') 414 415Sets the cell class attribute. 416 417=item setSectionCellClass([tbody|thead|tfoot], section_num, row_num, col_num, 'css class') 418 419Same as setCellClass, but able to specify which section to act on. 420 421=item setCellAttr (row_num, col_num, 'user attribute') 422 423Sets a user defined attribute for the cell. Useful for when 424HTML::Table hasn't implemented a particular attribute yet 425 426=item setSectionCellAttr([tbody|thead|tfoot], section_num, row_num, col_num, 'css class') 427 428Same as setCellAttr, but able to specify which section to act on. 429 430=item setLastCell* 431 432All of the setCell methods have a corresponding setLastCell method which 433does not accept the row_num and col_num parameters, but automatically applies 434to the last row and last col of the table. 435 436NB. Only works on the setCell* methods, not on the setSectionCell* methods. 437 438=item getCell(row_num, col_num) 439 440Returns the contents of the specified cell as a string. 441 442=item getSectionCell([tbody|thead|tfoot], section_num, row_num, col_num) 443 444Same as getCell, but able to specify which section to act on. 445 446=item getCellStyle(row_num, col_num) 447 448Returns cell's style attribute. 449 450=item getSectionCellStyle([tbody|thead|tfoot], section_num, row_num, col_num) 451 452Same as getCellStyle, but able to specify which section to act on. 453 454=back 455 456=head2 Column Level Methods 457 458=over 4 459 460=item addCol("cell 1 content" [, "cell 2 content", ...]) 461 462Adds a column to the right end of the table. Assumes if 463you pass more values than there are rows that you want 464to increase the number of rows. 465 466=item addSectionCol([tbody|thead|tfoot], section_num, "cell 1 content" [, "cell 2 content", ...]) 467 468Same as addCol, but able to specify which section to act on. 469 470=item setColAlign(col_num, [center|right|left]) 471 472Applies setCellAlign over the entire column. 473 474=item setSectionColAlign([tbody|thead|tfoot], section_num, col_num, [center|right|left]) 475 476Same as setColAlign, but able to specify which section to act on. 477 478=item setColVAlign(col_num, [center|top|bottom|middle|baseline]) 479 480Applies setCellVAlign over the entire column. 481 482=item setSectionColVAlign([tbody|thead|tfoot], section_num, col_num, [center|top|bottom|middle|baseline]) 483 484Same as setColVAlign, but able to specify which section to act on. 485 486=item setColWidth(col_num, [pixels|percentoftable]) 487 488Applies setCellWidth over the entire column. 489 490=item setSectionColWidth([tbody|thead|tfoot], section_num, col_num, [pixels|percentoftable]) 491 492Same as setColWidth, but able to specify which section to act on. 493 494=item setColHeight(col_num, [pixels]) 495 496Applies setCellHeight over the entire column. 497 498=item setSectionColHeight([tbody|thead|tfoot], section_num, col_num, [pixels]) 499 500Same as setColHeight, but able to specify which section to act on. 501 502=item setColHead(col_num, [0|1]) 503 504Applies setCellHead over the entire column. 505 506=item setSectionColHead([tbody|thead|tfoot], section_num, col_num, [0|1]) 507 508Same as setColHead, but able to specify which section to act on. 509 510=item setColNoWrap(col_num, [0|1]) 511 512Applies setCellNoWrap over the entire column. 513 514=item setSectionColNoWrap([tbody|thead|tfoot], section_num, col_num, [0|1]) 515 516Same as setColNoWrap, but able to specify which section to act on. 517 518=item setColBGColor(row_num, [colorname|colortriplet]) 519 520Applies setCellBGColor over the entire column. 521 522=item setSectionColBGColor([tbody|thead|tfoot], section_num, col_num, [colorname|colortriplet]) 523 524Same as setColBGColor, but able to specify which section to act on. 525 526=item setColFormat(col_num, start_string, end_sting) 527 528Applies setCellFormat over the entire column. 529 530=item setSectionColFormat([tbody|thead|tfoot], section_num, col_num, start_string, end_sting) 531 532Same as setColFormat, but able to specify which section to act on. 533 534=item setColStyle (col_num, 'css style') 535 536Applies setCellStyle over the entire column. 537 538=item setSectionColStyle([tbody|thead|tfoot], section_num, col_num, 'css style') 539 540Same as setColStyle, but able to specify which section to act on. 541 542=item setColClass (col_num, 'css class') 543 544Applies setCellClass over the entire column. 545 546=item setSectionColClass([tbody|thead|tfoot], section_num, col_num, 'css class') 547 548Same as setColClass, but able to specify which section to act on. 549 550=item setColAttr (col_num, 'user attribute') 551 552Applies setCellAttr over the entire column. 553 554=item setSectionColAttr([tbody|thead|tfoot], section_num, col_num, 'user attribute') 555 556Same as setColAttr, but able to specify which section to act on. 557 558=item setLastCol* 559 560All of the setCol methods have a corresponding setLastCol method which 561does not accept the col_num parameter, but automatically applies 562to the last col of the table. 563 564NB. Only works on the setCol* methods, not on the setSectionCol* methods. 565 566=item getColStyle(col_num) 567 568Returns column's style attribute. Only really useful after setting a column's style via setColStyle(). 569 570=item getSectionColStyle([tbody|thead|tfoot], section_num, col_num) 571 572Same as getColStyle, but able to specify which section to act on. 573 574=back 575 576=head2 Row Level Methods 577 578=over 4 579 580=item addRow("cell 1 content" [, "cell 2 content", ...]) 581 582Adds a row to the bottom of the first body section of the table. 583 584Adds a row to the bottom of the table. Assumes if you 585pass more values than there are columns that you want 586to increase the number of columns. 587 588=item addSectionRow([tbody|thead|tfoot], section_num, "cell 1 content" [, "cell 2 content", ...]) 589 590Same as addRow, but able to specify which section to act on. 591 592=item delRow(row_num) 593 594Deletes a row from the first body section of the table. If -1 is passed as row_num, the 595last row in the section will be deleted. 596 597=item delSectionRow([tbody|thead|tfoot], section_num, row_num) 598 599Same as delRow, but able to specify which section to act on. 600 601=item setRowAlign(row_num, [center|right|left]) 602 603Sets the Align attribute of the row. 604 605=item setSectionRowAlign([tbody|thead|tfoot], section_num, row_num, [center|right|left]) 606 607Same as setRowAlign, but able to specify which section to act on. 608 609=item setRowVAlign(row_num, [center|top|bottom|middle|baseline]) 610 611Sets the VAlign attribute of the row. 612 613=item setSectionRowVAlign([tbody|thead|tfoot], section_num, row_num, [center|top|bottom|middle|baseline]) 614 615Same as setRowVAlign, but able to specify which section to act on. 616 617=item setRowNoWrap(col_num, [0|1]) 618 619Sets the NoWrap attribute of the row. 620 621=item setSectionRowNoWrap([tbody|thead|tfoot], section_num, row_num, [0|1]) 622 623Same as setRowNoWrap, but able to specify which section to act on. 624 625=item setRowBGColor(row_num, [colorname|colortriplet]) 626 627Sets the BGColor attribute of the row. 628 629=item setSectionRowBGColor([tbody|thead|tfoot], section_num, row_num, [colorname|colortriplet]) 630 631Same as setRowBGColor, but able to specify which section to act on. 632 633=item setRowStyle (row_num, 'css style') 634 635Sets the Style attribute of the row. 636 637=item setSectionRowStyle([tbody|thead|tfoot], section_num, row_num, 'css style') 638 639Same as setRowStyle, but able to specify which section to act on. 640 641=item setRowClass (row_num, 'css class') 642 643Sets the Class attribute of the row. 644 645=item setSectionRowClass([tbody|thead|tfoot], section_num, row_num, 'css class') 646 647Same as setRowClass, but able to specify which section to act on. 648 649=item setRowAttr (row_num, 'user attribute') 650 651Sets the Attr attribute of the row. 652 653=item setSectionRowAttr([tbody|thead|tfoot], section_num, row_num, 'user attribute') 654 655Same as setRowAttr, but able to specify which section to act on. 656 657 658 659=item setRCellsWidth(row_num, [pixels|percentoftable]) 660 661=item setRowWidth(row_num, [pixels|percentoftable]) ** Deprecated ** 662 663Applies setCellWidth over the entire row. 664 665=item setSectionRCellsWidth([tbody|thead|tfoot], section_num, row_num, [pixels|percentoftable]) 666 667=item setSectionRowWidth([tbody|thead|tfoot], section_num, row_num, [pixels|percentoftable]) ** Deprecated ** 668 669Same as setRowWidth, but able to specify which section to act on. 670 671=item setRCellsHeight(row_num, [pixels]) 672 673=item setRowHeight(row_num, [pixels]) ** Deprecated ** 674 675Applies setCellHeight over the entire row. 676 677=item setSectionRCellsHeight([tbody|thead|tfoot], section_num, row_num, [pixels]) 678 679=item setSectionRowHeight([tbody|thead|tfoot], section_num, row_num, [pixels]) ** Deprecated ** 680 681Same as setRowHeight, but able to specify which section to act on. 682 683=item setRCellsHead(row_num, [0|1]) 684 685=item setRowHead(row_num, [0|1]) ** Deprecated ** 686 687Applies setCellHead over the entire row. 688 689=item setSectionRCellsHead([tbody|thead|tfoot], section_num, row_num, [0|1]) 690 691=item setSectionRowHead([tbody|thead|tfoot], section_num, row_num, [0|1]) ** Deprecated ** 692 693Same as setRowHead, but able to specify which section to act on. 694 695=item setRCellsFormat(row_num, start_string, end_string) 696 697=item setRowFormat(row_num, start_string, end_string) ** Deprecated ** 698 699Applies setCellFormat over the entire row. 700 701=item setSectionRCellsFormat([tbody|thead|tfoot], section_num, row_num, start_string, end_string) 702 703=item setSectionRowFormat([tbody|thead|tfoot], section_num, row_num, start_string, end_string) ** Deprecated ** 704 705Same as setRowFormat, but able to specify which section to act on. 706 707 708=item setLastRow* 709 710All of the setRow methods have a corresponding setLastRow method which 711does not accept the row_num parameter, but automatically applies 712to the last row of the table. 713 714NB. Only works on the setRow* methods, not on the setSectionRow* methods. 715 716=item getRowStyle(row_num) 717 718Returns row's style attribute. 719 720=item getSectionRowStyle([tbody|thead|tfoot], section_num, row_num) 721 722Same as getRowStyle, but able to specify which section to act on. 723 724=back 725 726=head2 Output Methods 727 728=over 4 729 730=item getTable 731 732Returns a string containing the HTML representation 733of the table. 734 735The same effect can also be achieved by using the object reference 736in a string scalar context. 737 738For example... 739 740 This code snippet: 741 742 $table = new HTML::Table(2, 2); 743 print '<p>Start</p>'; 744 print $table->getTable; 745 print '<p>End</p>'; 746 747 would produce the same output as: 748 749 $table = new HTML::Table(2, 2); 750 print "<p>Start</p>$table<p>End</p>"; 751 752=item print 753 754Prints HTML representation of the table to STDOUT 755 756=back 757 758=head1 CLASS VARIABLES 759 760=head1 HISTORY 761 762This module was originally created in 1997 by Stacy Lacy and whose last 763version was uploaded to CPAN in 1998. The module was adopted in July 2000 764by Anthony Peacock in order to distribute a revised version. This adoption 765took place without the explicit consent of Stacy Lacy as it proved impossible 766to contact them at the time. Explicit consent for the adoption has since been 767received. 768 769=head1 AUTHOR 770 771Anthony Peacock, a.peacock@chime.ucl.ac.uk 772Stacy Lacy (Original author) 773 774=head1 CONTRIBUTIONS 775 776Douglas Riordan <doug.riordan@gmail.com> 777For get methods for Style attributes. 778 779Jay Flaherty, fty@mediapulse.com 780For ROW, COL & CELL HEAD methods. Modified the new method to allow hash of values. 781 782John Stumbles, john@uk.stumbles.org 783For autogrow behaviour of setCell, and allowing alignment specifications to be case insensitive 784 785Arno Teunisse, Arno.Teunisse@Simac.nl 786For the methods adding rules, styles and table alignment attributes. 787 788Ville Skytt�, ville.skytta@iki.fi 789For general fixes 790 791Paul Vernaza, vernaza@stwing.upenn.edu 792For the setLast... methods 793 794David Link, dvlink@yahoo.com 795For the sort method 796 797Tommi Maekitalo, t.maekitalo@epgmbh.de 798For adding the 'head' parameter to the new method and for adding the initialisation from an array ref 799to the new method. 800 801Chris Weyl, cweyl@alumni.drew.edu 802For adding the even/odd row class support. 803 804=head1 COPYRIGHT 805 806Copyright (c) 2000-2007 Anthony Peacock, CHIME. 807Copyright (c) 1997 Stacy Lacy 808 809This library is free software; you can redistribute it and/or 810modify it under the same terms as Perl itself. 811 812=head1 SEE ALSO 813 814perl(1), CGI(3) 815 816=cut 817 818#------------------------------------------------------- 819# Subroutine: new([num_rows, num_cols]) 820# or new([-rows=>num_rows, 821# -cols=>num_cols, 822# -border=>border_width, 823# -bgcolor=>back_colour, 824# -width=>table_width, 825# -spacing=>cell_spacing, 826# -padding=>cell_padding]); 827# Author: Stacy Lacy 828# Date: 30 Jul 1997 829# Modified: 30 Mar 1998 - Jay Flaherty 830# Modified: 13 Feb 2001 - Anthony Peacock 831# Modified: 30 Aug 2002 - Tommi Maekitalo 832# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 833# Modified: 25 May 2007 - Chris Weyl (even/odd row class support) 834#------------------------------------------------------- 835sub new { 836 837# Creates new table instance 838my $type = shift; 839my $class = ref($type) || $type; 840my $self = {}; 841bless( $self, $class); 842 843# If paramter list is a hash (of the form -param=>value, ...) 844if (defined $_[0] && $_[0] =~ /^-/) { 845 my %flags = @_; 846 $self->{border} = defined $flags{-border} && _is_validnum($flags{-border}) ? $flags{-border} : undef; 847 $self->{align} = $flags{-align} || undef; 848 $self->{rules} = $flags{-rules} || undef; 849 $self->{style} = $flags{-style} || undef; 850 $self->{class} = $flags{-class} || undef; 851 $self->{bgcolor} = $flags{-bgcolor} || undef; 852 $self->{background} = $flags{-background} || undef; 853 $self->{width} = $flags{-width} || undef; 854 $self->{cellspacing} = defined $flags{-spacing} && _is_validnum($flags{-spacing}) ? $flags{-spacing} : undef; 855 $self->{cellpadding} = defined $flags{-padding} && _is_validnum($flags{-padding}) ? $flags{-padding} : undef; 856 $self->{last_col} = $flags{-cols} || 0; 857 $self->{evenrowclass} = $flags{-evenrowclass} || undef; 858 $self->{oddrowclass} = $flags{-oddrowclass} || undef; 859 860 if ($flags{-head}) 861 { 862 $self->addRow(@{$flags{-head}}); 863 $self->setRowHead(1); 864 } 865 866 if ($flags{-data}) 867 { 868 foreach (@{$flags{-data}}) 869 { 870 $self->addRow(@$_); 871 } 872 } 873 874 if ($self->{tbody}[0]->{last_row}) { 875 $self->{tbody}[0]->{last_row} = $flags{-rows} if (defined $flags{-rows} && $self->{tbody}[0]->{last_row} < $flags{-rows}); 876 } else { 877 $self->{tbody}[0]->{last_row} = $flags{-rows} || 0; 878 } 879 880} 881elsif (ref $_[0]) 882{ 883 # Array-reference [ ['row0col0', 'row0col1'], ['row1col0', 'row1col1'] ] 884 $self->{tbody}[0]->{last_row} = 0; 885 $self->{last_col} = 0; 886 foreach (@{$_[0]}) 887 { 888 $self->addRow(@$_); 889 } 890 891} 892else # user supplied row and col (or default to 0,0) 893{ 894 $self->{tbody}[0]->{last_row} = shift || 0; 895 $self->{last_col} = shift || 0; 896} 897 898# Table Auto-Grow mode (default on) 899$self->{autogrow} = 1; 900 901return $self; 902} 903 904#------------------------------------------------------- 905# Subroutine: getTable 906# Author: Stacy Lacy 907# Date: 30 July 1997 908# Modified: 19 Mar 1998 - Jay Flaherty 909# Modified: 13 Feb 2001 - Anthony Peacock 910# Modified: 23 Oct 2001 - Terence Brown 911# Modified: 05 Jan 2002 - Arno Teunisse 912# Modified: 10 Jan 2002 - Anthony Peacock 913# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 914# Modified: 25 May 2007 - Chris Weyl (add even/odd row class support) 915# Modified: 10 Sept 2007 - Anthony Peacock 916#------------------------------------------------------- 917sub getTable { 918 my $self = shift; 919 my $html=""; 920 921 # this sub returns HTML version of the table object 922 if ((! $self->{tbody}[0]{last_row}) || (! $self->{last_col})) { 923 return ; # no rows or no cols 924 } 925 926 # Table tag 927 $html .="\n<table"; 928 $html .=" border=\"$self->{border}\"" if defined $self->{border}; 929 $html .=" cellspacing=\"$self->{cellspacing}\"" if defined $self->{cellspacing}; 930 $html .=" cellpadding=\"$self->{cellpadding}\"" if defined $self->{cellpadding}; 931 $html .=" width=\"$self->{width}\"" if defined $self->{width}; 932 $html .=" bgcolor=\"$self->{bgcolor}\"" if defined $self->{bgcolor}; 933 $html .=" background=\"$self->{background}\"" if defined $self->{background}; 934 $html .=" rules=\"$self->{rules}\"" if defined $self->{rules} ; # add rules for table 935 $html .=" align=\"$self->{align}\"" if defined $self->{align} ; # alignment of the table 936 $html .=" style=\"$self->{style}\"" if defined $self->{style} ; # style for the table 937 $html .=" class=\"$self->{class}\"" if defined $self->{class} ; # class for the table 938 $html .=" $self->{attr}" if defined $self->{attr} ; # user defined attribute string 939 $html .=">\n"; 940 if (defined $self->{caption}) { 941 $html .="<caption"; 942 $html .=" align=\"$self->{caption_align}\"" if (defined $self->{caption_align}); 943 $html .=">$self->{caption}</caption>\n"; 944 } 945 946 # thead tag (if defined) 947 if (defined $self->{thead}) { 948 $html .= $self->getSection ( 'thead', 0 ); 949 } 950 951 # TFOOT tag (if defined) 952 if (defined $self->{tfoot}) { 953 $html .= $self->getSection ( 'tfoot', 0 ); 954 } 955 956 # Body sections 957 my $num_sections = @{$self->{tbody}} - 1; 958 for my $j ( 0..$num_sections ) { 959 $html .= $self->getSection ( 'tbody', $j ); 960 } 961 962 # Close TABLE tag 963 $html .="</table>\n"; 964 965 return ($html); 966} 967 968#------------------------------------------------------- 969# Subroutine: getRow 970# Author: Anthony Peacock 971# Date: 10 September 2007 972# Description: Gets the HTML to form a row, based on code taken from getTable 973#------------------------------------------------------- 974sub getRow { 975 my $self = shift; 976 my $section = lc(shift); 977 my $sect_num = shift; 978 my $row_num = shift; 979 my $html=""; 980 981 # Print each row of the table 982 $html .="<tr" ; 983 984 # Set the row attributes (if any) 985 $html .= ' bgcolor="' . $self->{$section}[$sect_num]->{rows}[$row_num]->{bgcolor} . '"' if defined $self->{$section}[$sect_num]->{rows}[$row_num]->{bgcolor}; 986 $html .= ' align="' . $self->{$section}[$sect_num]->{rows}[$row_num]->{align} . '"' if defined $self->{$section}[$sect_num]->{rows}[$row_num]->{align}; 987 $html .= ' valign="' . $self->{$section}[$sect_num]->{rows}[$row_num]->{valign} . '"' if defined $self->{$section}[$sect_num]->{rows}[$row_num]->{valign} ; 988 $html .= ' style="' . $self->{$section}[$sect_num]->{rows}[$row_num]->{style} . '"' if defined $self->{$section}[$sect_num]->{rows}[$row_num]->{style} ; 989 $html .= defined $self->{$section}[$sect_num]->{rows}[$row_num]->{class} ? ' class="' . $self->{$section}[$sect_num]->{rows}[$row_num]->{class} . '"' 990 : defined $self->{evenrowclass} && ($row_num % 2 == 0) ? ' class="' . $self->{evenrowclass} . '"' 991 : defined $self->{oddrowclass} && ($row_num % 2 == 1) ? ' class="' . $self->{oddrowclass} . '"' 992 : q{}; 993 $html .= ' nowrap="' . $self->{$section}[$sect_num]->{rows}[$row_num]->{nowrap} . '"' if defined $self->{$section}[$sect_num]->{rows}[$row_num]->{nowrap} ; 994 $html .= " $self->{$section}[$sect_num]->{rows}[$row_num]->{attr}" if defined $self->{$section}[$sect_num]->{rows}[$row_num]->{attr} ; 995 $html .= ">" ; # Closing tr tag 996 997 my $j; 998 for ($j=1; $j <= ($self->{last_col}); $j++) { 999 1000 if (defined $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{colspan} && $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{colspan} eq "SPANNED"){ 1001 $html.="<!-- spanned cell -->"; 1002 next 1003 } 1004 1005 # print cell 1006 # if head flag is set print <th> tag else <td> 1007 if (defined $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{head}) { 1008 $html .="<th"; 1009 } else { 1010 $html .="<td"; 1011 } 1012 1013 # if alignment options are set, add them in the cell tag 1014 $html .=' align="' . $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{align} . '"' 1015 if defined $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{align}; 1016 1017 $html .=" valign=\"" . $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{valign} . "\"" 1018 if defined $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{valign}; 1019 1020 # apply custom height and width to the cell tag 1021 $html .=" width=\"" . $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{width} . "\"" 1022 if defined $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{width}; 1023 1024 $html .=" height=\"" . $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{height} . "\"" 1025 if defined $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{height}; 1026 1027 # apply background color if set 1028 $html .=" bgcolor=\"" . $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{bgcolor} . "\"" 1029 if defined $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{bgcolor}; 1030 1031 # apply style if set 1032 $html .=" style=\"" . $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{style} . "\"" 1033 if defined $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{style}; 1034 1035 # apply class if set 1036 $html .=" class=\"" . $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{class} . "\"" 1037 if defined $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{class}; 1038 1039 # User defined attribute 1040 $html .=" " . $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{attr} 1041 if defined $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{attr}; 1042 1043 # if nowrap mask is set, put it in the cell tag 1044 $html .=" nowrap" if defined $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{nowrap}; 1045 1046 # if column/row spanning is set, put it in the cell tag 1047 # also increment to skip spanned rows/cols. 1048 if (defined $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{colspan}) { 1049 $html .=" colspan=\"" . $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{colspan} ."\""; 1050 } 1051 if (defined $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{rowspan}){ 1052 $html .=" rowspan=\"" . $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{rowspan} ."\""; 1053 } 1054 1055 # Finish up Cell by ending cell start tag, putting content and cell end tag 1056 $html .=">"; 1057 $html .= $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{startformat} if defined $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{startformat} ; 1058 $html .= $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{contents} if defined $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{contents}; 1059 $html .= $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{endformat} if defined $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{endformat} ; 1060 1061 # if head flag is set print </th> tag else </td> 1062 if (defined $self->{$section}[$sect_num]->{rows}[$row_num]->{cells}[$j]->{head}) { 1063 $html .= "</th>"; 1064 } else { 1065 $html .= "</td>"; 1066 } 1067 } 1068 $html .="</tr>\n"; 1069 1070 return ($html); 1071} 1072 1073#------------------------------------------------------- 1074# Subroutine: getSection 1075# Author: Anthony Peacock 1076# Date: 10 April 2008 1077# Description: Gets the HTML to form a section 1078#------------------------------------------------------- 1079sub getSection { 1080 my $self = shift; 1081 my $section = lc(shift); 1082 my $sect_num = shift; 1083 my $html=""; 1084 1085 # Create section HTML 1086 $html .= "<$section"; 1087 1088 # Set the section attributes (if any) 1089 $html .= ' id="' . $self->{$section}[$sect_num]->{id} . '"' if defined $self->{$section}[$sect_num]->{id}; 1090 $html .= ' title="' . $self->{$section}[$sect_num]->{title} . '"' if defined $self->{$section}[$sect_num]->{title}; 1091 $html .= ' class="' . $self->{$section}[$sect_num]->{class} . '"' if defined $self->{$section}[$sect_num]->{class}; 1092 $html .= ' style="' . $self->{$section}[$sect_num]->{style} . '"' if defined $self->{$section}[$sect_num]->{style}; 1093 $html .= ' align="' . $self->{$section}[$sect_num]->{align} . '"' if defined $self->{$section}[$sect_num]->{align}; 1094 $html .= ' valign="' . $self->{$section}[$sect_num]->{valign} . '"' if defined $self->{$section}[$sect_num]->{valign}; 1095 $html .= ' attr="' . $self->{$section}[$sect_num]->{attr} . '"' if defined $self->{$section}[$sect_num]->{attr}; 1096 1097 $html .= ">\n"; 1098 1099 for my $i ( 1..($self->{$section}[$sect_num]->{last_row})){ 1100 # Print each row 1101 $html .= $self->getRow($section, $sect_num, $i); 1102 } 1103 $html .= "</$section>\n"; 1104 1105 1106 return ($html); 1107} 1108 1109#------------------------------------------------------- 1110# Subroutine: print 1111# Author: Stacy Lacy 1112# Date: 30 Jul 1997 1113#------------------------------------------------------- 1114sub print { 1115 my $self = shift; 1116 print $self->getTable; 1117} 1118 1119#------------------------------------------------------- 1120# Subroutine: autoGrow([1|on|true|0|off|false]) 1121# Author: John Stumbles 1122# Date: 08 Feb 2001 1123# Description: switches on (default) or off auto-grow mode 1124# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1125#------------------------------------------------------- 1126sub autoGrow { 1127 my $self = shift; 1128 $self->{autogrow} = shift; 1129 if ( defined $self->{autogrow} && $self->{autogrow} =~ /^(?:no|off|false|disable|0)$/i ) { 1130 $self->{autogrow} = 0; 1131 } else { 1132 $self->{autogrow} = 1; 1133 } 1134} 1135 1136 1137#------------------------------------------------------- 1138# Table config methods 1139# 1140#------------------------------------------------------- 1141 1142#------------------------------------------------------- 1143# Subroutine: setBorder([pixels]) 1144# Author: Stacy Lacy 1145# Date: 30 Jul 1997 1146# Modified: 12 Jul 2000 - Anthony Peacock (To allow zero values) 1147# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1148#------------------------------------------------------- 1149sub setBorder { 1150 my $self = shift; 1151 $self->{border} = shift; 1152 $self->{border} = 1 unless ( &_is_validnum($self->{border}) ) ; 1153} 1154 1155#------------------------------------------------------- 1156# Subroutine: setBGColor([colorname|colortriplet]) 1157# Author: Stacy Lacy 1158# Date: 30 Jul 1997 1159# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1160#------------------------------------------------------- 1161sub setBGColor { 1162 my $self = shift; 1163 $self->{bgcolor} = shift || undef; 1164} 1165 1166#------------------------------------------------------- 1167# Subroutine: setStyle(css style) 1168# Author: Anthony Peacock 1169# Date: 6 Mar 2002 1170# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1171#------------------------------------------------------- 1172sub setStyle { 1173 my $self = shift; 1174 $self->{style} = shift || undef; 1175} 1176 1177#------------------------------------------------------- 1178# Subroutine: setClass(css class) 1179# Author: Anthony Peacock 1180# Date: 22 July 2002 1181# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1182#------------------------------------------------------- 1183sub setClass { 1184 my $self = shift; 1185 $self->{class} = shift || undef; 1186} 1187 1188#------------------------------------------------------- 1189# Subroutine: setEvenRowClass(css class) 1190# Author: Chris Weyl 1191# Date: 25 May 2007 1192#------------------------------------------------------- 1193sub setEvenRowClass { 1194 my $self = shift; 1195 $self->{evenrowclass} = shift || undef; 1196} 1197 1198#------------------------------------------------------- 1199# Subroutine: setOddRowClass(css class) 1200# Author: Chris Weyl 1201# Date: 25 May 2007 1202#------------------------------------------------------- 1203sub setOddRowClass { 1204 my $self = shift; 1205 $self->{oddrowclass} = shift || undef; 1206} 1207 1208#------------------------------------------------------- 1209# Subroutine: setWidth([pixels|percentofscreen]) 1210# Author: Stacy Lacy 1211# Date: 30 Jul 1997 1212# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1213#------------------------------------------------------- 1214sub setWidth { 1215 my $self = shift; 1216 my $value = shift; 1217 1218 if ( $value !~ /^\s*\d+%?/ ) { 1219 print STDERR "$0:setWidth:Invalid value $value\n"; 1220 return 0; 1221 } else { 1222 $self->{width} = $value; 1223 } 1224} 1225 1226#------------------------------------------------------- 1227# Subroutine: setCellSpacing([pixels]) 1228# Author: Stacy Lacy 1229# Date: 30 Jul 1997 1230# Modified: 12 Jul 2000 - Anthony Peacock (To allow zero values) 1231# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1232#------------------------------------------------------- 1233sub setCellSpacing { 1234 my $self = shift; 1235 $self->{cellspacing} = shift; 1236 $self->{cellspacing} = 1 unless ( &_is_validnum($self->{cellspacing}) ) ; 1237} 1238 1239#------------------------------------------------------- 1240# Subroutine: setCellPadding([pixels]) 1241# Author: Stacy Lacy 1242# Date: 30 Jul 1997 1243# Modified: 12 Jul 2000 - Anthony Peacock (To allow zero values) 1244# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1245#------------------------------------------------------- 1246sub setCellPadding { 1247 my $self = shift; 1248 $self->{cellpadding} = shift; 1249 $self->{cellpadding} = 1 unless ( &_is_validnum($self->{cellpadding}) ) ; 1250} 1251 1252#------------------------------------------------------- 1253# Subroutine: setCaption("CaptionText" [, "TOP|BOTTOM]) 1254# Author: Stacy Lacy 1255# Date: 30 Jul 1997 1256# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1257#------------------------------------------------------- 1258sub setCaption { 1259 my $self = shift; 1260 $self->{caption} = shift ; 1261 my $align = lc(shift); 1262 if (defined $align && (($align eq 'top') || ($align eq 'bottom')) ) { 1263 $self->{caption_align} = $align; 1264 } else { 1265 $self->{caption_align} = 'top'; 1266 } 1267} 1268 1269#------------------------------------------------------- 1270# Subroutine: setAlign([left|right|center]) 1271# Author: Arno Teunisse ( freely copied from setBGColor 1272# Date: 05 Jan 2002 1273# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1274#------------------------------------------------------- 1275sub setAlign { 1276 my $self = shift; 1277 $self->{align} = shift || undef; 1278} 1279 1280#------------------------------------------------------- 1281# Subroutine: setRules([left|right|center]) 1282# Author: Arno Teunisse ( freely copied from setBGColor 1283# Date: 05 Jan 2002 1284# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1285# parameter [ none | groups | rows| cols | all ] 1286#------------------------------------------------------- 1287sub setRules { 1288 my $self = shift; 1289 $self->{rules} = shift || undef; 1290} 1291 1292#------------------------------------------------------- 1293# Subroutine: setAttr("attribute string") 1294# Author: Anthony Peacock 1295# Date: 10 Jan 2002 1296# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1297#------------------------------------------------------- 1298sub setAttr { 1299 my $self = shift; 1300 $self->{attr} = shift || undef; 1301} 1302 1303#------------------------------------------------------- 1304# Subroutine: getSectionTableRows ('section', section_num') 1305# Author: Anthony Peacock 1306# Date: 12 Sept 2007 1307# Based on: getTableRows 1308#------------------------------------------------------- 1309sub getSectionTableRows { 1310 my $self = shift; 1311 my $section = shift; 1312 my $section_num = shift; 1313 1314 if ( $section !~ /thead|tbody|tfoot/i ) { 1315 print STDERR "\ngetSectionTableRows: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 1316 return 0; 1317 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 1318 print STDERR "\ngetSectionTableRows: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 1319 return 0; 1320 } 1321 1322 return $self->{$section}[$section_num]->{last_row}; 1323} 1324 1325#------------------------------------------------------- 1326# Subroutine: getTableRows 1327# Author: Joerg Jaspert 1328# Date: 4 Aug 2001 1329# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1330# Modified: 12 Sept 2007 - Anthony Peacock 1331#------------------------------------------------------- 1332sub getTableRows{ 1333 my $self = shift; 1334 return $self->getSectionTableRows ( 'tbody', 0 ); 1335} 1336 1337#------------------------------------------------------- 1338# Subroutine: getTableCols 1339# Author: Joerg Jaspert 1340# Date: 4 Aug 2001 1341# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1342#------------------------------------------------------- 1343sub getTableCols{ 1344 my $self = shift; 1345 return $self->{last_col}; 1346} 1347 1348#------------------------------------------------------- 1349# Subroutine: getStyle 1350# Author: Douglas Riordan 1351# Date: 30 Nov 2005 1352# Description: getter for table style 1353#------------------------------------------------------- 1354 1355sub getStyle { 1356 return shift->{style} || undef; 1357} 1358 1359#------------------------------------------------------- 1360# Subroutine: sort (sort_col_num, [ALPHA|NUMERIC], [ASC|DESC], 1361# num_rows_to_skip) 1362# sort ( -section=>'section', 1363# -section_num=>number, 1364# -sort_col=>sort_col_num, 1365# -sort_type=>[ALPHA|NUMERIC], 1366# -sort_order=>[ASC|DESC], 1367# -skip_rows=>num_rows_to_skip, 1368# -strip_html=>[0|1], # default 1 1369# -strip_non_numeric=>[0|1], # default 1 1370# # for sort_type=NUMERIC 1371# -presort_func=>\&filter, 1372# ) 1373# Author: David Link 1374# Date: 28 Jun 2002 1375# Modified: 09 Apr 2003 -- dl Added options: -strip_html, 1376# -strip_non_numeric, and -presort_func. 1377# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1378# Modified: 12 Sept 2007 - Anthony Peacock 1379#------------------------------------------------------- 1380sub sort { 1381 my $self = shift; 1382 my ($sort_col, $sort_type, $sort_order, $skip_rows, 1383 $strip_html, $strip_non_numeric, $presort_func, $section, $section_num); 1384 $strip_html = 1; 1385 $strip_non_numeric = 1; 1386 1387 # Set the default section to the first 'tbody' 1388 $section = 'tbody'; 1389 $section_num = 0; 1390 1391 if (defined $_[0] && $_[0] =~ /^-/) { 1392 my %flag = @_; 1393 $section = $flag{-section} || 'tbody'; 1394 $section_num = $flag{-section_num} || 0; 1395 $sort_col = $flag{-sort_col} || 1; 1396 $sort_type = $flag{-sort_type} || "alpha"; 1397 $sort_order = $flag{-sort_order} || "asc"; 1398 $skip_rows = $flag{-skip_rows} || 0; 1399 $strip_html = $flag{-strip_html} if defined($flag{-strip_html}); 1400 $strip_non_numeric = $flag{-strip_non_numeric} 1401 if defined($flag{-strip_non_numeric}); 1402 $presort_func = $flag{-presort_func} || undef; 1403 } 1404 else { 1405 $sort_col = shift || 1; 1406 $sort_type = shift || "alpha"; 1407 $sort_order = shift || "asc"; 1408 $skip_rows = shift || 0; 1409 $presort_func = undef; 1410 } 1411 my $cmp_symbol = lc($sort_type) eq "alpha" ? "cmp" : "<=>"; 1412 my ($first, $last) = lc($sort_order) eq "asc"?("\$a", "\$b"):("\$b", "\$a"); 1413 my $piece1 = qq/\$self->{$section}[$section_num]->{rows}[$first]->{cells}[$sort_col]->{contents}/; 1414 my $piece2 = qq/\$self->{$section}[$section_num]->{rows}[$last]->{cells}[$sort_col]->{contents}/; 1415 if ($strip_html) { 1416 $piece1 = qq/&_stripHTML($piece1)/; 1417 $piece2 = qq/&_stripHTML($piece2)/; 1418 } 1419 if ($presort_func) { 1420 $piece1 = qq/\&{\$presort_func}($piece1)/; 1421 $piece2 = qq/\&{\$presort_func}($piece2)/; 1422 } 1423 if (lc($sort_type) ne 'alpha' && $strip_non_numeric) { 1424 $piece1 = qq/&_stripNonNumeric($piece1)/; 1425 $piece2 = qq/&_stripNonNumeric($piece2)/; 1426 } 1427 my $sortfunc = qq/sub { $piece1 $cmp_symbol $piece2 }/; 1428 my $sorter = eval($sortfunc); 1429 my @sortkeys = sort $sorter (($skip_rows+1)..$self->{$section}[$section_num]->{last_row}); 1430 1431 my @holdtable = @{$self->{$section}[$section_num]->{rows}}; 1432 my $i = $skip_rows+1; 1433 for my $k (@sortkeys) { 1434 $self->{$section}[$section_num]->{rows}[$i++] = $holdtable[$k]; 1435 } 1436} 1437 1438#------------------------------------------------------- 1439# Subroutine: _stripHTML (html_string) 1440# Author: David Link 1441# Date: 12 Feb 2003 1442#------------------------------------------------------- 1443sub _stripHTML { 1444 $_ = $_[0]; 1445 s/ \< [^>]* \> //gx; 1446 s/\ / /g; 1447 return $_; 1448} 1449 1450#------------------------------------------------------- 1451# Subroutine: _stripNonNumeric (string) 1452# Author: David Link 1453# Date: 04 Apr 2003 1454# Description: Remove all non-numeric char from a string 1455# For efficiency does not deal with: 1456# 1. nested '-' chars., 2. multiple '.' chars. 1457#------------------------------------------------------- 1458sub _stripNonNumeric { 1459 $_ = $_[0]; 1460 s/[^0-9.+-]//g; 1461 return 0 if !$_; 1462 return $_; 1463} 1464 1465#------------------------------------------------------- 1466# Section config methods 1467# 1468#------------------------------------------------------- 1469 1470#------------------------------------------------------- 1471# Subroutine: setSectionAlign('Section', section_num, [left|right|center]) 1472# Author: Anthony Peacock 1473# Date: 10 Septmeber 2007 1474#------------------------------------------------------- 1475sub setSectionAlign { 1476 my $self = shift; 1477 my $section = lc(shift); 1478 my $section_num = shift; 1479 1480 if ( $section !~ /thead|tbody|tfoot/i ) { 1481 print STDERR "\nsetSectionAlign: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 1482 return 0; 1483 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 1484 print STDERR "\nsetSectionAlign: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 1485 return 0; 1486 } 1487 1488 $self->{$section}[$section_num]->{align} = shift || undef; 1489} 1490 1491#------------------------------------------------------- 1492# Subroutine: setSectionId('Section', section_num, 'Id') 1493# Author: Anthony Peacock 1494# Date: 10 Septmeber 2007 1495#------------------------------------------------------- 1496sub setSectionId { 1497 my $self = shift; 1498 my $section = lc(shift); 1499 my $section_num = shift; 1500 1501 if ( $section !~ /thead|tbody|tfoot/i ) { 1502 print STDERR "\nsetSectionId: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 1503 return 0; 1504 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 1505 print STDERR "\nsetSectionId: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 1506 return 0; 1507 } 1508 1509 $self->{$section}[$section_num]->{id} = shift || undef; 1510} 1511 1512#------------------------------------------------------- 1513# Subroutine: setSectionClass('Section', section_num, 'Class') 1514# Author: Anthony Peacock 1515# Date: 10 Septmeber 2007 1516#------------------------------------------------------- 1517sub setSectionClass { 1518 my $self = shift; 1519 my $section = lc(shift); 1520 my $section_num = shift; 1521 1522 if ( $section !~ /thead|tbody|tfoot/i ) { 1523 print STDERR "\nsetSectionClass: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 1524 return 0; 1525 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 1526 print STDERR "\nsetSectionClass: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 1527 return 0; 1528 } 1529 1530 $self->{$section}[$section_num]->{class} = shift || undef; 1531} 1532 1533#------------------------------------------------------- 1534# Subroutine: setSectionStyle('Section', section_num, 'style') 1535# Author: Anthony Peacock 1536# Date: 10 Septmeber 2007 1537#------------------------------------------------------- 1538sub setSectionStyle { 1539 my $self = shift; 1540 my $section = lc(shift); 1541 my $section_num = shift; 1542 1543 if ( $section !~ /thead|tbody|tfoot/i ) { 1544 print STDERR "\nsetSectionStyle: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 1545 return 0; 1546 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 1547 print STDERR "\nsetSectionStyle: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 1548 return 0; 1549 } 1550 1551 $self->{$section}[$section_num]->{style} = shift || undef; 1552} 1553 1554#------------------------------------------------------- 1555# Subroutine: setSectionValign('Section', section_num, [center|top|bottom|middle|baseline]) 1556# Author: Anthony Peacock 1557# Date: 10 Septmeber 2007 1558#------------------------------------------------------- 1559sub setSectionValign { 1560 my $self = shift; 1561 my $section = lc(shift); 1562 my $section_num = shift; 1563 my $valign = lc(shift); 1564 1565 if ( $section !~ /thead|tbody|tfoot/i ) { 1566 print STDERR "\nsetSectionValign: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 1567 return 0; 1568 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 1569 print STDERR "\nsetSectionValign: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 1570 return 0; 1571 } 1572 1573 if (! (($valign eq "center") || ($valign eq "top") || 1574 ($valign eq "bottom") || ($valign eq "middle") || 1575 ($valign eq "baseline")) ) { 1576 print STDERR "$0:setSectionVAlign:Invalid alignment type\n"; 1577 return 0; 1578 } 1579 1580 $self->{$section}[$section_num]->{valign} = $valign; 1581} 1582 1583#------------------------------------------------------- 1584# Subroutine: setSectionAttr('Section', section_num, 'attr') 1585# Author: Anthony Peacock 1586# Date: 10 Septmeber 2007 1587#------------------------------------------------------- 1588sub setSectionAttr { 1589 my $self = shift; 1590 my $section = lc(shift); 1591 my $section_num = shift; 1592 1593 if ( $section !~ /thead|tbody|tfoot/i ) { 1594 print STDERR "\nsetSectionAttr: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 1595 return 0; 1596 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 1597 print STDERR "\nsetSectionAttr: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 1598 return 0; 1599 } 1600 1601 $self->{$section}[$section_num]->{attr} = shift; 1602} 1603 1604#------------------------------------------------------- 1605# Cell config methods 1606# 1607#------------------------------------------------------- 1608 1609#------------------------------------------------------- 1610# Subroutine: setSectionCell("section", section_num, row_num, col_num, "content") 1611# Author: Anthony Peacock 1612# Date: 10 September 2007 1613#------------------------------------------------------- 1614sub setSectionCell { 1615 my $self = shift; 1616 my $section = lc(shift); 1617 my $section_num = shift; 1618 (my $row = shift) || return 0; 1619 (my $col = shift) || return 0; 1620 1621 if ( $section !~ /thead|tbody|tfoot/i ) { 1622 print STDERR "\nsetSectionCell: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 1623 return 0; 1624 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 1625 print STDERR "\nsetSectionCell: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 1626 return 0; 1627 } 1628 1629 # If -1 is used in either the row or col parameter, use the last row or cell 1630 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 1631 $col = $self->{last_col} if $col == -1; 1632 1633 if ($row < 1) { 1634 print STDERR "$0:setSectionCell:Invalid table row reference $row:$col\n"; 1635 return 0; 1636 } 1637 if ($col < 1) { 1638 print STDERR "$0:setSectionCell:Invalid table column reference $row:$col\n"; 1639 return 0; 1640 } 1641 if ($row > $self->{$section}[$section_num]{last_row}) { 1642 if ($self->{autogrow}) { 1643 $self->{$section}[$section_num]{last_row} = $row ; 1644 } else { 1645 print STDERR "$0:setSectionCell:Invalid table row reference $row:$col\n"; 1646 } 1647 } 1648 if ($col > $self->{last_col}) { 1649 if ($self->{autogrow}) { 1650 $self->{last_col} = $col ; 1651 } else { 1652 print STDERR "$0:setSectionCell:Invalid table column reference $row:$col\n"; 1653 } 1654 } 1655 $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{contents} = shift; 1656 return ($row, $col); 1657 1658} 1659 1660#------------------------------------------------------- 1661# Subroutine: setCell(row_num, col_num, "content") 1662# Author: Stacy Lacy 1663# Date: 30 Jul 1997 1664# Modified: 08 Feb 2001 - John Stumbles to allow auto-growing of table 1665# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1666#------------------------------------------------------- 1667sub setCell { 1668 my $self = shift; 1669 (my $row = shift) || return 0; 1670 (my $col = shift) || return 0; 1671 my $contents = shift; 1672 1673 return $self->setSectionCell ( 'tbody', 0, $row, $col, $contents ); 1674} 1675 1676#------------------------------------------------------- 1677# Subroutine: getSectionCell('section', section_num, row_num, col_num) 1678# Author: Anthony Peacock 1679# Date: 12 Sept 2007 1680# Based on: getCell 1681#------------------------------------------------------- 1682sub getSectionCell { 1683 my $self = shift; 1684 my $section = shift; 1685 my $section_num = shift; 1686 (my $row = shift) || return 0; 1687 (my $col = shift) || return 0; 1688 1689 if ( $section !~ /thead|tbody|tfoot/i ) { 1690 print STDERR "\ngetSectionCell: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 1691 return 0; 1692 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 1693 print STDERR "\ngetSectionCell: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 1694 return 0; 1695 } 1696 1697 # If -1 is used in either the row or col parameter, use the last row or cell 1698 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 1699 $col = $self->{last_col} if $col == -1; 1700 1701 if (($row > $self->{$section}[$section_num]->{last_row}) || ($row < 1) ) { 1702 print STDERR "$0:getSectionCell:Invalid table reference $row:$col\n"; 1703 return 0; 1704 } 1705 if (($col > $self->{last_col}) || ($col < 1) ) { 1706 print STDERR "$0:getSectionCell:Invalid table reference $row:$col\n"; 1707 return 0; 1708 } 1709 1710 return $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{contents} ; 1711} 1712 1713#------------------------------------------------------- 1714# Subroutine: getCell(row_num, col_num) 1715# Author: Anthony Peacock 1716# Date: 27 Jul 1998 1717# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1718# Modified: 12 Sept 2007 - Anthony Peacock 1719#------------------------------------------------------- 1720sub getCell { 1721 my $self = shift; 1722 (my $row = shift) || return 0; 1723 (my $col = shift) || return 0; 1724 1725 return $self->getSectionCell ( 'tbody', 0, $row, $col) ; 1726} 1727 1728#------------------------------------------------------- 1729# Subroutine: getSectionCellStyle('section', section_num, $row_num, $col_num) 1730# Author: Anthony Peacock 1731# Date: 12 Sept 2007 1732# Description: getter for cell style 1733# Based on: getCellStyle 1734#------------------------------------------------------- 1735sub getSectionCellStyle { 1736 my $self = shift; 1737 my $section = shift; 1738 my $section_num = shift; 1739 my ($row, $col) = @_; 1740 1741 if ( $section !~ /thead|tbody|tfoot/i ) { 1742 print STDERR "\ngetSectionCellStyle: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 1743 return 0; 1744 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 1745 print STDERR "\ngetSectionCellStyle: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 1746 return 0; 1747 } 1748 1749 return $self->_checkRowAndCol('getSectionCellStyle', $section, $section_num, {row => $row, col => $col}) 1750 ? $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{style} 1751 : undef; 1752} 1753 1754#------------------------------------------------------- 1755# Subroutine: getCellStyle($row_num, $col_num) 1756# Author: Douglas Riordan 1757# Date: 30 Nov 2005 1758# Description: getter for cell style 1759# Modified: 12 Sept 2007 - Anthony Peacock 1760#------------------------------------------------------- 1761sub getCellStyle { 1762 my ($self, $row, $col) = @_; 1763 1764 return $self->getSectionCellStyle('tbody', 0, $row, $col); 1765} 1766 1767#------------------------------------------------------- 1768# Subroutine: setSectionCellAlign('section', section_num, row_num, col_num, [center|right|left]) 1769# Author: Anthony Peacock 1770# Date: 12 Sept 2007 1771# Based on: setCellAlign 1772#------------------------------------------------------- 1773sub setSectionCellAlign { 1774 my $self = shift; 1775 my $section = shift; 1776 my $section_num = shift; 1777 (my $row = shift) || return 0; 1778 (my $col = shift) || return 0; 1779 my $align = lc(shift); 1780 1781 if ( $section !~ /thead|tbody|tfoot/i ) { 1782 print STDERR "\nsetSectionCellAlign: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 1783 return 0; 1784 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 1785 print STDERR "\nsetSectionCellAlign: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 1786 return 0; 1787 } 1788 1789 # If -1 is used in either the row or col parameter, use the last row or cell 1790 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 1791 $col = $self->{last_col} if $col == -1; 1792 1793 if (($row > $self->{$section}[$section_num]->{last_row}) || ($row < 1) ) { 1794 print STDERR "$0:setSectionCellAlign:Invalid table reference\n"; 1795 return 0; 1796 } 1797 if (($col > $self->{last_col}) || ($col < 1) ) { 1798 print STDERR "$0:setSectionCellAlign:Invalid table reference\n"; 1799 return 0; 1800 } 1801 1802 if (! $align) { 1803 #return to default alignment if none specified 1804 undef $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{align}; 1805 return ($row, $col); 1806 } 1807 1808 if (! (($align eq 'center') || ($align eq 'right') || 1809 ($align eq 'left'))) { 1810 print STDERR "$0:setCellAlign:Invalid alignment type\n"; 1811 return 0; 1812 } 1813 1814 # We have a valid alignment type so let's set it for the cell 1815 $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{align} = $align; 1816 return ($row, $col); 1817} 1818 1819#------------------------------------------------------- 1820# Subroutine: setCellAlign(row_num, col_num, [center|right|left]) 1821# Author: Stacy Lacy 1822# Date: 30 Jul 1997 1823# Modified: 13 Feb 2001 - Anthony Peacock for case insensitive 1824# alignment parameters 1825# (suggested by John Stumbles) 1826# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1827# Modified: 12 Sept 2007 - Anthony Peacock 1828#------------------------------------------------------- 1829sub setCellAlign { 1830 my $self = shift; 1831 (my $row = shift) || return 0; 1832 (my $col = shift) || return 0; 1833 my $align = lc(shift); 1834 1835 return $self->setSectionCellAlign ( 'tbody', 0, $row, $col, $align ); 1836} 1837 1838#------------------------------------------------------- 1839# Subroutine: setSectionCellVAlign('section', section_num, row_num, col_num, [center|top|bottom|middle|baseline]) 1840# Author: Anthony Peacock 1841# Date: 12 Sept 2007 1842# Based on: setCellVAlign 1843#------------------------------------------------------- 1844sub setSectionCellVAlign { 1845 my $self = shift; 1846 my $section = shift; 1847 my $section_num = shift; 1848 (my $row = shift) || return 0; 1849 (my $col = shift) || return 0; 1850 my $valign = lc(shift); 1851 1852 if ( $section !~ /thead|tbody|tfoot/i ) { 1853 print STDERR "\nsetSectionCellVAlign: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 1854 return 0; 1855 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 1856 print STDERR "\nsetSectionCellVAlign: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 1857 return 0; 1858 } 1859 1860 # If -1 is used in either the row or col parameter, use the last row or cell 1861 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 1862 $col = $self->{last_col} if $col == -1; 1863 1864 if (($row > $self->{$section}[$section_num]->{last_row}) || ($row < 1) ) { 1865 print STDERR "$0:setSectionCellVAlign:Invalid table reference\n"; 1866 return 0; 1867 } 1868 if (($col > $self->{last_col}) || ($col < 1) ) { 1869 print STDERR "$0:setSectionCellVAlign:Invalid table reference\n"; 1870 return 0; 1871 } 1872 1873 if (! $valign) { 1874 #return to default alignment if none specified 1875 undef $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{valign}; 1876 return ($row, $col); 1877 } 1878 1879 if (! (($valign eq "center") || ($valign eq "top") || 1880 ($valign eq "bottom") || ($valign eq "middle") || 1881 ($valign eq "baseline")) ) { 1882 print STDERR "$0:setSectionCellVAlign:Invalid alignment type\n"; 1883 return 0; 1884 } 1885 1886 # We have a valid valignment type so let's set it for the cell 1887 $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{valign} = $valign; 1888 return ($row, $col); 1889} 1890 1891#------------------------------------------------------- 1892# Subroutine: setCellVAlign(row_num, col_num, [center|top|bottom|middle|baseline]) 1893# Author: Stacy Lacy 1894# Date: 30 Jul 1997 1895# Modified: 13 Feb 2001 - Anthony Peacock for case insensitive 1896# alignment parameters 1897# (suggested by John Stumbles) 1898# Modified: 22 Aug 2003 - Alejandro Juarez to add MIDDLE and BASELINE 1899# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1900# Modified: 12 Sept 2007 1901#------------------------------------------------------- 1902sub setCellVAlign { 1903 my $self = shift; 1904 (my $row = shift) || return 0; 1905 (my $col = shift) || return 0; 1906 my $valign = lc(shift); 1907 1908 return $self->setSectionCellVAlign ( 'tbody', 0, $row, $col, $valign ); 1909} 1910 1911#------------------------------------------------------- 1912# Subroutine: setSectionCellHead('section', section_num, row_num, col_num, [0|1]) 1913# Author: Anthony Peacock 1914# Date: 12 Sept 2007 1915# Based on: setCellHead 1916#------------------------------------------------------- 1917sub setSectionCellHead { 1918 my $self = shift; 1919 my $section = shift; 1920 my $section_num = shift; 1921 (my $row = shift) || return 0; 1922 (my $col = shift) || return 0; 1923 my $value = shift || 1; 1924 1925 if ( $section !~ /thead|tbody|tfoot/i ) { 1926 print STDERR "\nsetSectionCellHead: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 1927 return 0; 1928 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 1929 print STDERR "\nsetSectionCellHead: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 1930 return 0; 1931 } 1932 1933 # If -1 is used in either the row or col parameter, use the last row or cell 1934 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 1935 $col = $self->{last_col} if $col == -1; 1936 1937 if (($row > $self->{$section}[$section_num]->{last_row}) || ($row < 1) ) { 1938 print STDERR "$0:setSectionCellHead:Invalid table reference\n"; 1939 return 0; 1940 } 1941 if (($col > $self->{last_col}) || ($col < 1) ) { 1942 print STDERR "$0:setSectionCellHead:Invalid table reference\n"; 1943 return 0; 1944 } 1945 1946 $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{head} = $value; 1947 return ($row, $col); 1948} 1949 1950#------------------------------------------------------- 1951# Subroutine: setCellHead(row_num, col_num, [0|1]) 1952# Author: Jay Flaherty 1953# Date: 19 Mar 1998 1954# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 1955# Modified: 12 Sept 2007 - Anthony Peacock 1956#------------------------------------------------------- 1957sub setCellHead{ 1958 my $self = shift; 1959 (my $row = shift) || return 0; 1960 (my $col = shift) || return 0; 1961 my $value = shift || 1; 1962 1963 $self->setSectionCellHead ( 'tbody', 0, $row, $col, $value ); 1964} 1965 1966#------------------------------------------------------- 1967# Subroutine: setSectionCellNoWrap('section', section_num, row_num, col_num, [0|1]) 1968# Author: Anthony Peacock 1969# Date: 12 Sept 2007 1970# Based on: setCellNoWrap 1971#------------------------------------------------------- 1972sub setSectionCellNoWrap { 1973 my $self = shift; 1974 my $section = shift; 1975 my $section_num = shift; 1976 (my $row = shift) || return 0; 1977 (my $col = shift) || return 0; 1978 (my $value = shift); 1979 1980 if ( $section !~ /thead|tbody|tfoot/i ) { 1981 print STDERR "\nsetSectionCellNoWrap: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 1982 return 0; 1983 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 1984 print STDERR "\nsetSectionCellNoWrap: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 1985 return 0; 1986 } 1987 1988 # If -1 is used in either the row or col parameter, use the last row or cell 1989 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 1990 $col = $self->{last_col} if $col == -1; 1991 1992 if (($row > $self->{$section}[$section_num]->{last_row}) || ($row < 1) ) { 1993 print STDERR "$0:setSectionCellNoWrap:Invalid table reference\n"; 1994 return 0; 1995 } 1996 if (($col > $self->{last_col}) || ($col < 1) ) { 1997 print STDERR "$0:setSectionCellNoWrap:Invalid table reference\n"; 1998 return 0; 1999 } 2000 2001 $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{nowrap} = $value; 2002 return ($row, $col); 2003} 2004 2005#------------------------------------------------------- 2006# Subroutine: setCellNoWrap(row_num, col_num, [0|1]) 2007# Author: Stacy Lacy 2008# Date: 30 Jul 1997 2009# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 2010# Modified: 12 Sept 2007 - Anthony Peacock 2011#------------------------------------------------------- 2012sub setCellNoWrap { 2013 my $self = shift; 2014 (my $row = shift) || return 0; 2015 (my $col = shift) || return 0; 2016 (my $value = shift); 2017 2018 $self->setSectionCellNoWrap ( 'tbody', 0, $row, $col, $value ); 2019} 2020 2021#------------------------------------------------------- 2022# Subroutine: setSectionCellWidth('section', section_num, row_num, col_num, [pixels|percentoftable]) 2023# Author: Anthony Peacock 2024# Date: 12 Sept 2007 2025# Based on: setCellWidth 2026#------------------------------------------------------- 2027sub setSectionCellWidth { 2028 my $self = shift; 2029 my $section = shift; 2030 my $section_num = shift; 2031 (my $row = shift) || return 0; 2032 (my $col = shift) || return 0; 2033 (my $value = shift); 2034 2035 if ( $section !~ /thead|tbody|tfoot/i ) { 2036 print STDERR "\nsetSectionCellWidth: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 2037 return 0; 2038 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 2039 print STDERR "\nsetSectionCellWidth: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 2040 return 0; 2041 } 2042 2043 # If -1 is used in either the row or col parameter, use the last row or cell 2044 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 2045 $col = $self->{last_col} if $col == -1; 2046 2047 if (($row > $self->{$section}[$section_num]->{last_row}) || ($row < 1) ) { 2048 print STDERR "$0:setSectionCellWidth:Invalid table reference\n"; 2049 return 0; 2050 } 2051 if (($col > $self->{last_col}) || ($col < 1) ) { 2052 print STDERR "$0:setSectionCellWidth:Invalid table reference\n"; 2053 return 0; 2054 } 2055 2056 if (! $value) { 2057 #return to default alignment if none specified 2058 undef $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{width}; 2059 return ($row, $col); 2060 } 2061 2062 if ( $value !~ /^\s*\d+%?/ ) { 2063 print STDERR "$0:setSectionCellWidth:Invalid value $value\n"; 2064 return 0; 2065 } else { 2066 $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{width} = $value; 2067 return ($row, $col); 2068 } 2069} 2070 2071#------------------------------------------------------- 2072# Subroutine: setCellWidth(row_num, col_num, [pixels|percentoftable]) 2073# Author: Stacy Lacy 2074# Date: 30 Jul 1997 2075# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 2076# Modified: 12 Sept 2007 2077#------------------------------------------------------- 2078sub setCellWidth { 2079 my $self = shift; 2080 (my $row = shift) || return 0; 2081 (my $col = shift) || return 0; 2082 (my $value = shift); 2083 2084 $self->setSectionCellWidth ( 'tbody', 0, $row, $col, $value ); 2085} 2086 2087#------------------------------------------------------- 2088# Subroutine: setSectionCellHeight('section', section_num, row_num, col_num, [pixels]) 2089# Author: Anthony Peacock 2090# Date: 12 Sept 2007 2091# Based on: setCellHeight 2092#------------------------------------------------------- 2093sub setSectionCellHeight { 2094 my $self = shift; 2095 my $section = shift; 2096 my $section_num = shift; 2097 (my $row = shift) || return 0; 2098 (my $col = shift) || return 0; 2099 (my $value = shift); 2100 2101 if ( $section !~ /thead|tbody|tfoot/i ) { 2102 print STDERR "\nsetSectionCellHeight: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 2103 return 0; 2104 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 2105 print STDERR "\nsetSectionCellHeight: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 2106 return 0; 2107 } 2108 2109 # If -1 is used in either the row or col parameter, use the last row or cell 2110 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 2111 $col = $self->{last_col} if $col == -1; 2112 2113 if (($row > $self->{$section}[$section_num]->{last_row}) || ($row < 1) ) { 2114 print STDERR "$0:setSectionCellHeight:Invalid table reference\n"; 2115 return 0; 2116 } 2117 if (($col > $self->{last_col}) || ($col < 1) ) { 2118 print STDERR "$0:setSectionCellHeight:Invalid table reference\n"; 2119 return 0; 2120 } 2121 2122 if (! $value) { 2123 #return to default alignment if none specified 2124 undef $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{height}; 2125 return ($row, $col); 2126 } 2127 2128 $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{height} = $value; 2129 return ($row, $col); 2130} 2131 2132#------------------------------------------------------- 2133# Subroutine: setCellHeight(row_num, col_num, [pixels]) 2134# Author: Stacy Lacy 2135# Date: 30 Jul 1997 2136# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 2137# Modified: 12 Sept 2007 2138#------------------------------------------------------- 2139sub setCellHeight { 2140 my $self = shift; 2141 (my $row = shift) || return 0; 2142 (my $col = shift) || return 0; 2143 (my $value = shift); 2144 2145 $self->setSectionCellHeight ( 'tbody', 0, $row, $col, $value ); 2146 return ($row, $col); 2147} 2148 2149#------------------------------------------------------- 2150# Subroutine: setSectionCellBGColor('section', section_num, row_num, col_num, [colorname|colortrip]) 2151# Author: Anthony Peacock 2152# Date: 12 Sept 2007 2153# Based on: setCellBGColor 2154#------------------------------------------------------- 2155sub setSectionCellBGColor { 2156 my $self = shift; 2157 my $section = shift; 2158 my $section_num = shift; 2159 (my $row = shift) || return 0; 2160 (my $col = shift) || return 0; 2161 (my $value = shift); 2162 2163 if ( $section !~ /thead|tbody|tfoot/i ) { 2164 print STDERR "\nsetSectionCellBGColor: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 2165 return 0; 2166 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 2167 print STDERR "\nsetSectionCellBGColor: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 2168 return 0; 2169 } 2170 2171 # If -1 is used in either the row or col parameter, use the last row or cell 2172 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 2173 $col = $self->{last_col} if $col == -1; 2174 2175 if (($row > $self->{$section}[$section_num]->{last_row}) || ($row < 1) ) { 2176 print STDERR "$0:setSectionCellBGColor:Invalid table reference\n"; 2177 return 0; 2178 } 2179 if (($col > $self->{last_col}) || ($col < 1) ) { 2180 print STDERR "$0:setSectionCellBGColor:Invalid table reference\n"; 2181 return 0; 2182 } 2183 2184 if (! $value) { 2185 #return to default alignment if none specified 2186 undef $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{bgcolor}; 2187 } 2188 2189 # BG colors are too hard to verify, let's assume user 2190 # knows what they are doing 2191 $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{bgcolor} = $value; 2192 return ($row, $col); 2193} 2194 2195#------------------------------------------------------- 2196# Subroutine: setCellBGColor(row_num, col_num, [colorname|colortrip]) 2197# Author: Stacy Lacy 2198# Date: 30 Jul 1997 2199# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 2200# Modified: 12 Sept 2007 - Anthony Peacock 2201#------------------------------------------------------- 2202sub setCellBGColor { 2203 my $self = shift; 2204 (my $row = shift) || return 0; 2205 (my $col = shift) || return 0; 2206 (my $value = shift); 2207 2208 $self->setSectionCellBGColor ( 'tbody', 0, $row, $col, $value ); 2209} 2210 2211#------------------------------------------------------- 2212# Subroutine: setSectionCellSpan('section', section_num, row_num, col_num, num_rows, num_cols) 2213# Author: Anthony Peacock 2214# Date: 12 Sept 2007 2215# Based on: setCellSpan 2216#------------------------------------------------------- 2217sub setSectionCellSpan { 2218 my $self = shift; 2219 my $section = shift; 2220 my $section_num = shift; 2221 (my $row = shift) || return 0; 2222 (my $col = shift) || return 0; 2223 (my $num_rows = shift); 2224 (my $num_cols = shift); 2225 2226 if ( $section !~ /thead|tbody|tfoot/i ) { 2227 print STDERR "\nsetSectionCellSpan: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 2228 return 0; 2229 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 2230 print STDERR "\nsetSectionCellSpan: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 2231 return 0; 2232 } 2233 2234 # If -1 is used in either the row or col parameter, use the last row or cell 2235 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 2236 $col = $self->{last_col} if $col == -1; 2237 2238 if (($row > $self->{$section}[$section_num]->{last_row}) || ($row < 1) ) { 2239 print STDERR "$0:setSectionCellSpan:Invalid table reference\n"; 2240 return 0; 2241 } 2242 if (($col > $self->{last_col}) || ($col < 1) ) { 2243 print STDERR "$0:setSectionCellSpan:Invalid table reference\n"; 2244 return 0; 2245 } 2246 2247 if (! $num_cols || ! $num_rows) { 2248 #return to default if none specified 2249 undef $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{colspan}; 2250 undef $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{rowspan}; 2251 } 2252 2253 $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{colspan} = $num_cols; 2254 $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{rowspan} = $num_rows; 2255 2256 $self->_updateSpanGrid($section, $section_num, $row,$col); 2257 2258 return ($row, $col); 2259} 2260 2261#------------------------------------------------------- 2262# Subroutine: setCellSpan(row_num, col_num, num_rows, num_cols) 2263# Author: Anthony Peacock 2264# Date: 22 July 2002 2265# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 2266# Modified: 12 Sept 2007 - Anthony Peacock 2267#------------------------------------------------------- 2268sub setCellSpan { 2269 my $self = shift; 2270 (my $row = shift) || return 0; 2271 (my $col = shift) || return 0; 2272 (my $num_rows = shift); 2273 (my $num_cols = shift); 2274 2275 return $self->setSectionCellSpan ('tbody', 0, $row, $col, $num_rows, $num_cols); 2276} 2277 2278#------------------------------------------------------- 2279# Subroutine: setSectionCellRowSpan('section', section_num, row_num, col_num, num_cells) 2280# Author: Anthony Peacock 2281# Date: 10 September 2007 2282# Based on: setCellRowSpan 2283#------------------------------------------------------- 2284sub setSectionCellRowSpan { 2285 my $self = shift; 2286 my $section = lc(shift); 2287 my $section_num = shift; 2288 (my $row = shift) || return 0; 2289 (my $col = shift) || return 0; 2290 (my $value = shift); 2291 2292 if ( $section !~ /thead|tbody|tfoot/i ) { 2293 print STDERR "\nsetSectionCellRowSpan: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 2294 return 0; 2295 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 2296 print STDERR "\nsetSectionCellRowSpan: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 2297 return 0; 2298 } 2299 2300 # If -1 is used in either the row or col parameter, use the last row or cell 2301 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 2302 $col = $self->{last_col} if $col == -1; 2303 2304 if (($row > $self->{$section}[$section_num]->{last_row}) || ($row < 1) ) { 2305 print STDERR "$0:setSectionCellRowSpan:Invalid table reference\n"; 2306 return 0; 2307 } 2308 if (($col > $self->{last_col}) || ($col < 1) ) { 2309 print STDERR "$0:setSectionCellRowSpan:Invalid table reference\n"; 2310 return 0; 2311 } 2312 2313 if (! $value) { 2314 #return to default alignment if none specified 2315 undef $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{rowspan}; 2316 } 2317 2318 $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{rowspan} = $value; 2319 2320 $self->_updateSpanGrid($section, $section_num, $row,$col); 2321 2322 return ($row, $col); 2323} 2324 2325#------------------------------------------------------- 2326# Subroutine: setCellRowSpan(row_num, col_num, num_cells) 2327# Author: Stacy Lacy 2328# Date: 31 Jul 1997 2329# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 2330# Modified: 10 Sept 2007 - Anthony Peacock 2331#------------------------------------------------------- 2332sub setCellRowSpan { 2333 my $self = shift; 2334 (my $row = shift) || return 0; 2335 (my $col = shift) || return 0; 2336 (my $value = shift); 2337 2338 return $self->setSectionCellRowSpan( 'tbody', 0, $row, $col, $value); 2339} 2340 2341#------------------------------------------------------- 2342# Subroutine: setSectionCellColSpan(row_num, col_num, num_cells) 2343# Author: Anthony Peacock 2344# Date: 12 Sept 2007 2345# Based on: setCellColSpan 2346#------------------------------------------------------- 2347sub setSectionCellColSpan { 2348 my $self = shift; 2349 my $section = shift; 2350 my $section_num = shift; 2351 (my $row = shift) || return 0; 2352 (my $col = shift) || return 0; 2353 (my $value = shift); 2354 2355 if ( $section !~ /thead|tbody|tfoot/i ) { 2356 print STDERR "\nsetSectionCellColSpan: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 2357 return 0; 2358 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 2359 print STDERR "\nsetSectionCellColSpan: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 2360 return 0; 2361 } 2362 2363 # If -1 is used in either the row or col parameter, use the last row or cell 2364 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 2365 $col = $self->{last_col} if $col == -1; 2366 2367 if (($row > $self->{$section}[$section_num]->{last_row}) || ($row < 1) ) { 2368 print STDERR "$0:setSectionCellColSpan:Invalid table reference\n"; 2369 return 0; 2370 } 2371 2372 if (($col > $self->{last_col}) || ($col < 1) ) { 2373 print STDERR "$0:setSectionCellColSpan:Invalid table reference\n"; 2374 return 0; 2375 } 2376 2377 if (! $value) { 2378 #return to default alignment if none specified 2379 undef $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{colspan}; 2380 } 2381 2382 $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{colspan} = $value; 2383 2384 $self->_updateSpanGrid($section, $section_num, $row,$col); 2385 2386 return ($row, $col); 2387} 2388 2389#------------------------------------------------------- 2390# Subroutine: setCellColSpan(row_num, col_num, num_cells) 2391# Author: Stacy Lacy 2392# Date: 31 Jul 1997 2393# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 2394#------------------------------------------------------- 2395sub setCellColSpan { 2396 my $self = shift; 2397 (my $row = shift) || return 0; 2398 (my $col = shift) || return 0; 2399 (my $value = shift); 2400 2401 return $self->setSectionCellColSpan ( 'tbody', 0, $row, $col, $value ); 2402} 2403 2404#------------------------------------------------------- 2405# Subroutine: setSectionCellFormat('section', section_num, row_num, col_num, start_string, end_string) 2406# Author: Anthony Peacock 2407# Date: 12 Sept 2007 2408# Description: Sets start and end HTML formatting strings for 2409# the cell content 2410# Based on: setCellFormat 2411#------------------------------------------------------- 2412sub setSectionCellFormat { 2413 my $self = shift; 2414 my $section = shift; 2415 my $section_num = shift; 2416 (my $row = shift) || return 0; 2417 (my $col = shift) || return 0; 2418 (my $start_string = shift); 2419 (my $end_string = shift); 2420 2421 if ( $section !~ /thead|tbody|tfoot/i ) { 2422 print STDERR "\nsetSectionCellFormat: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 2423 return 0; 2424 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 2425 print STDERR "\nsetSectionCellFormat: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 2426 return 0; 2427 } 2428 2429 # If -1 is used in either the row or col parameter, use the last row or cell 2430 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 2431 $col = $self->{last_col} if $col == -1; 2432 2433 if (($row > $self->{$section}[$section_num]->{last_row}) || ($row < 1) ) { 2434 print STDERR "$0:setSectionCellFormat:Invalid table reference\n"; 2435 return 0; 2436 } 2437 if (($col > $self->{last_col}) || ($col < 1) ) { 2438 print STDERR "$0:setSectionCellFormat:Invalid table reference\n"; 2439 return 0; 2440 } 2441 2442 if (! $start_string) { 2443 #return to default format if none specified 2444 undef $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{startformat}; 2445 undef $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{endformat}; 2446 } 2447 else 2448 { 2449 # No checks will be made on the validity of these strings 2450 # User must take responsibility for results... 2451 $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{startformat} = $start_string; 2452 $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{endformat} = $end_string; 2453 } 2454 return ($row, $col); 2455} 2456 2457#------------------------------------------------------- 2458# Subroutine: setCellFormat(row_num, col_num, start_string, end_string) 2459# Author: Anthony Peacock 2460# Date: 21 Feb 2001 2461# Description: Sets start and end HTML formatting strings for 2462# the cell content 2463# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 2464# Modified: 12 Sept 2007 - Anthony Peacock 2465#------------------------------------------------------- 2466sub setCellFormat { 2467 my $self = shift; 2468 (my $row = shift) || return 0; 2469 (my $col = shift) || return 0; 2470 (my $start_string = shift); 2471 (my $end_string = shift); 2472 2473 return $self->setSectionCellFormat ( 'tbody', 0, $row, $col, $start_string, $end_string ); 2474} 2475 2476#------------------------------------------------------- 2477# Subroutine: setSectionCellStyle('section', section_num, row_num, col_num, "Style") 2478# Author: Anthony Peacock 2479# Date: 12 Sept 2007 2480# Based on: setCellStyle 2481#------------------------------------------------------- 2482sub setSectionCellStyle { 2483 my $self = shift; 2484 my $section = shift; 2485 my $section_num = shift; 2486 (my $row = shift) || return 0; 2487 (my $col = shift) || return 0; 2488 (my $value = shift); 2489 2490 if ( $section !~ /thead|tbody|tfoot/i ) { 2491 print STDERR "\nsetSectionCellStyle: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 2492 return 0; 2493 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 2494 print STDERR "\nsetSectionCellStyle: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 2495 return 0; 2496 } 2497 2498 # If -1 is used in either the row or col parameter, use the last row or cell 2499 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 2500 $col = $self->{last_col} if $col == -1; 2501 2502 if (($row > $self->{$section}[$section_num]->{last_row}) || ($row < 1) ) { 2503 print STDERR "$0:setSectionCellStyle:Invalid table reference\n"; 2504 return 0; 2505 } 2506 if (($col > $self->{last_col}) || ($col < 1) ) { 2507 print STDERR "$0:setSectionCellStyle:Invalid table reference\n"; 2508 return 0; 2509 } 2510 2511 if (! $value) { 2512 #return to default style if none specified 2513 undef $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{style}; 2514 return ($row, $col); 2515 } 2516 2517 $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{style} = $value; 2518 return ($row, $col); 2519} 2520 2521#------------------------------------------------------- 2522# Subroutine: setCellStyle(row_num, col_num, "Style") 2523# Author: Anthony Peacock 2524# Date: 10 Jan 2002 2525# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 2526# Modified: 12 Sept 2007 - Anthony Peacock 2527#------------------------------------------------------- 2528sub setCellStyle { 2529 my $self = shift; 2530 (my $row = shift) || return 0; 2531 (my $col = shift) || return 0; 2532 (my $value = shift); 2533 2534 return $self->setSectionCellStyle ( 'tbody', 0, $row, $col, $value ); 2535} 2536 2537#------------------------------------------------------- 2538# Subroutine: setSectionCellClass('section', section_num, row_num, col_num, "class") 2539# Author: Anthony Peacock 2540# Date: 12 Sept 2007 2541# Based on: setCellClass 2542#------------------------------------------------------- 2543sub setSectionCellClass { 2544 my $self = shift; 2545 my $section = shift; 2546 my $section_num = shift; 2547 (my $row = shift) || return 0; 2548 (my $col = shift) || return 0; 2549 (my $value = shift); 2550 2551 if ( $section !~ /thead|tbody|tfoot/i ) { 2552 print STDERR "\nsetSectionCellClass: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 2553 return 0; 2554 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 2555 print STDERR "\nsetSectionCellClass: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 2556 return 0; 2557 } 2558 2559 # If -1 is used in either the row or col parameter, use the last row or cell 2560 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 2561 $col = $self->{last_col} if $col == -1; 2562 2563 if (($row > $self->{$section}[$section_num]->{last_row}) || ($row < 1) ) { 2564 print STDERR "$0:setSectionCellClass:Invalid table reference\n"; 2565 return 0; 2566 } 2567 if (($col > $self->{last_col}) || ($col < 1) ) { 2568 print STDERR "$0:setSectionCellClass:Invalid table reference\n"; 2569 return 0; 2570 } 2571 2572 if (! $value) { 2573 #return to default class if none specified 2574 undef $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{class}; 2575 return ($row, $col); 2576 } 2577 2578 $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{class} = $value; 2579 return ($row, $col); 2580} 2581 2582#------------------------------------------------------- 2583# Subroutine: setCellClass(row_num, col_num, "class") 2584# Author: Anthony Peacock 2585# Date: 22 July 2002 2586# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 2587#------------------------------------------------------- 2588sub setCellClass { 2589 my $self = shift; 2590 (my $row = shift) || return 0; 2591 (my $col = shift) || return 0; 2592 (my $value = shift); 2593 2594 $self->setSectionCellClass ( 'tbody', 0, $row, $col, $value ); 2595} 2596 2597#------------------------------------------------------- 2598# Subroutine: setSectionCellAttr('section', section_num, row_num, col_num, "cell attribute string") 2599# Author: Anthony Peacock 2600# Date: 12 Sept 2007 2601# Based on: setCellAttr 2602#------------------------------------------------------- 2603sub setSectionCellAttr { 2604 my $self = shift; 2605 my $section = shift; 2606 my $section_num = shift; 2607 (my $row = shift) || return 0; 2608 (my $col = shift) || return 0; 2609 (my $value = shift); 2610 2611 if ( $section !~ /thead|tbody|tfoot/i ) { 2612 print STDERR "\nsetSectionCellAttr: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 2613 return 0; 2614 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 2615 print STDERR "\nsetSectionCellAttr: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 2616 return 0; 2617 } 2618 2619 # If -1 is used in either the row or col parameter, use the last row or cell 2620 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 2621 $col = $self->{last_col} if $col == -1; 2622 2623 if (($row > $self->{$section}[$section_num]->{last_row}) || ($row < 1) ) { 2624 print STDERR "$0:setSectionCellAttr:Invalid table reference\n"; 2625 return 0; 2626 } 2627 if (($col > $self->{last_col}) || ($col < 1) ) { 2628 print STDERR "$0:setSectionCellAttr:Invalid table reference\n"; 2629 return 0; 2630 } 2631 2632 if (! $value) { 2633 undef $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{attr}; 2634 } 2635 2636 $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{attr} = $value; 2637 return ($row, $col); 2638} 2639 2640#------------------------------------------------------- 2641# Subroutine: setCellAttr(row_num, col_num, "cell attribute string") 2642# Author: Anthony Peacock 2643# Date: 10 Jan 2002 2644# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 2645# Modified: 12 Sept 2007 - Anthony Peacock 2646#------------------------------------------------------- 2647sub setCellAttr { 2648 my $self = shift; 2649 (my $row = shift) || return 0; 2650 (my $col = shift) || return 0; 2651 (my $value = shift); 2652 2653 return $self->setSectionCellAttr ( 'tbody', 0, $row, $col, $value ); 2654} 2655 2656#------------------------------------------------------- 2657# Row config methods 2658# 2659#------------------------------------------------------- 2660 2661 2662#------------------------------------------------------- 2663# Subroutine: addSectionRow("Section", section_num, "cell 1 content" [, "cell 2 content", ...]) 2664# Author: Anthony Peacock 2665# Date: 10 August 2007 2666# Modified: 2667#------------------------------------------------------- 2668sub addSectionRow { 2669 my $self = shift; 2670 my $section = lc(shift); 2671 my $section_num = shift; 2672 2673 if ( $section !~ /thead|tbody|tfoot/i ) { 2674 print STDERR "\naddSectionRow: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 2675 return 0; 2676 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 2677 print STDERR "\naddSectionRow: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 2678 return 0; 2679 } 2680 2681 # this sub should add a row, using @_ as contents 2682 my $count = @_; 2683 # if number of cells is greater than cols, let's assume 2684 # we want to add a column. 2685 $self->{last_col} = $count if ($count > $self->{last_col}); 2686 2687 $self->{$section}[$section_num]->{last_row}++; # increment number of rows 2688 for (my $i = 1; $i <= $count; $i++) { 2689 # Store each value in cell on row 2690 $self->{$section}[$section_num]->{rows}[$self->{$section}[$section_num]{last_row}]->{cells}[$i]->{contents} = shift; 2691 } 2692 return $self->{$section}[$section_num]{last_row}; 2693 2694} 2695 2696#------------------------------------------------------- 2697# Subroutine: addRow("cell 1 content" [, "cell 2 content", ...]) 2698# Author: Stacy Lacy 2699# Date: 30 Jul 1997 2700# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 2701#------------------------------------------------------- 2702sub addRow { 2703 my $self = shift; 2704 2705 my $last_row = $self->addSectionRow ( 'tbody', 0, @_ ); 2706 return $last_row; 2707} 2708 2709#------------------------------------------------------- 2710# Subroutine: delSectionRow("Section", section_num, row_num) 2711# Author: Anthony Peacock 2712# Date: 10 April 2008 2713# Modified: 2714#------------------------------------------------------- 2715sub delSectionRow { 2716 my $self = shift; 2717 my $section = lc(shift); 2718 my $section_num = shift; 2719 my $row_num = shift; 2720 2721 if ( $section !~ /thead|tbody|tfoot/i ) { 2722 print STDERR "\ndelSectionRow: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 2723 return 0; 2724 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 2725 print STDERR "\ndelSectionRow: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 2726 return 0; 2727 } 2728 2729 # If -1 is used in the row parameter, use the last row 2730 $row_num = $self->{$section}[$section_num]->{last_row} if $row_num == -1; 2731 2732 # Deleting the last row 2733 #if ( $row_num == $self->{$section}[$section_num]->{last_row} ) { 2734 # $self->{$section}[$section_num]->{rows}[$row_num] = undef; 2735 #} 2736 2737 splice ( @{$self->{$section}[$section_num]->{rows}}, $row_num, 1 ); 2738 2739 $self->{$section}[$section_num]->{last_row}--; # decrement number of rows 2740 return $self->{$section}[$section_num]{last_row}; 2741 2742} 2743 2744#------------------------------------------------------- 2745# Subroutine: delRow(row_num) 2746# Author: Anthony Peacock 2747# Date: 10 April 2008 2748# Modified: 2749#------------------------------------------------------- 2750sub delRow { 2751 my $self = shift; 2752 my $row_num = shift; 2753 2754 my $last_row = $self->delSectionRow ( 'tbody', 0, $row_num ); 2755 return $last_row; 2756} 2757 2758#------------------------------------------------------- 2759# Subroutine: setSectionRowAlign('section', section_num, row_num, [center|right|left]) 2760# Author: Anthony Peacock 2761# Date: 11 Sept 2007 2762# Based on: setRowAlign 2763#------------------------------------------------------- 2764sub setSectionRowAlign { 2765 my $self = shift; 2766 my $section = shift; 2767 my $section_num = shift; 2768 (my $row = shift) || return 0; 2769 my $align = shift; 2770 2771 if ( $section !~ /thead|tbody|tfoot/i ) { 2772 print STDERR "\nsetSectionRowAlign: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 2773 return 0; 2774 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 2775 print STDERR "\nsetSectionRowAlign: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 2776 return 0; 2777 } 2778 2779 # If -1 is used in the row parameter, use the last row 2780 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 2781 2782 if ( $row > $self->{$section}[$section_num]->{last_row} || $row < 1 ) { 2783 print STDERR "\n$0:setSectionRowAlign: Invalid table reference" ; 2784 return 0; 2785 } elsif ( $align !~ /left|right|center/i ) { 2786 print STDERR "\nsetSectionRowAlign: Alignment can be : 'left | right | center' : Cur value: $align\n"; 2787 return 0; 2788 } 2789 2790 $self->{$section}[$section_num]->{rows}[$row]->{align} = $align ; 2791} 2792 2793#------------------------------------------------------- 2794# Subroutine: setRowAlign(row_num, [center|right|left]) 2795# Author: Stacy Lacy 2796# Date: 30 Jul 1997 2797# Modified: 05 Jan 2002 - Arno Teunisse 2798# Modified: 10 Jan 2002 - Anthony Peacock 2799# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 2800# Modified: 11 Sept 2007 - Anthony Peacock 2801#------------------------------------------------------- 2802sub setRowAlign { 2803 my $self = shift; 2804 (my $row = shift) || return 0; 2805 my $align = shift; 2806 2807 $self->setSectionRowAlign ( 'tbody', 0, $row, $align ); 2808} 2809 2810#------------------------------------------------------- 2811# Subroutine: setSectionRowStyle 2812# Comment: to insert a css style the <tr > Tag 2813# Author: Anthony Peacock 2814# Date: 11 Sept 2007 2815# Based on: setRowStyle by Arno Teunisse 2816#------------------------------------------------------- 2817sub setSectionRowStyle { 2818 my $self = shift; 2819 my $section = shift; 2820 my $section_num = shift; 2821 (my $row = shift) || return 0; 2822 my $html_str = shift; 2823 2824 if ( $section !~ /thead|tbody|tfoot/i ) { 2825 print STDERR "\nsetSectionRowStyle: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 2826 return 0; 2827 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 2828 print STDERR "\nsetSectionRowStyle: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 2829 return 0; 2830 } 2831 2832 # If -1 is used in the row parameter, use the last row 2833 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 2834 2835 if ( $row > $self->{$section}[$section_num]->{last_row} || $row < 1 ) { 2836 print STDERR "\n$0:setSectionRowStyle: Invalid table reference" ; 2837 return 0; 2838 } 2839 2840 $self->{$section}[$section_num]->{rows}[$row]->{style} = $html_str ; 2841} 2842 2843#------------------------------------------------------- 2844# Subroutine: setRowStyle 2845# Comment: to insert a css style the <tr > Tag 2846# Author: Arno Teunisse 2847# Date: 05 Jan 2002 2848# Modified: 10 Jan 2002 - Anthony Peacock 2849# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 2850# Modified: 11 Sept 2007 - Anthony Peaock 2851#------------------------------------------------------- 2852sub setRowStyle { 2853 my $self = shift; 2854 (my $row = shift) || return 0; 2855 my $html_str = shift; 2856 2857 $self->setSectionRowStyle ( 'tbody', 0, $row, $html_str ); 2858} 2859 2860#------------------------------------------------------- 2861# Subroutine: setSectionRowClass 2862# Comment: to insert a css class in the <tr > Tag 2863# Author: Anthony Peacock (based on setRowStyle by Arno Teunisse) 2864# Date: 11 Sept 2007 2865# Based on: setRowClass 2866#------------------------------------------------------- 2867sub setSectionRowClass { 2868 my $self = shift; 2869 my $section = shift; 2870 my $section_num = shift; 2871 (my $row = shift) || return 0; 2872 my $html_str = shift; 2873 2874 if ( $section !~ /thead|tbody|tfoot/i ) { 2875 print STDERR "\nsetSectionRowClass: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 2876 return 0; 2877 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 2878 print STDERR "\nsetSectionRowClass: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 2879 return 0; 2880 } 2881 2882 # If -1 is used in the row parameter, use the last row 2883 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 2884 2885 if ( $row > $self->{$section}[$section_num]->{last_row} || $row < 1 ) { 2886 print STDERR "\n$0:setSectionRowClass: Invalid table reference" ; 2887 return 0; 2888 } 2889 2890 $self->{$section}[$section_num]->{rows}[$row]->{class} = $html_str ; 2891} 2892 2893#------------------------------------------------------- 2894# Subroutine: setRowClass 2895# Comment: to insert a css class in the <tr > Tag 2896# Author: Anthony Peacock (based on setRowStyle by Arno Teunisse) 2897# Date: 22 July 2002 2898# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 2899# Modified: 11 Sept 2007 - Anthony Peacock 2900#------------------------------------------------------- 2901sub setRowClass { 2902 my $self = shift; 2903 (my $row = shift) || return 0; 2904 my $html_str = shift; 2905 2906 $self->setSectionRowClass ( 'tbody', 0, $row, $html_str ); 2907} 2908 2909 2910#------------------------------------------------------- 2911# Subroutine: setSectionRowVAlign('section', section_num, row_num, [center|top|bottom]) 2912# Author: Anthony Peacock 2913# Date: 11 Sept 2007 2914# Based on: setRowVAlign 2915#------------------------------------------------------- 2916sub setSectionRowVAlign { 2917 my $self = shift; 2918 my $section = shift; 2919 my $section_num = shift; 2920 (my $row = shift) || return 0; 2921 my $valign = shift; 2922 2923 if ( $section !~ /thead|tbody|tfoot/i ) { 2924 print STDERR "\nsetSectionRowVAlign: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 2925 return 0; 2926 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 2927 print STDERR "\nsetSectionRowVAlign: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 2928 return 0; 2929 } 2930 2931 # If -1 is used in the row parameter, use the last row 2932 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 2933 2934 if ( $row > $self->{$section}[$section_num]->{last_row} || $row < 1 ) { 2935 print STDERR "\n$0:setSectionRowVAlign: Invalid table reference" ; 2936 return 0; 2937 } 2938 2939 $self->{$section}[$section_num]->{rows}[$row]->{valign} = $valign ; 2940} 2941 2942#------------------------------------------------------- 2943# Subroutine: setRowVAlign(row_num, [center|top|bottom]) 2944# Author: Stacy Lacy 2945# Date: 30 Jul 1997 2946# Modified: 23 Oct 2003 - Anthony Peacock 2947# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 2948# Modified: 11 Sept 2007 - Anthony Peacock 2949#------------------------------------------------------- 2950sub setRowVAlign { 2951 my $self = shift; 2952 (my $row = shift) || return 0; 2953 my $valign = shift; 2954 2955 $self->setSectionRowVAlign ( 'tbody', 0, $row, $valign ); 2956} 2957 2958#------------------------------------------------------- 2959# Subroutine: setSectionRowNoWrap('section', section_num, row_num, [0|1]) 2960# Author: Anthony Peacock 2961# Date: 11 September 2007 2962# Based on: setRowNoWrap 2963#------------------------------------------------------- 2964sub setSectionRowNoWrap { 2965 my $self = shift; 2966 my $section = shift; 2967 my $section_num = shift; 2968 (my $row = shift) || return 0; 2969 my $value = shift; 2970 2971 if ( $section !~ /thead|tbody|tfoot/i ) { 2972 print STDERR "\nsetSectionRowNoWrap: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 2973 return 0; 2974 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 2975 print STDERR "\nsetSectionRowNoWrap: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 2976 return 0; 2977 } 2978 2979 # If -1 is used in the row parameter, use the last row 2980 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 2981 2982 if ( $row > $self->{$section}[$section_num]->{last_row} || $row < 1 ) { 2983 print STDERR "\n$0:setSectionRowNoWrap: Invalid table reference" ; 2984 return 0; 2985 } 2986 2987 $self->{$section}[$section_num]->{rows}[$row]->{nowrap} = $value ; 2988} 2989 2990#------------------------------------------------------- 2991# Subroutine: setRowNoWrap(row_num, [0|1]) 2992# Author: Anthony Peacock 2993# Date: 22 Feb 2001 2994# Modified: 23 Oct 2003 - Anthony Peacock 2995# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 2996# Modified: 11 September 2007 - Anthony Peacock 2997#------------------------------------------------------- 2998sub setRowNoWrap { 2999 my $self = shift; 3000 (my $row = shift) || return 0; 3001 my $value = shift; 3002 3003 $self->setSectionRowNoWrap ( 'tbody', 0, $row, $value ) ; 3004} 3005 3006#------------------------------------------------------- 3007# Subroutine: setSectionRowBGColor('section', section_num, row_num, [colorname|colortriplet]) 3008# Author: Anthony Peacock 3009# Date: 10 Sep 2007 3010# Based On: setRowBGColor 3011#------------------------------------------------------- 3012sub setSectionRowBGColor { 3013 my $self = shift; 3014 my $section = lc(shift); 3015 my $section_num = shift; 3016 (my $row = shift) || return 0; 3017 my $value = shift; 3018 3019 if ( $section !~ /thead|tbody|tfoot/i ) { 3020 print STDERR "\nsetSectionRowBGColor: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 3021 return 0; 3022 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 3023 print STDERR "\nsetSectionRowBGColor: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 3024 return 0; 3025 } 3026 3027 # If -1 is used in the row parameter, use the last row 3028 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 3029 3030 # You cannot set a nonexistent row 3031 if ( $row > $self->{$section}[$section_num]->{last_row} || $row < 1 ) { 3032 print STDERR "\n$0:setSectionRowBGColor: Invalid table reference" ; 3033 return 0; 3034 } 3035 3036 $self->{$section}[$section_num]->{rows}[$row]->{bgcolor} = $value ; 3037} 3038 3039#------------------------------------------------------- 3040# Subroutine: setRowBGColor(row_num, [colorname|colortriplet]) 3041# Author: Arno Teunisse 3042# Date: 08 Jan 2002 3043# Modified: 10 Jan 2002 - Anthony Peacock 3044# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 3045# Modified: 10 Sept 2007 - Anthony Peacock 3046#------------------------------------------------------- 3047sub setRowBGColor { 3048 my $self = shift; 3049 (my $row = shift) || return 0; 3050 my $value = shift; 3051 3052 $self->setSectionRowBGColor ( 'tbody', 0, $row, $value ); 3053} 3054 3055#------------------------------------------------------- 3056# Subroutine: setSectionRowAttr('section', section_num, row, "Attribute string") 3057# Comment: To add user defined attribute to specified row in a section 3058# Author: Anthony Peacock 3059# Date: 10 September 2007 3060# Modified: 3061#------------------------------------------------------- 3062sub setSectionRowAttr { 3063 my $self = shift; 3064 my $section = lc(shift); 3065 my $section_num = shift; 3066 (my $row = shift) || return 0; 3067 my $html_str = shift; 3068 3069 if ( $section !~ /thead|tbody|tfoot/i ) { 3070 print STDERR "\nsetSectionRowAttr: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 3071 return 0; 3072 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 3073 print STDERR "\nsetSectionRowAttr: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 3074 return 0; 3075 } 3076 3077 # If -1 is used in the row parameter, use the last row 3078 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 3079 3080 # You cannot set a nonexistent row 3081 if ( $row > $self->{$section}[$section_num]->{last_row} || $row < 1 ) { 3082 print STDERR "\n$0:setRowAttr: Invalid table reference" ; 3083 return 0; 3084 } 3085 3086 $self->{$section}[$section_num]->{rows}[$row]->{attr} = $html_str; 3087} 3088 3089#------------------------------------------------------- 3090# Subroutine: setRowAttr(row, "Attribute string") 3091# Comment: To add user defined attribute to specified row 3092# Author: Anthony Peacock 3093# Date: 10 Jan 2002 3094# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 3095#------------------------------------------------------- 3096sub setRowAttr { 3097 my $self = shift; 3098 (my $row = shift) || return 0; 3099 my $html_str = shift; 3100 3101 $self->setSectionRowAttr ( 'tbody', 0, $row, $html_str ); 3102} 3103 3104# ----- Routines that work across a Row's Cells 3105 3106#------------------------------------------------------- 3107# Subroutine: setSectionRCellsHead('section', section_num, row_num, [0|1]) 3108# Author: Anthony Peacock 3109# Date: 10 April 2008 3110# Based on: setRowHead 3111#------------------------------------------------------- 3112sub setSectionRCellsHead { 3113 my $self = shift; 3114 my $section = shift; 3115 my $section_num = shift; 3116 (my $row = shift) || return 0; 3117 my $value = shift || 1; 3118 3119 if ( $section !~ /thead|tbody|tfoot/i ) { 3120 print STDERR "\nasetSectionRowHead: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 3121 return 0; 3122 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 3123 print STDERR "\nsetSectionRowHead: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 3124 return 0; 3125 } 3126 3127 # If -1 is used in the row parameter, use the last row 3128 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 3129 3130 if ( $row > $self->{$section}[$section_num]->{last_row} || $row < 1 ) { 3131 print STDERR "\n$0:setSectionRowHead: Invalid table reference" ; 3132 return 0; 3133 } 3134 3135 # this sub should change the head flag of a row; 3136 my $i; 3137 for ($i=1;$i <= $self->{last_col};$i++) { 3138 $self->setSectionCellHead($section, $section_num, $row, $i, $value); 3139 } 3140} 3141 3142#------------------------------------------------------- 3143# Subroutine: setSectionRowHead('section', section_num, row_num, [0|1]) 3144# Author: Anthony Peacock 3145# Date: 10 April 2008 3146# Based on: setRowHead 3147# Status: Deprecated by setSectionRCellsHead 3148#------------------------------------------------------- 3149sub setSectionRowHead { 3150 my $self = shift; 3151 my $section = shift; 3152 my $section_num = shift; 3153 (my $row = shift) || return 0; 3154 my $value = shift || 1; 3155 3156 return $self->setSectionRCellsHead ( $section, $section_num, $row, $value ); 3157} 3158 3159#------------------------------------------------------- 3160# Subroutine: setRCellsHead(row_num, [0|1]) 3161# Author: Anthony Peacock 3162# Date: 10 April 2008 3163#------------------------------------------------------- 3164sub setRCellsHead { 3165 my $self = shift; 3166 (my $row = shift) || return 0; 3167 my $value = shift || 1; 3168 3169 $self->setSectionRCellsHead ( 'tbody', 0, $row, $value); 3170} 3171 3172#------------------------------------------------------- 3173# Subroutine: setRowHead(row_num, [0|1]) 3174# Author: Stacy Lacy 3175# Date: 30 Jul 1997 3176# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 3177# Modified: 10 April 2008 - Anthony Peacock 3178# Status: Deprecated by setRCellsHead 3179#------------------------------------------------------- 3180sub setRowHead { 3181 my $self = shift; 3182 (my $row = shift) || return 0; 3183 my $value = shift || 1; 3184 3185 $self->setSectionRCellsHead ( 'tbody', 0, $row, $value); 3186} 3187 3188#------------------------------------------------------- 3189# Subroutine: setSectionRCellsWidth('Section', section_num', row_num, [pixels|percentoftable]) 3190# Author: Anthony Peacock 3191# Date: 10 April 2008 3192# Based on: setRowWidth 3193#------------------------------------------------------- 3194sub setSectionRCellsWidth { 3195 my $self = shift; 3196 my $section = lc(shift); 3197 my $section_num = shift; 3198 (my $row = shift) || return 0; 3199 my $value = shift; 3200 3201 if ( $section !~ /thead|tbody|tfoot/i ) { 3202 print STDERR "\nsetSectionRCellsWidth: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 3203 return 0; 3204 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 3205 print STDERR "\nsetSectionRCellsWidth: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 3206 return 0; 3207 } 3208 3209 # If -1 is used in the row parameter, use the last row 3210 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 3211 3212 if ( $row > $self->{$section}[$section_num]->{last_row} || $row < 1 ) { 3213 print STDERR "\n$0:setSectionRCellsWidth: Invalid table reference" ; 3214 return 0; 3215 } 3216 3217 # this sub should change the cell width of a row; 3218 my $i; 3219 for ($i=1;$i <= $self->{last_col};$i++) { 3220 $self->setSectionCellWidth($section, $section_num, $row, $i, $value); 3221 } 3222} 3223 3224#------------------------------------------------------- 3225# Subroutine: setSectionRowWidth('Section', section_num', row_num, [pixels|percentoftable]) 3226# Author: Anthony Peacock 3227# Date: 10 Sept 2007 3228# Modified: 10 April 2008 3229# Based on: setRowWidth 3230# Status: Deprecated by setSectionRCellsWidth 3231#------------------------------------------------------- 3232sub setSectionRowWidth { 3233 my $self = shift; 3234 my $section = lc(shift); 3235 my $section_num = shift; 3236 (my $row = shift) || return 0; 3237 my $value = shift; 3238 3239 return $self->setSectionRCellsWidth ( $section, $section_num, $row, $value ); 3240} 3241 3242#------------------------------------------------------- 3243# Subroutine: setRCellsWidth(row_num, [pixels|percentoftable]) 3244# Author: Anthony Peacock 3245# Date: 22 Feb 2001 3246# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 3247# Modified: 10 April 2008 - Anthony Peacock 3248#------------------------------------------------------- 3249sub setRCellsWidth { 3250 my $self = shift; 3251 (my $row = shift) || return 0; 3252 my $value = shift; 3253 3254 $self->setSectionRCellsWidth( 'tbody', 0, $row, $value); 3255} 3256 3257#------------------------------------------------------- 3258# Subroutine: setRowWidth(row_num, [pixels|percentoftable]) 3259# Author: Anthony Peacock 3260# Date: 22 Feb 2001 3261# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 3262# Modified: 10 April 2008 - Anthony Peacock 3263# Status: Deprecated by setRCellsWidth 3264#------------------------------------------------------- 3265sub setRowWidth { 3266 my $self = shift; 3267 (my $row = shift) || return 0; 3268 my $value = shift; 3269 3270 $self->setSectionRCellsWidth( 'tbody', 0, $row, $value); 3271} 3272 3273#------------------------------------------------------- 3274# Subroutine: setSectionRCellsHeight("Section", section_num, row_num, [pixels]) 3275# Author: Anthony Peacock 3276# Date: 10 April 2008 3277# Based on: setRowHeight 3278#------------------------------------------------------- 3279sub setSectionRCellsHeight { 3280 my $self = shift; 3281 my $section = lc(shift); 3282 my $section_num = shift; 3283 (my $row = shift) || return 0; 3284 my $value = shift; 3285 3286 if ( $section !~ /thead|tbody|tfoot/i ) { 3287 print STDERR "\nsetSectionRCellsHeight: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 3288 return 0; 3289 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 3290 print STDERR "\nsetSectionRCellsHeight: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 3291 return 0; 3292 } 3293 3294 # If -1 is used in the row parameter, use the last row 3295 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 3296 3297 if ( $row > $self->{$section}[$section_num]->{last_row} || $row < 1 ) { 3298 print STDERR "\n$0:setSectionRCellsHeight: Invalid table reference" ; 3299 return 0; 3300 } 3301 3302 # this sub should change the cell height of a row; 3303 my $i; 3304 for ($i=1;$i <= $self->{last_col};$i++) { 3305 $self->setSectionCellHeight($section, $section_num, $row, $i, $value); 3306 } 3307} 3308 3309#------------------------------------------------------- 3310# Subroutine: setSectionRowHeight("Section", section_num, row_num, [pixels]) 3311# Author: Anthony Peacock 3312# Date: 10 Sept 2007 3313# Modified: 10 April 2008 3314# Based on: setRowHeight 3315# Status: Deprecated by setSectionRCellsHeight 3316#------------------------------------------------------- 3317sub setSectionRowHeight { 3318 my $self = shift; 3319 my $section = lc(shift); 3320 my $section_num = shift; 3321 (my $row = shift) || return 0; 3322 my $value = shift; 3323 3324 return $self->setSectionRCellsHeight ( $section, $section_num, $row, $value ); 3325} 3326 3327#------------------------------------------------------- 3328# Subroutine: setRCellsHeight(row_num, [pixels]) 3329# Author: Anthony Peacock 3330# Date: 10 April 2008 3331# Based on: setRowHeight 3332#------------------------------------------------------- 3333sub setRCellsHeight { 3334 my $self = shift; 3335 (my $row = shift) || return 0; 3336 my $value = shift; 3337 3338 $self->setSectionRCellsHeight('tbody', 0, $row, $value); 3339} 3340 3341#------------------------------------------------------- 3342# Subroutine: setRowHeight(row_num, [pixels]) 3343# Author: Anthony Peacock 3344# Date: 22 Feb 2001 3345# Modified: 10 April 2008 3346# Status: Deprecated by setRCellsHeight 3347#------------------------------------------------------- 3348sub setRowHeight { 3349 my $self = shift; 3350 (my $row = shift) || return 0; 3351 my $value = shift; 3352 3353 $self->setSectionRCellsHeight('tbody', 0, $row, $value); 3354} 3355 3356 3357#------------------------------------------------------- 3358# Subroutine: setSectionRCellsFormat('section', section_num, row_num, start_string, end_string) 3359# Author: Anthony Peacock 3360# Date: 10 April 2008 3361# Base on: setSectionRowFormat 3362#------------------------------------------------------- 3363sub setSectionRCellsFormat { 3364 my $self = shift; 3365 my $section = lc(shift); 3366 my $section_num = shift; 3367 (my $row = shift) || return 0; 3368 my ($start_string, $end_string) = @_; 3369 3370 if ( $section !~ /thead|tbody|tfoot/i ) { 3371 print STDERR "\nsetSectionRCellsFormat: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 3372 return 0; 3373 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 3374 print STDERR "\nsetSectionRCellsFormat: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 3375 return 0; 3376 } 3377 3378 # If -1 is used in the row parameter, use the last row 3379 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 3380 3381 # You cannot set a nonexistent row 3382 if ( $row > $self->{$section}[$section_num]->{last_row} || $row < 1 ) { 3383 print STDERR "\n$0:setSectionRCellsFormat: Invalid table reference" ; 3384 return 0; 3385 } 3386 3387 # this sub should set format strings for each 3388 # cell in a row given a row number; 3389 my $i; 3390 for ($i=1;$i <= $self->{last_col};$i++) { 3391 $self->setSectionCellFormat($section, $section_num, $row,$i, $start_string, $end_string); 3392 } 3393} 3394 3395#------------------------------------------------------- 3396# Subroutine: setSectionRowFormat('section', section_num, row_num, start_string, end_string) 3397# Author: Anthony Peacock 3398# Date: 10 September 2007 3399# Modified: 10 April 2008 3400# Status: Deprecated by setSectionRCellsFormat 3401#------------------------------------------------------- 3402sub setSectionRowFormat { 3403 my $self = shift; 3404 my $section = lc(shift); 3405 my $section_num = shift; 3406 (my $row = shift) || return 0; 3407 my ($start_string, $end_string) = @_; 3408 3409 return $self->setSectionRCellsFormat ( $section, $section_num, $row, $start_string, $end_string ); 3410} 3411 3412#------------------------------------------------------- 3413# Subroutine: setRCellsFormat(row_num, start_string, end_string) 3414# Author: Anthony Peacock 3415# Date: 21 Feb 2001 3416# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 3417# Modified: 10 April 2008 - Anthony Peacock 3418#------------------------------------------------------- 3419sub setRCellsFormat { 3420 my $self = shift; 3421 (my $row = shift) || return 0; 3422 my ($start_string, $end_string) = @_; 3423 3424 $self->setSectionRCellsFormat( 'tbody', 0, $row, $start_string, $end_string); 3425} 3426 3427#------------------------------------------------------- 3428# Subroutine: setRowFormat(row_num, start_string, end_string) 3429# Author: Anthony Peacock 3430# Date: 21 Feb 2001 3431# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 3432# Modified: 10 September 2007 - Anthony Peacock 3433# Status: Deprecated by setRCellsFormat 3434#------------------------------------------------------- 3435sub setRowFormat { 3436 my $self = shift; 3437 (my $row = shift) || return 0; 3438 my ($start_string, $end_string) = @_; 3439 3440 $self->setSectionRCellsFormat( 'tbody', 0, $row, $start_string, $end_string); 3441} 3442 3443#------------------------------------------------------- 3444# Subroutine: getSectionRowStyle('section', section_num, $row_num) 3445# Author: Anthony Peacock 3446# Date: 10 September 2007 3447# Description: getter for row style, using sections 3448# Based on: getRowStyle 3449#------------------------------------------------------- 3450sub getSectionRowStyle { 3451 my ($self, $section, $section_num, $row) = @_; 3452 3453 if ( $section !~ /thead|tbody|tfoot/i ) { 3454 print STDERR "\ngetSectionRowStyle: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 3455 return 0; 3456 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 3457 print STDERR "\ngetSectionRowStyle: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 3458 return 0; 3459 } 3460 3461 return $self->_checkRowAndCol('getRowStyle', $section, $section_num, {row => $row}) 3462 ? $self->{$section}[$section_num]->{rows}[$row]->{style} 3463 : undef; 3464} 3465 3466#------------------------------------------------------- 3467# Subroutine: getRowStyle($row_num) 3468# Author: Douglas Riordan 3469# Date: 1 Dec 2005 3470# Description: getter for row style 3471# Modified: 10 September 2007 - Anthony Peacock 3472#------------------------------------------------------- 3473sub getRowStyle { 3474 my ($self, $row) = @_; 3475 3476 return $self->getSectionRowStyle ( 'tbody', 0, $row ); 3477} 3478 3479#------------------------------------------------------- 3480# Col config methods 3481# 3482#------------------------------------------------------- 3483 3484#------------------------------------------------------- 3485# Subroutine: addSectionCol('section', section_num, "cell 1 content" [, "cell 2 content", ...]) 3486# Author: Anthony Peacock 3487# Date: 11 Sept 2007 3488# Based on: addCol 3489#------------------------------------------------------- 3490sub addSectionCol { 3491 my $self = shift; 3492 my $section = shift; 3493 my $section_num = shift; 3494 3495 if ( $section !~ /thead|tbody|tfoot/i ) { 3496 print STDERR "\naddSectionCol: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 3497 return 0; 3498 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 3499 print STDERR "\naddSectionCol: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 3500 return 0; 3501 } 3502 3503 # this sub should add a column, using @_ as contents 3504 my $count= @_; 3505 # if number of cells is greater than rows, let's assume 3506 # we want to add a row. 3507 $self->{$section}[$section_num]->{last_row} = $count if ($count >$self->{$section}[$section_num]->{last_row}); 3508 $self->{last_col}++; # increment number of rows 3509 my $i; 3510 for ($i=1;$i <= $count;$i++) { 3511 # Store each value in cell on row 3512 $self->{$section}[$section_num]->{rows}[$i]->{cells}[$self->{last_col}]->{contents} = shift; 3513 } 3514 return $self->{last_col}; 3515 3516} 3517 3518#------------------------------------------------------- 3519# Subroutine: addCol("cell 1 content" [, "cell 2 content", ...]) 3520# Author: Stacy Lacy 3521# Date: 30 Jul 1997 3522# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 3523# Modified: 11 Sept 2007 - Anthony Peacock 3524#------------------------------------------------------- 3525sub addCol { 3526 my $self = shift; 3527 return $self->addSectionCol ( 'tbody', 0, @_ ); 3528} 3529 3530#------------------------------------------------------- 3531# Subroutine: setSectionColAlign('section', section_num, col_num, [center|right|left]) 3532# Author: Anthony Peacock 3533# Date: 11 Sept 2007 3534# Based on: setColAlign 3535#------------------------------------------------------- 3536sub setSectionColAlign { 3537 my $self = shift; 3538 my $section = shift; 3539 my $section_num = shift; 3540 (my $col = shift) || return 0; 3541 my $align = shift; 3542 3543 if ( $section !~ /thead|tbody|tfoot/i ) { 3544 print STDERR "\nsetSectionColAlign: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 3545 return 0; 3546 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 3547 print STDERR "\nsetSectionColAlign: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 3548 return 0; 3549 } 3550 3551 # If -1 is used in the col parameter, use the last col 3552 $col = $self->{last_col} if $col == -1; 3553 3554 # You cannot set a nonexistent row 3555 if ( $col > $self->{last_col} || $col < 1 ) { 3556 print STDERR "\n$0:setSectionColAlign: Invalid table reference" ; 3557 return 0; 3558 } 3559 3560 # this sub should align a col given a col number; 3561 my $i; 3562 for ($i=1;$i <= $self->{$section}[$section_num]->{last_row};$i++) { 3563 $self->setSectionCellAlign($section, $section_num, $i, $col, $align); 3564 } 3565} 3566 3567#------------------------------------------------------- 3568# Subroutine: setColAlign(col_num, [center|right|left]) 3569# Author: Stacy Lacy 3570# Date: 30 Jul 1997 3571# Modified: 11 Sept 2007 Anthony Peacock 3572#------------------------------------------------------- 3573sub setColAlign { 3574 my $self = shift; 3575 (my $col = shift) || return 0; 3576 my $align = shift; 3577 3578 $self->setSectionColAlign ( 'tbody', 0, $col, $align ); 3579} 3580 3581#------------------------------------------------------- 3582# Subroutine: setSectionColVAlign('section', section_num, col_num, [center|top|bottom]) 3583# Author: Anthony Peacock 3584# Date: 11 Sept 2007 3585# Based on: setColVAlign 3586#------------------------------------------------------- 3587sub setSectionColVAlign { 3588 my $self = shift; 3589 my $section = shift; 3590 my $section_num = shift; 3591 (my $col = shift) || return 0; 3592 my $valign = shift; 3593 3594 if ( $section !~ /thead|tbody|tfoot/i ) { 3595 print STDERR "\nsetSectionColVAlign: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 3596 return 0; 3597 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 3598 print STDERR "\nsetSectionColVAlign: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 3599 return 0; 3600 } 3601 3602 # If -1 is used in the col parameter, use the last col 3603 $col = $self->{last_col} if $col == -1; 3604 3605 # You cannot set a nonexistent row 3606 if ( $col > $self->{last_col} || $col < 1 ) { 3607 print STDERR "\n$0:setSectionColVAlign: Invalid table reference" ; 3608 return 0; 3609 } 3610 3611 # this sub should align a all rows given a column number; 3612 my $i; 3613 for ($i=1;$i <= $self->{$section}[$section_num]->{last_row};$i++) { 3614 $self->setSectionCellVAlign($section, $section_num, $i,$col, $valign); 3615 } 3616} 3617 3618#------------------------------------------------------- 3619# Subroutine: setColVAlign(col_num, [center|top|bottom]) 3620# Author: Stacy Lacy 3621# Date: 30 Jul 1997 3622# Modified: 11 Sept 2007 - Anthony Peacock 3623#------------------------------------------------------- 3624sub setColVAlign { 3625 my $self = shift; 3626 (my $col = shift) || return 0; 3627 my $valign = shift; 3628 3629 $self->setSectionColVAlign( 'tbody', 0, $col, $valign); 3630} 3631 3632#------------------------------------------------------- 3633# Subroutine: setSectionColHead('section', section_num, col_num, [0|1]) 3634# Author: Anthony Peacock 3635# Date: 11 Sept 2007 3636# Based on: setColHead 3637#------------------------------------------------------- 3638sub setSectionColHead { 3639 my $self = shift; 3640 my $section = shift; 3641 my $section_num = shift; 3642 (my $col = shift) || return 0; 3643 my $value = shift || 1; 3644 3645 if ( $section !~ /thead|tbody|tfoot/i ) { 3646 print STDERR "\nsetSectionColHead: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 3647 return 0; 3648 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 3649 print STDERR "\nsetSectionColHead: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 3650 return 0; 3651 } 3652 3653 # If -1 is used in the col parameter, use the last col 3654 $col = $self->{last_col} if $col == -1; 3655 3656 # You cannot set a nonexistent row 3657 if ( $col > $self->{last_col} || $col < 1 ) { 3658 print STDERR "\n$0:setSectionColHead: Invalid table reference" ; 3659 return 0; 3660 } 3661 3662 # this sub should set the head attribute of a col given a col number; 3663 my $i; 3664 for ($i=1;$i <= $self->{$section}[$section_num]->{last_row};$i++) { 3665 $self->setSectionCellHead($section, $section_num, $i, $col, $value); 3666 } 3667} 3668 3669#------------------------------------------------------- 3670# Subroutine: setColHead(col_num, [0|1]) 3671# Author: Jay Flaherty 3672# Date: 30 Mar 1998 3673# Modified: 11 Sept 2007 - Anthony Peacock 3674#------------------------------------------------------- 3675sub setColHead { 3676 my $self = shift; 3677 (my $col = shift) || return 0; 3678 my $value = shift || 1; 3679 3680 $self->setSectionColHead( 'tbody', 0, $col, $value); 3681} 3682 3683#------------------------------------------------------- 3684# Subroutine: setSectionColNoWrap('section', section_num, row_num, col_num, [0|1]) 3685# Author: Anthony Peacock 3686# Date: 11 Sept 2007 3687# Based on: setColNoWrap 3688#------------------------------------------------------- 3689sub setSectionColNoWrap { 3690 my $self = shift; 3691 my $section = shift; 3692 my $section_num = shift; 3693 (my $col = shift) || return 0; 3694 my $value = shift; 3695 3696 if ( $section !~ /thead|tbody|tfoot/i ) { 3697 print STDERR "\nsetSectionColNoWrap: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 3698 return 0; 3699 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 3700 print STDERR "\nsetSectionColNoWrap: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 3701 return 0; 3702 } 3703 3704 # If -1 is used in the col parameter, use the last col 3705 $col = $self->{last_col} if $col == -1; 3706 3707 # You cannot set a nonexistent row 3708 if ( $col > $self->{last_col} || $col < 1 ) { 3709 print STDERR "\n$0:setSectionColNoWrap: Invalid table reference" ; 3710 return 0; 3711 } 3712 3713 # this sub should change the wrap flag of a column; 3714 my $i; 3715 for ($i=1;$i <= $self->{$section}[$section_num]->{last_row};$i++) { 3716 $self->setSectionCellNoWrap($section, $section_num, $i,$col, $value); 3717 } 3718} 3719 3720#------------------------------------------------------- 3721# Subroutine: setColNoWrap(row_num, col_num, [0|1]) 3722# Author: Stacy Lacy 3723# Date: 30 Jul 1997 3724# Modified: 11 Sept 2007 - Anthony Peacock 3725#------------------------------------------------------- 3726sub setColNoWrap { 3727 my $self = shift; 3728 (my $col = shift) || return 0; 3729 my $value = shift; 3730 3731 $self->setSectionColNoWrap( 'tbody', 0, $col, $value); 3732} 3733 3734#------------------------------------------------------- 3735# Subroutine: setSectionColWidth('section', section_num, col_num, [pixels|percentoftable]) 3736# Author: Anthony Peacock 3737# Date: 12 Sept 2007 3738# Based on: setColWidth 3739#------------------------------------------------------- 3740sub setSectionColWidth { 3741 my $self = shift; 3742 my $section = shift; 3743 my $section_num = shift; 3744 (my $col = shift) || return 0; 3745 my $value = shift; 3746 3747 if ( $section !~ /thead|tbody|tfoot/i ) { 3748 print STDERR "\nsetSectionColWidth: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 3749 return 0; 3750 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 3751 print STDERR "\nsetSectionColWidth: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 3752 return 0; 3753 } 3754 3755 # If -1 is used in the col parameter, use the last col 3756 $col = $self->{last_col} if $col == -1; 3757 3758 # You cannot set a nonexistent row 3759 if ( $col > $self->{last_col} || $col < 1 ) { 3760 print STDERR "\n$0:setSectionColWidth: Invalid table reference" ; 3761 return 0; 3762 } 3763 3764 # this sub should change the cell width of a col; 3765 my $i; 3766 for ($i=1;$i <= $self->{$section}[$section_num]->{last_row};$i++) { 3767 $self->setSectionCellWidth($section, $section_num, $i, $col, $value); 3768 } 3769} 3770 3771#------------------------------------------------------- 3772# Subroutine: setColWidth(col_num, [pixels|percentoftable]) 3773# Author: Anthony Peacock 3774# Date: 22 Feb 2001 3775# Modified: 12 Sept 2007 - Anthony Peacock 3776#------------------------------------------------------- 3777sub setColWidth { 3778 my $self = shift; 3779 (my $col = shift) || return 0; 3780 my $value = shift; 3781 3782 $self->setSectionColWidth('tbody', 0, $col, $value); 3783} 3784 3785#------------------------------------------------------- 3786# Subroutine: setSectionColHeight('section', section_num, col_num, [pixels]) 3787# Author: Anthony Peacock 3788# Date: 12 Sept 2007 3789# Based on: setColHeight 3790#------------------------------------------------------- 3791sub setSectionColHeight { 3792 my $self = shift; 3793 my $section = shift; 3794 my $section_num = shift; 3795 (my $col = shift) || return 0; 3796 my $value = shift; 3797 3798 if ( $section !~ /thead|tbody|tfoot/i ) { 3799 print STDERR "\nsetSectionColHeight: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 3800 return 0; 3801 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 3802 print STDERR "\nsetSectionColHeight: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 3803 return 0; 3804 } 3805 3806 # If -1 is used in the col parameter, use the last col 3807 $col = $self->{last_col} if $col == -1; 3808 3809 # You cannot set a nonexistent row 3810 if ( $col > $self->{last_col} || $col < 1 ) { 3811 print STDERR "\n$0:setSectionColHeight: Invalid table reference" ; 3812 return 0; 3813 } 3814 3815 # this sub should change the cell height of a col; 3816 my $i; 3817 for ($i=1;$i <= $self->{$section}[$section_num]->{last_row};$i++) { 3818 $self->setSectionCellHeight($section, $section_num, $i, $col, $value); 3819 } 3820} 3821 3822#------------------------------------------------------- 3823# Subroutine: setColHeight(col_num, [pixels]) 3824# Author: Anthony Peacock 3825# Date: 22 Feb 2001 3826# Modified: 12 Sept 2007 - Anthony Peacock 3827#------------------------------------------------------- 3828sub setColHeight { 3829 my $self = shift; 3830 (my $col = shift) || return 0; 3831 my $value = shift; 3832 3833 $self->setSectionColHeight('tbody', 0, $col, $value); 3834} 3835 3836#------------------------------------------------------- 3837# Subroutine: setSectionColBGColor('section', section_num, col_num, [colorname|colortriplet]) 3838# Author: Anthony Peacock 3839# Date: 12 Sept 2007 3840# Based on: setColBGColor 3841#------------------------------------------------------- 3842sub setSectionColBGColor{ 3843 my $self = shift; 3844 my $section = shift; 3845 my $section_num = shift; 3846 (my $col = shift) || return 0; 3847 my $value = shift || 1; 3848 3849 if ( $section !~ /thead|tbody|tfoot/i ) { 3850 print STDERR "\nsetSectionColBGColor: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 3851 return 0; 3852 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 3853 print STDERR "\nsetSectionColBGColor: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 3854 return 0; 3855 } 3856 3857 # If -1 is used in the col parameter, use the last col 3858 $col = $self->{last_col} if $col == -1; 3859 3860 # You cannot set a nonexistent row 3861 if ( $col > $self->{last_col} || $col < 1 ) { 3862 print STDERR "\n$0:setSectionColBGColor: Invalid table reference" ; 3863 return 0; 3864 } 3865 3866 # this sub should set bgcolor for each 3867 # cell in a col given a col number; 3868 my $i; 3869 for ($i=1;$i <= $self->{$section}[$section_num]->{last_row};$i++) { 3870 $self->setSectionCellBGColor($section, $section_num, $i, $col, $value); 3871 } 3872} 3873 3874#------------------------------------------------------- 3875# Subroutine: setColBGColor(col_num, [colorname|colortriplet]) 3876# Author: Jay Flaherty 3877# Date: 16 Nov 1998 3878# Modified: 12 Sept 2007 - Anthony Peacock 3879#------------------------------------------------------- 3880sub setColBGColor{ 3881 my $self = shift; 3882 (my $col = shift) || return 0; 3883 my $value = shift || 1; 3884 3885 $self->setSectionColBGColor( 'tbody', 0, $col, $value); 3886} 3887 3888#------------------------------------------------------- 3889# Subroutine: setSectionColStyle('section', section_num, col_num, "style") 3890# Author: Anthony Peacock 3891# Date: 12 Sept 2007 3892# Based on: setColStyle 3893#------------------------------------------------------- 3894sub setSectionColStyle{ 3895 my $self = shift; 3896 my $section = shift; 3897 my $section_num = shift; 3898 (my $col = shift) || return 0; 3899 my $value = shift || 1; 3900 3901 if ( $section !~ /thead|tbody|tfoot/i ) { 3902 print STDERR "\nsetSectionColStyle: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 3903 return 0; 3904 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 3905 print STDERR "\nsetSectionColStyle: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 3906 return 0; 3907 } 3908 3909 # If -1 is used in the col parameter, use the last col 3910 $col = $self->{last_col} if $col == -1; 3911 3912 # You cannot set a nonexistent row 3913 if ( $col > $self->{last_col} || $col < 1 ) { 3914 print STDERR "\n$0:setSectionColStyle: Invalid table reference" ; 3915 return 0; 3916 } 3917 3918 # this sub should set style for each 3919 # cell in a col given a col number; 3920 my $i; 3921 for ($i=1;$i <= $self->{$section}[$section_num]->{last_row};$i++) { 3922 $self->setSectionCellStyle($section, $section_num, $i,$col, $value); 3923 } 3924} 3925 3926#------------------------------------------------------- 3927# Subroutine: setColStyle(col_num, "style") 3928# Author: Anthony Peacock 3929# Date: 10 Jan 2002 3930# Modified: 12 Sept 2007 - Anthony Peacock 3931#------------------------------------------------------- 3932sub setColStyle{ 3933 my $self = shift; 3934 (my $col = shift) || return 0; 3935 my $value = shift || 1; 3936 3937 $self->setSectionColStyle( 'tbody', 0, $col, $value); 3938} 3939 3940#------------------------------------------------------- 3941# Subroutine: setSectionColClass('section', section_num, col_num, 'class') 3942# Author: Anthony Peacock 3943# Date: 12 Sept 2007 3944# Based on: setColClass 3945#------------------------------------------------------- 3946sub setSectionColClass{ 3947 my $self = shift; 3948 my $section = shift; 3949 my $section_num = shift; 3950 (my $col = shift) || return 0; 3951 my $value = shift || 1; 3952 3953 if ( $section !~ /thead|tbody|tfoot/i ) { 3954 print STDERR "\nsetSectionColClass: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 3955 return 0; 3956 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 3957 print STDERR "\nsetSectionColClass: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 3958 return 0; 3959 } 3960 3961 # If -1 is used in the col parameter, use the last col 3962 $col = $self->{last_col} if $col == -1; 3963 3964 # You cannot set a nonexistent row 3965 if ( $col > $self->{last_col} || $col < 1 ) { 3966 print STDERR "\n$0:setSectionColClass: Invalid table reference" ; 3967 return 0; 3968 } 3969 3970 # this sub should set class for each 3971 # cell in a col given a col number; 3972 my $i; 3973 for ($i=1;$i <= $self->{$section}[$section_num]->{last_row};$i++) { 3974 $self->setSectionCellClass($section, $section_num, $i,$col, $value); 3975 } 3976} 3977 3978#------------------------------------------------------- 3979# Subroutine: setColClass(col_num, 'class') 3980# Author: Anthony Peacock 3981# Date: 22 July 2002 3982# Modified: 12 Sept 2007 - Anthony Peacock 3983#------------------------------------------------------- 3984sub setColClass{ 3985 my $self = shift; 3986 (my $col = shift) || return 0; 3987 my $value = shift || 1; 3988 3989 $self->setSectionColClass( 'tbody', 0, $col, $value); 3990} 3991 3992#------------------------------------------------------- 3993# Subroutine: setSectionColFormat('section', section_num, row_num, start_string, end_string) 3994# Author: Anthony Peacock 3995# Date: 12 Sept 2007 3996# Based on: setColFormat 3997#------------------------------------------------------- 3998sub setSectionColFormat{ 3999 my $self = shift; 4000 my $section = shift; 4001 my $section_num = shift; 4002 (my $col = shift) || return 0; 4003 my ($start_string, $end_string) = @_; 4004 4005 if ( $section !~ /thead|tbody|tfoot/i ) { 4006 print STDERR "\nsetSectionColFormat: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 4007 return 0; 4008 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 4009 print STDERR "\nsetSectionColFormat: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 4010 return 0; 4011 } 4012 4013 # If -1 is used in the col parameter, use the last col 4014 $col = $self->{last_col} if $col == -1; 4015 4016 # You cannot set a nonexistent row 4017 if ( $col > $self->{last_col} || $col < 1 ) { 4018 print STDERR "\n$0:setSectionColFormat: Invalid table reference" ; 4019 return 0; 4020 } 4021 4022 # this sub should set format strings for each 4023 # cell in a col given a col number; 4024 my $i; 4025 for ($i=1;$i <= $self->{$section}[$section_num]->{last_row};$i++) { 4026 $self->setSectionCellFormat($section, $section_num, $i,$col, $start_string, $end_string); 4027 } 4028} 4029 4030#------------------------------------------------------- 4031# Subroutine: setColFormat(row_num, start_string, end_string) 4032# Author: Anthony Peacock 4033# Date: 21 Feb 2001 4034# Modified: 12 Sept 2007 4035#------------------------------------------------------- 4036sub setColFormat{ 4037 my $self = shift; 4038 (my $col = shift) || return 0; 4039 my ($start_string, $end_string) = @_; 4040 4041 $self->setSectionColFormat( 'tbody', 0, $col, $start_string, $end_string); 4042} 4043 4044#------------------------------------------------------- 4045# Subroutine: setSectionColAttr('section', section_num, col, "Attribute string") 4046# Author: Anthony Peacock 4047# Date: 12 Sept 2007 4048# Based on: setColAttr 4049#------------------------------------------------------- 4050sub setSectionColAttr { 4051 my $self = shift; 4052 my $section = shift; 4053 my $section_num = shift; 4054 (my $col = shift) || return 0; 4055 my $html_str = shift; 4056 4057 if ( $section !~ /thead|tbody|tfoot/i ) { 4058 print STDERR "\nsetSectionColAttr: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 4059 return 0; 4060 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 4061 print STDERR "\nsetSectionColAttr: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 4062 return 0; 4063 } 4064 4065 # If -1 is used in the col parameter, use the last col 4066 $col = $self->{last_col} if $col == -1; 4067 4068 # You cannot set a nonexistent row 4069 if ( $col > $self->{last_col} || $col < 1 ) { 4070 print STDERR "\n$0:setSectionColAttr: Invalid table reference" ; 4071 return 0; 4072 } 4073 4074 # this sub should set attribute string for each 4075 # cell in a col given a col number; 4076 my $i; 4077 for ($i=1;$i <= $self->{$section}[$section_num]->{last_row};$i++) { 4078 $self->setSectionCellAttr($section, $section_num, $i,$col, $html_str); 4079 } 4080} 4081 4082#------------------------------------------------------- 4083# Subroutine: setColAttr(col, "Attribute string") 4084# Author: Benjamin Longuet 4085# Date: 27 Feb 2002 4086# Modified: 12 Sept 2007 - Anthony Peacock 4087#------------------------------------------------------- 4088sub setColAttr { 4089 my $self = shift; 4090 (my $col = shift) || return 0; 4091 my $html_str = shift; 4092 4093 $self->setSectionColAttr( 'tbody', 0,$col, $html_str); 4094} 4095 4096#------------------------------------------------------- 4097# Subroutine: getSectionColStyle('section', section_num, $col_num) 4098# Author: Anthony Peacock 4099# Date: 12 Sept 2007 4100# Description: getter for col style 4101# Based on: getColStyle 4102#------------------------------------------------------- 4103sub getSectionColStyle { 4104 my ($self, $section, $section_num, $col) = @_; 4105 4106 if ( $section !~ /thead|tbody|tfoot/i ) { 4107 print STDERR "\ngetSectionColStyle: Section can be : 'thead | tbody | tfoot' : Cur value: $section\n"; 4108 return 0; 4109 } elsif ( $section =~ /thead|tfoot/i && $section_num > 0 ) { 4110 print STDERR "\ngetSectionColStyle: Section number for Head and Foot can only be 0 : Cur value: $section_num\n"; 4111 return 0; 4112 } 4113 4114 if ($self->_checkRowAndCol('getSectionColStyle', $section, $section_num, {col => $col})) { 4115 my $last_row = $self->{$section}[$section_num]->{last_row}; 4116 return $self->{$section}[$section_num]->{rows}->[$last_row]->{cells}[$col]->{style}; 4117 } 4118 else { 4119 return undef; 4120 } 4121} 4122 4123#------------------------------------------------------- 4124# Subroutine: getColStyle($col_num) 4125# Author: Douglas Riordan 4126# Date: 1 Dec 2005 4127# Description: getter for col style 4128# Modified: 12 Sept 2007 - Anthony Peacock 4129#------------------------------------------------------- 4130sub getColStyle { 4131 my ($self, $col) = @_; 4132 4133 return $self->getSectionColStyle ( 'tbody', 0, $col ); 4134} 4135 4136#------------------------------------------------------- 4137#******************************************************* 4138# 4139# End of public methods 4140# 4141# The following methods are internal to this package 4142# 4143#******************************************************* 4144#------------------------------------------------------- 4145 4146#------------------------------------------------------- 4147# Subroutine: _updateSpanGrid('section', section_num, row_num, col_num) 4148# Author: Stacy Lacy 4149# Date: 31 Jul 1997 4150# Modified: 23 Oct 2003 - Anthony Peacock (Version 2 new data structure) 4151#------------------------------------------------------- 4152sub _updateSpanGrid { 4153 my $self = shift; 4154 my $section = shift; 4155 my $section_num = shift; 4156 (my $row = shift) || return 0; 4157 (my $col = shift) || return 0; 4158 4159 my $colspan = $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{colspan} || 0; 4160 my $rowspan = $self->{$section}[$section_num]->{rows}[$row]->{cells}[$col]->{rowspan} || 0; 4161 4162 if ($self->{autogrow}) { 4163 $self->{last_col} = $col + $colspan - 1 unless $self->{last_col} > ($col + $colspan - 1 ); 4164 $self->{$section}[$section_num]->{last_row} = $row + $rowspan - 1 unless $self->{$section}[$section_num]->{last_row} > ($row + $rowspan - 1 ); 4165 } 4166 4167 my ($i, $j); 4168 if ($colspan) { 4169 for ($j=$col+1;(($j <= $self->{last_col}) && ($j <= ($col +$colspan -1))); $j++ ) { 4170 $self->{$section}[$section_num]->{rows}[$row]->{cells}[$j]->{colspan} = "SPANNED"; 4171 } 4172 } 4173 if ($rowspan) { 4174 for ($i=$row+1;(($i <= $self->{$section}[$section_num]->{last_row}) && ($i <= ($row +$rowspan -1))); $i++) { 4175 $self->{$section}[$section_num]->{rows}[$i]->{cells}[$col]->{colspan} = "SPANNED"; 4176 } 4177 } 4178 4179 if ($colspan && $rowspan) { 4180 # Spanned Grid 4181 for ($i=$row+1;(($i <= $self->{$section}[$section_num]->{last_row}) && ($i <= ($row +$rowspan -1))); $i++) { 4182 for ($j=$col+1;(($j <= $self->{last_col}) && ($j <= ($col +$colspan -1))); $j++ ) { 4183 $self->{$section}[$section_num]->{rows}[$i]->{cells}[$j]->{colspan} = "SPANNED"; 4184 } 4185 } 4186 } 4187} 4188 4189#------------------------------------------------------- 4190# Subroutine: _getTableHashValues(tablehashname) 4191# Author: Stacy Lacy 4192# Date: 31 Jul 1997 4193#------------------------------------------------------- 4194sub _getTableHashValues { 4195 my $self = shift; 4196 (my $hashname = shift) || return 0; 4197 4198 my ($i, $j, $retval); 4199 for ($i=1; $i <= ($self->{last_row}); $i++) { 4200 for ($j=1; $j <= ($self->{last_col}); $j++) { 4201 $retval.= "|$i:$j| " . ($self->{"$hashname"}{"$i:$j"}) . " "; 4202 } 4203 $retval.=" |<br />"; 4204 } 4205 4206 return $retval; 4207} 4208 4209#------------------------------------------------------- 4210# Subroutine: _is_validnum(string_value) 4211# Author: Anthony Peacock 4212# Date: 12 Jul 2000 4213# Description: Checks the string value passed as a parameter 4214# and returns true if it is >= 0 4215# Modified: 23 Oct 2001 - Terence Brown 4216# Modified: 30 Aug 2002 - Tommi Maekitalo 4217#------------------------------------------------------- 4218sub _is_validnum { 4219 my $str = shift; 4220 4221 if ( defined($str) && $str =~ /^\s*\d+\s*$/ && $str >= 0 ) { 4222 return 1; 4223 } else { 4224 return; 4225 } 4226} 4227 4228#---------------------------------------------------------------------- 4229# Subroutine: _install_stateful_set_method 4230# Author: Paul Vernaza 4231# Date: 1 July 2002 4232# Description: Generates and installs a stateful version of the given 4233# setter method (in the sense that it 'remembers' the last row or 4234# column in the table and passes it as an implicit argument). 4235#---------------------------------------------------------------------- 4236sub _install_stateful_set_method { 4237 my ($called_method, $real_method) = @_; 4238 4239 my $row_andor_cell = $real_method =~ /^setCell/ ? 4240 '($self->getTableRows, $self->getTableCols)' : 4241 $real_method =~ /^setRow/ ? '$self->getTableRows' : 4242 $real_method =~ /^setCol/ ? '$self->getTableCols' : 4243 die 'can\'t determine argument type(s)'; 4244 4245 { no strict 'refs'; 4246 *$called_method = sub { 4247 my $self = shift(); 4248 return &$real_method($self, eval ($row_andor_cell), @_); 4249 }; } 4250} 4251 4252#---------------------------------------------------------------------- 4253# Subroutine: AUTOLOAD 4254# Author: Paul Vernaza 4255# Date: 1 July 2002 4256# Description: Intercepts calls to setLast* methods, generates them 4257# if possible from existing set-methods that require explicit row/column. 4258# Modified: 23 January 2006 - Suggestion by Gordon Lack 4259# Modified: 1 February 2006 - Made the "Usupported method" code more flexible. 4260#---------------------------------------------------------------------- 4261 4262sub AUTOLOAD { 4263 (my $called_method = $AUTOLOAD ) =~ s/.*:://; 4264 (my $real_method = $called_method) =~ s/^setLast/set/; 4265 4266 return if ($called_method eq 'DESTROY'); 4267 4268 die sprintf("Unsupported method $called_method call in %s\n", __PACKAGE__) unless defined(&$real_method); 4269 4270 _install_stateful_set_method($called_method, $real_method); 4271 goto &$called_method; 4272} 4273 4274 4275#---------------------------------------------------------------------- 4276# Subroutine: _checkRowAndCol($caller_method, $hsh_ref) 4277# Author: Douglas Riordan 4278# Date: 30 Nov 2005 4279# Description: validates row and col coordinates 4280# Modified: 12 Sept 2007 - Anthony Peacock 4281#---------------------------------------------------------------------- 4282sub _checkRowAndCol { 4283 my ($self, $method, $section, $section_num, $attrs) = @_; 4284 4285 if (defined $attrs->{row}) { 4286 my $row = $attrs->{row}; 4287 # if -1 is used in the row parameter, use the last row 4288 $row = $self->{$section}[$section_num]->{last_row} if $row == -1; 4289 if ($row > $self->{$section}[$section_num]->{last_row} || $row < 1) { 4290 print STDERR "$0: $method - Invalid table row reference\n"; 4291 return 0; 4292 } 4293 } 4294 4295 if (defined $attrs->{col}) { 4296 my $col = $attrs->{col}; 4297 # if -1 is used in the col parameter, use the last col 4298 $col = $self->{last_col} if $col == -1; 4299 if ($col > $self->{last_col} || $col < 1) { 4300 print STDERR "$0: $method - Invalid table col reference\n"; 4301 return 0; 4302 } 4303 } 4304 4305 return 1; 4306} 4307 43081; 4309 4310__END__ 4311 4312 4313