Over the years I have had discussions with some of you about how I display my data. I mix up my data with how I am going to display my data (mostly HTML). One day I was looking at a few of the HTML tables I wrote into my perl code and decided to write a little subroutine. cell was born and was written fast once I got all the attributes I wanted to include nailed down. 

sub cell {
  # $tab is a number.
  # $type is either 'h' for heading or 'd' for data.
  # $contents is the text in the cell.
  # $opt is all of the available options to be adding inside the openi
+ng tag.
  my ($tab,$type,$contents,$opt) = @_;

  my @attributes;
  push @attributes, qq(id="$opt->{id}")       if $opt->{id};
  push @attributes, qq(class="$opt->{class}") if $opt->{class};
  push @attributes, qq(style="$opt->{style}") if $opt->{style};
  push @attributes, qq(colspan="$opt->{colspan}") if $opt->{colspan};
  push @attributes, qq(rowspan="$opt->{rowspan}") if $opt->{rowspan};

  my $format = @attributes > 0 ? ' '.join(' ',@attributes) : '';
  my $open = $type.$format;
  
  line($tab,qq(<t$open>));
  # Lists are treated specially in cells. The list subroutine is below
+.
  if ($contents =~ /list/i) {
    if (ref($opt->{list}[1]) eq 'HASH') {
      list($tab + 1,$opt->{list}->[0],$opt->{list}->[1]);
    }
    else {
      list($tab + 1,$opt->{list});
    }
  }
  else {
    line($tab + 1,$contents);
  }
  line($tab,qq(</t$type>));
}

[download]

Once I had all of my cells (except those which contained lists), I noticed patterns emerge. There were rows which only contained headings (header), most only contained data (data), and a lot contained an initial header followed by data (whead). From those patterns I was able to see a way to put whole rows into a subroutine. So, row was written.

sub row {
  # $tab is a number.
  # $type is one of the keys from the %types table below.
  # $cells is an array ref list of the cells in the row.
  my ($tab,$type,$cells) = @_;

  my %types = (
    header => 'h',
    data   => 'd',
    whead  => 'd'
  );

  line($tab,qq(<tr>));

  # Rows which start with a header need to have the first cell 
  # shifted off to receive the th tag.
  if ($type eq 'whead') {
    my $cell = shift @{$cells};
    cell($tab + 1,'h',ucfirst $cell, { class => 'row_header' });
  }

  # Most cells do not need anything special so the contents can be pas
+sed
  # as $value, however if the cell needs formatting or other attribute
+s,
  # it can be passed as an array ref [$contents, { ... options ... }].
  my $cell_type = $types{$type};
  for my $cell (@{$cells}) {
    if (ref($cell) eq 'ARRAY') {
      cell($tab + 1,$cell_type,$cell->[0],$cell->[1]);
    }
    else {
      cell($tab + 1,$cell_type,$cell);
    }
  }

  line($tab,q(</tr>));
}

[download]

I stalled after row for a while since I was not seeing a way to get them into yet another subroutine. All of my rows (except those which contained cells with lists) were nice one liners with most of the data munged separately. For me keeping data away from presentation was a problem. So, I stared at the tables for hours off and on trying to figure out how to get the rows into a table subroutine. I finally had a break through, and got to work writing table.

sub table {
  # $tab is again a number.
  # Everything else is optional.
  my ($tab,$opt) = @_;

  my @attributes;
  push @attributes, qq(id="$opt->{id}")       if $opt->{id};
  push @attributes, qq(class="$opt->{class}") if $opt->{class};
  push @attributes, qq(style="$opt->{style}") if $opt->{style};

  my $format = @attributes > 0 ? ' '.join(' ',@attributes) : '';
  my $tag = 'table'.$format;

  line($tab,qq(<$tag>));
  # If a caption is wanted set caption => "Caption"
  line($tab + 1,qq(<caption>$opt->{caption}</caption>)) if $opt->{capt
+ion};

  # Set headings to the same array ref as you would if you were settin
+g the row.
  row($tab + 1,'header',$opt->{headings}) if $opt->{headings};

  # In most tables, the data rows would come next. For this array ref
  # you would push all the array refs you would use for row above.
  # (I hope that makes sense.)
  if ($opt->{data}) {
    row($tab + 1,'data',$_) for @{$opt->{data}};
  }

  # In most tables, there could be final rows which contain totals. 
  # For this array ref you would push all the array refs you would
  # use for row above. Some tables have a header row and rows with
  # their own headings.
  # (I hope that makes sense.)
  if ($opt->{whead}) {
    row($tab + 1,'whead',$_) for @{$opt->{whead}};
  }

  line($tab,q(</table>));
}

[download]

Before you go on, take a break and have a cookie.

I have almost every table printing from a one line subroutine call with my data all being munged separately. (There is one table I knew of for a while which is not falling into the structure I created.) I really had to think hard to get the cells with lists into the framework, but I finally did it with line 15 of cell and using yet another subroutine for lists appropriately named list. From looking at it right now, I now remember I need to make it usable as an ordered list or an unordered list. (Added to my to-do list.)

sub list {
  # And again, $tab is a number.
  # $list is an array ref of values.
  # $opt is the few available options for lists.
  my ($tab,$list,$opt) = @_;

  my @attributes;
  push @attributes, qq(id="$opt->{id}")       if $opt->{id};
  push @attributes, qq(class="$opt->{class}") if $opt->{class};
  push @attributes, qq(style="$opt->{style}") if $opt->{style};

  my $format = @attributes > 0 ? ' '.join(' ',@attributes) : '';
  my $tag = 'ul'.$format;

  line($tab,qq(<$tag>));
  line($tab + 1,qq(<li>$_</li>)) for @{$list};
  line($tab,q(</ul>));
}

[download]

I have almost all of the items in place with the exception of the two subroutines, col and cols which I have not figured out how to add to table.

sub col {
  my ($tab,$opt) = @_;

  my @attributes;
  push @attributes, qq(class="$opt->{class}") if $opt->{class};
  push @attributes, qq(span="$opt->{span}")   if $opt->{span};

  my $format = @attributes > 0 ? ' '.join(' ',@attributes) : '';
  my $tag = 'col'.$format;
  line($tab,qq(<$tag>));
}

sub cols {
  my ($tab,$cols) = @_;
  col($tab,$_) for @{$cols};
}

[download]

So, everything was going rather smoothly until last night when I was smacked with several tables which became exceptions to my structure. I am at a mental impasse. I do not how how I am going to add another header row and another data row after the main table. I feel as if I have written myself into a corner from which I can not get out. So, I am asking for several more sets of eyeballs from people who know more than I. I know I have to restructure the table subroutine and rewrite the 20 or so scripts where I am already using it. I am hoping I do not have to rewrite the entire module; but if I must I will.

For those who have not come across my code for printing before, you may be wondering what line is. line adds tabs to the beginning of the string and a new line at the end of the string. I add the tabs and the new lines to make the HTML community happy as I add tabs (albeit two spaces instead of four) and new lines to my perl code.

sub sline {
  my ($tab,$line) = @_;
  return qq(\t) x $tab.qq($line\n);
}

sub line {
  print sline(@_);
}

[download]

So here I sit, desperately trying to figure out how to fix table so there can be more variety when it comes to row group placement.

Note: It was not until I started writing table when I realized how dependent I was on references. Before I started writing these subroutines, I had not used references much. Now, I use them wherever I can to the point I am thinking of rewriting a lot more of my subroutines to use references instead of real arrays or hashes. References have become the only way I want to pass parameters into subroutines. They are so much easier to use in my humble opinion. So, I stretched my brain to learn to use references which has made me very happy.

Here is the module as a whole.

package Base::HTML::Elements;
use strict;
use warnings;
use base 'Exporter';
our @EXPORT_OK = qw(table cols col row cell list);

use Base::Nifty qw(line);

sub list {
  my ($tab,$list,$opt) = @_;

  my @attributes;
  push @attributes, qq(id="$opt->{id}")       if $opt->{id};
  push @attributes, qq(class="$opt->{class}") if $opt->{class};
  push @attributes, qq(style="$opt->{style}") if $opt->{style};

  my $format = @attributes > 0 ? ' '.join(' ',@attributes) : '';
  my $tag = 'ul'.$format;

  line($tab,qq(<$tag>));
  line($tab + 1,qq(<li>$_</li>)) for @{$list};
  line($tab,q(</ul>));
}

sub cell {
  my ($tab,$type,$contents,$opt) = @_;

  my @attributes;
  push @attributes, qq(id="$opt->{id}")       if $opt->{id};
  push @attributes, qq(class="$opt->{class}") if $opt->{class};
  push @attributes, qq(style="$opt->{style}") if $opt->{style};
  push @attributes, qq(colspan="$opt->{colspan}") if $opt->{colspan};
  push @attributes, qq(rowspan="$opt->{rowspan}") if $opt->{rowspan};

  my $format = @attributes > 0 ? ' '.join(' ',@attributes) : '';
  my $open = $type.$format;
  
  line($tab,qq(<t$open>));
  if ($contents =~ /list/i) {
    if (ref($opt->{list}[1]) eq 'HASH') {
      list($tab + 1,$opt->{list}->[0],$opt->{list}->[1]);
    }
    else {
      list($tab + 1,$opt->{list});
    }
  }
  else {
    line($tab + 1,$contents);
  }
  line($tab,qq(</t$type>));
}

sub row {
  my ($tab,$type,$cells) = @_;

  my %types = (
    header => 'h',
    data   => 'd',
    whead  => 'd'
  );

  line($tab,qq(<tr>));

  if ($type eq 'whead') {
    my $cell = shift @{$cells};
    cell($tab + 1,'h',ucfirst $cell, { class => 'row_header' });
  }

  my $cell_type = $types{$type};
  for my $cell (@{$cells}) {
    if (ref($cell) eq 'ARRAY') {
      cell($tab + 1,$cell_type,$cell->[0],$cell->[1]);
    }
    else {
      cell($tab + 1,$cell_type,$cell);
    }
  }

  line($tab,q(</tr>));
}

sub col {
  my ($tab,$opt) = @_;

  my @attributes;
  push @attributes, qq(class="$opt->{class}") if $opt->{class};
  push @attributes, qq(span="$opt->{span}")   if $opt->{span};

  my $format = @attributes > 0 ? ' '.join(' ',@attributes) : '';
  my $tag = 'col'.$format;
  line($tab,qq(<$tag>));
}

sub cols {
  my ($tab,$cols) = @_;
  col($tab,$_) for @{$cols};
}

sub table {
  my ($tab,$opt) = @_;

  my @attributes;
  push @attributes, qq(id="$opt->{id}")       if $opt->{id};
  push @attributes, qq(class="$opt->{class}") if $opt->{class};
  push @attributes, qq(style="$opt->{style}") if $opt->{style};

  my $format = @attributes > 0 ? ' '.join(' ',@attributes) : '';
  my $tag = 'table'.$format;

  line($tab,qq(<$tag>));
  line($tab + 1,qq(<caption>$opt->{caption}</caption>)) if $opt->{capt
+ion};

  row($tab + 1,'header',$opt->{headings}) if $opt->{headings};

  if ($opt->{data}) {
    row($tab + 1,'data',$_) for @{$opt->{data}};
  }

  if ($opt->{whead}) {
    row($tab + 1,'whead',$_) for @{$opt->{whead}};
  }

  line($tab,q(</table>));
}

1;

[download]

I am not trying to dump this on someone else's lap. I am still considering ways to make table more flexible, but I would like a second opinion.

If you made it this far you deserve a whole plate of cookies!

Have a cookie and a very nice day!
Lady Aleena

In reply to I'm stuck adding more named parameters to a subroutine since the new named parameters might have the same name as the current ones. by Lady_Aleena

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • 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! —
  • 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:
    & &amp;
    < &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.