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

Lady_Aleena has asked for the wisdom of the Perl Monks concerning the following question:

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

Comment on I'm stuck adding more named parameters to a subroutine since the new named parameters might have the same name as the current ones. Select or Download Code

Replies are listed 'Best First'.
Re: 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 choroba (Cardinal) on Mar 25, 2013 at 10:10 UTC
Can you please provide an example of the table you are not able to print? I was able to run the following with favourable output: `table(1, { id => 't1', headings => [ qw/NAME STRENGTH COMMENT/], data => [ [qw/1 2 no/], [qw/2 3 yes/]], whead => [ [qw/10 20 another/], [qw/100 200 comment/]], } );` [download] Also, sticking to DRY, I would abstract the attributes building: `sub build_attributes { my ($options, @valid) = @_; my @attributes; my %validH; undef @validH{ @valid }; while (my ($attr, $value) = each %$options) { push @attributes, qq($attr="$value") if exists $validH{$attr}; } return @attributes; }` [download] and use that instead of repeated push all over the code: `sub list { my ($tab, $list, $opt) = @_; my @attributes = build_attributes($opt, qw/id class style/); my $format = join ' ', q(), @attributes;` [download] (Notice also how the `$format` could be joined without a conditional.) لսႽ� ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ	[reply] [d/l] [select]
Re^2: 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 (Priest) on Mar 25, 2013 at 20:22 UTC
choroba, I had been looking at all of the `@attributes` and thinking something should be done about them, however, I was not seeing how to put them all into another subroutine. I am now looking for a way to have the attributes returned in the same order as `@valid`. I know it is just a nitpicky thing, but when I look at the HTML source, I would like my attributes in the same order for all of the elements. Losing the conditional for `$format` is very nice since it speeds up rendering just a smidgen. Now for an example of where I have hit a wall. `table(1, { id => 't1', headings => [qw/NAME STRENGTH COMMENT/], whead => [ [1, [2, { style => 'text-align: right' }], 'no'], [2, [3, { style => 'text-align: right' }], 'yes'], [10, [20, { style => 'text-align: right' }], 'another'], [100, [200, { style => 'text-align: right' }], 'comment'], ], headings => [['List to go with the whead' { colspan => 3 }]], data => [ ['list', { class => 'info', colspan => 3, list => [$list, { cl +ass => 'two_cols' }] }] ], });` [download] As you can see, there is a second `headings` which, as of now, would overwrite the first `headings`. Also, the `data` row would come before the `whead` rows when the `table` is displayed. I included more complexity, with the second cell in each row having a `style` added. In the `data` row, I included how a `list` would be added into a `cell`. So what I am trying to figure out is how to put an order to the row groups and have more than one of a type of row group. *Have a cookie and a very nice day!* Lady Aleena	[reply] [d/l] [select]
Re^3: 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 choroba (Cardinal) on Mar 25, 2013 at 20:39 UTC
If you want multiple instances of the same type with ordering, you should use an array instead of a hash. What about something like table(1, { id => 1, rows => [ { type => 'headings', data => [qw/NAME STRENGTH COMMENT/], }, { type => 'whead', data => [ [1, [2, { style => 'text-align: right' }], + 'no'], [2, [3, { style => 'text-align: right' }], + 'yes'], [10, [20, { style => 'text-align: right' }], + 'another'], [100, [200, { style => 'text-align: right' }], + 'comment'], ], }, { type => 'headings', data => [['List to go with the whead' { colspan => 3 }] +], }, { type => 'data', data => [ [ 'list', { class => 'info', colspan => 3, list => [$list, { class => 'two_cols' }] } ] ] } ] } ); [download] لսႽ� ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ	[reply] [d/l]
Re^4: 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 (Priest) on Mar 28, 2013 at 02:51 UTC
Re^2: 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 (Priest) on Mar 25, 2013 at 22:29 UTC
choroba, I added `get_attributes` (formerly `build_attributes`) to the module, and it is much better now. I hope you do not mind I made a few changes to suit my finickiness. I have not made any other changes yet, still figuring it out. Thank you very much for the nudge regarding the attributes! Read more... (3 kB) Update: The above code was altered to include the new `get_attributes` two posts (as of this writing) down. The original code was... Read more... (439 Bytes) *Have a cookie and a very nice day!* Lady Aleena	[reply] [d/l] [select]
Re^3: 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 choroba (Cardinal) on Mar 25, 2013 at 23:26 UTC
You are creating an unnecessary copy. You can `retrun \@attributes;` [download] as well, the reference will be different each time as you are using my inside the sub. لսႽ� ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ	[reply] [d/l]
Re^4: 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 (Priest) on Mar 25, 2013 at 23:37 UTC
Re: 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 tobyink (Canon) on Mar 25, 2013 at 13:21 UTC
As I understand your question, you want to be able for `table` to output certain rows with an initial header (i.e. `whead`) and certain without (i.e. `data`), but you don't want the current limitation where all the `whead` rows must be at the end of the table. Is that correct? If so, as a first step, I'd replace table's `data` and `whead` options with a single `rows` option which takes a single arrayref. This arrayref would contain a list of type/row pairs, where the type is a string "data" or "whead" and the row is an arrayref: 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}; my $next_needs_head; for (@{$opt->{rows} \|\| []}) { if (!ref and /^whead$/) { $next_needs_head = 1; next; } elsif (!ref) { $next_needs_head = 0; next; } row($tab + 1, $next_needs_head?"whead":"data", $_); $next_needs_head = 0; } line($tab,q(</table>)); } table(1, { id => 't1', headings => [qw/NAME STRENGTH COMMENT/], rows => [ whead => [qw/1 2 no/], data => [qw/2 3 yes/], whead => [qw/10 20 another/], data => [qw/100 200 comment/], ], }); [download] Read more... (14 kB) `package Cow { use Moo; has name => (is => 'lazy', default => sub { 'Mooington' }) } say Cow->new->name`	[reply] [d/l] [select]
Re^2: 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 (Priest) on Mar 25, 2013 at 22:08 UTC
tobyink, `headings` are rows just like `data` and `whead` so modifying your example of usage ... table(1, { id => 't1', rows => [ headings => [qw/NAME STRENGTH COMMENT/], whead => [ # multiple rows with the first cell being a header. [1, [2, { style => 'text-align: right' }], 'no'], [2, [3, { style => 'text-align: right' }], 'yes'], [10, [20, { style => 'text-align: right' }], 'another'], [100, [200, { style => 'text-align: right' }], 'comment'], ], headings => [['List to go with the whead' { colspan => 3 }]], data => [['list', { class => 'info', colspan => 3, list => [$ +list, { class => 'two_cols' }] }]], ], }); [download] I can understand why you would want to pass individual rows, however, you are not taking into consideration a table with hundreds or even thousands of rows. I have one table with over 2,000 rows, so I would prefer a way to pass them through with an arrayref. In my modified example, I put `headings` inside of `rows`. I can not have two `headings` currently and can not set the order in which the `row` groups are displayed. Oh, `line` comes from another module, so if possible, is there a way to use it as is? I use `line` in every script I write where I am printing lines. choroba suggested I build the `@attributes` separately, and I agree. I will be looking at what he did and see how I can modify it to my exact needs then adding it to the module. Also, the last time I tried figuring out OO, I was told I did it all wrong. OO and I have not become friends yet. So, right now I do not know what to ask on how to change what you wrote to suit my desires. Give me a lot of time to understand what you wrote, please? Update: It looks like you dropped the attributes from all the elements except `table`. Every HTML tag can have its own attributes. Since I am generating the HTML with perl, I could go really crazy and give every element its own `id`, but I will refrain. *Have a cookie and a very nice day!* Lady Aleena	[reply] [d/l] [select]
Re^3: 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 tobyink (Canon) on Mar 26, 2013 at 09:39 UTC
"Oh, line comes from another module, so if possible, is there a way to use it as is? I use line in every script I write where I am printing lines." Sure. I left it out in the interests of self-containedness. But it should just be a case of (in package MyElem): `sub _line { shift; my $tab = shift; require The::Other::Module; The::Other::Module::line($tab, join " ", @_); }` [download] e "choroba suggested I build the @attributes separately, and I agree. I will be looking at what he did and see how I can modify it to my exact needs then adding it to the module." Yes, in my final update I did this. "Also, the last time I tried figuring out OO, I was told I did it all wrong." Yes, I recall. That's why I took it in stages, so you can see how one style of coding translates to another. If I'd just posted the final version, it might be a bit mysterious how the things in your code corresponds to mine. Seeing the different steps makes it clearer that I didn't really add or remove much; just structured it into smaller parcels; replaced arrayrefs and hashrefs with objects; and replaced function calls with method calls. The main thing this buys you is polymorphism: a table object can call the `output` method on one of the row objects it contains, and it doesn't need to care about what type of row it is. Polymorphism is the main reason why people bang on about about OO all the time. It's a really great way of maintaining separation of concerns (i.e, so the MyCell package knows all about how to output cells, but the MyRow package needs to know nothing about how to output cells), and providing extensibility. An example of extensibility might be that you could define a new cell class: `{ package MyCell::Important; use base "MyCell"; sub _init { my $self = shift; no warnings "uninitialized"; $self->{style} = "color:red;font-weight:bold;$self->{style}"; } }` [download] And you can use your `MyCell::Important` class in tables without needing to make any changes to the `MyRow` or `MyTable` classes at all! `package Cow { use Moo; has name => (is => 'lazy', default => sub { 'Mooington' }) } say Cow->new->name`	[reply] [d/l] [select]
Re^4: 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 (Priest) on Mar 26, 2013 at 11:09 UTC
Re: 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 Anonymous Monk on Mar 25, 2013 at 10:14 UTC
title is no good, make some effort How do I compose an effective node title?	[reply]
Re^2: 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 Anonymous Monk on Mar 25, 2013 at 10:19 UTC
title is no good, make some effort How do I compose an effective node title? Sorry but "no good" "doesn't work" as an alternative title suggestion, please make some effort	[reply]