package TableMaker;
use strict;
use vars '$AUTOLOAD';
use CGI qw/:standard :html3/;

sub new {
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = {};
  $self->{face} = undef;
  $self->{color} = undef;
  $self->{size} = undef;
  $self->{width} = undef;
  $self->{border} = undef;
  $self->{cellspcacing} = undef;
  $self->{cols} = 1;
  $self->{cells} = [];
  bless($self, $class);
  return $self;
}

sub AUTOLOAD {
  no strict 'refs';
  my ($self, $val) = @_;
  my ($name) = $AUTOLOAD =~ m/.*::(\w*)/;

  return defined $val ? $self->{$name} = $val : $self->{$name};
}

sub addCell {
  my $self = shift;
  my @opt = qw/text face color size colspan rowspan align valign width
+ height/;
  my (%font, %td);
  my ($cs, $rs);
  if ( ref($_[0]) eq "HASH" ) {
    foreach ( @opt ) {
      if ( $_ =~ /text|face|color/ ) {
        if ( $_[0]->{$_} ) {
          $font{$_} = $_[0]->{$_}
        } elsif ( $_[0]->{"-$_"} ) {
          $font{$_} = $_[0]->{"-$_"}
        }elsif ( $self->{$_} ) {
          $font{$_} = $self->{$_}
        }
      } elsif ( $_ eq 'colspan' ) {
        if ( $_[0]->{$_} ) {
      $td{$_} = $_[0]->{$_};
      $cs = $_[0]->{$_}
    } elsif ( $_[0]->{"-$_"} ) {
      $td{$_} = $_[0]->{"-$_"};
      $cs = $_[0]->{"-$_"}
    }
      } elsif ( $_ eq 'rowspan' ) {
        if ( $_[0]->{$_} ) {
      $td{$_} = $_[0]->{$_};
      $rs = $_[0]->{$_}
    } elsif ( $_[0]->{"-$_"} ) {
      $td{$_} = $_[0]->{"-$_"};
      $rs = $_[0]->{"-$_"}
    }
      } elsif ( $_[0]->{$_} ) {
          $td{$_} = $_[0]->{$_};
      } elsif ( $_[0]->{"-$_"} ) {
          $td{$_} = $_[0]->{"-$_"};
      }
    }
  if (%font) {
    push(@{ $self->{cells} }, [td(\%td,font(\%font,$_[1])), $cs, $rs ]
+);
  } else {
    push(@{ $self->{cells} }, [td(\%td,$_[1]), $cs, $rs ]);
  } 
  } else {
    push(@{ $self->{cells} }, [td($_[0]), $cs, $rs ]);
  }
  
}

sub print_table {
  my $Rows;
  my $self = shift;
  my $col = 1;
  my @tab_opt = qw/width border cellspacing/;
  my %tab_opt;
  foreach (@tab_opt) {
    if ( $self->{$_} ) {
      $tab_opt{$_} = $self->{$_}
    } 
  }
  my @rowspan;
  my $row;
  my $colspan;
  foreach ( @{ $self->{cells} } ) {
    if ( $self->{cols} == 1 ) {
      $Rows .= Tr($_->[0])
    } else {
      while ( $rowspan[$col] ) {
    $rowspan[$col]--;
    if ( $col < $self->{cols} ) {
      $col++;
    } else {
          $Rows .= Tr($row);
      $row = ' ';
      $col = 1;
    }
      }
      $row .= $_->[0];
      $colspan = $_->[1] ? $col + $_->[1] - 1 : $col;
      $colspan = $self->{cols} if $colspan > $self->{cols};
      while ( ($col <= $colspan) ) {
    $rowspan[$col] = $_->[2] - 1 if $_->[2];
        $col++;
      }
      unless ( $col <= $self->{cols} ) {
        $Rows .= Tr($row);
    $row = ' ';
    $col = 1;
      }
    }
  }
  while ( $col <= $self->{cols} ) {
    unless ( $rowspan[$col++] ){
      $row .= td(' ')
    }
  }
  $Rows .= Tr($row);
  return table(\%tab_opt,$Rows);
    
}

1;
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.