File Coverage

blib/lib/HTML/Dashboard.pm

Criterion	Covered	Total	%
statement	307	408	75.2
branch	69	92	75.0
condition	20	33	60.6
subroutine	46	77	59.7
pod	57	60	95.0
total	499	670	74.4

package HTML::Dashboard;

use 5.008008;
use strict;
use warnings;

use Carp;

our $VERSION = '0.03';

# ============================================================

# Test:
# - escape of \t and \n in as_text
# - DB access stuff (incl DB errors)

# ------------------------------------------------------------

my ( $HI, $MED, $LOW ) = ( 300, 200, 100 );

sub new {
  my $arg = shift;
  my $class = $arg; # Always create through class name, not instance

  # Check _init_data_defaults below for meaning of individual variables...
  my $self = bless { data     => [],
		     first    => undef,
		     last     => undef,
		     records  => undef,
		     pagesize => undef,
		     captions => [],
		     view     => [],
		     sortrank => [],
		     comparator => undef,
		     format   => {} }, $class;

  # If triggers are set, these will be stored in the following instance
  # variables as multi-hash, keyed on column (==0 for row triggers) and
  # priority. The value is an array-ref, containing the trigger sub and
  # a key, which can be used to find the corresponding formatting options
  # in $self->{opts}.
  # Fired_col_triggers is set by _find_triggered_columns - since the
  # format of the ENTIRE col may depend on the entry of a single cell
  # in this col, col triggers must be evaluated ahead of time, and can
  # not be applied row by row, as is possible for cell and row triggers.
  # If a col trigger fired, its key will be stored in fired_col_triggers.
  $self->{ ROW_TRIGGERS }  = undef;
  $self->{ COL_TRIGGERS }  = undef;
  $self->{ CELL_TRIGGERS } = undef;
  $self->{ fired_col_triggers } = undef;

  # For each HTML tag (or Pseudo-tag, such as first_row), there is a hash,
  # containing HTML/CSS formatting arguments. A hash is used, so that
  # formatting commands from different (pseudo-)tags can be blended easily.
  # For instance, if a command for  has been set, as well as for
  # even_row, we want to blend both of them together for even rows. Hashes
  # can do this conveniently, using the following idiom:
  #     %tr = ( %tr, %{ $self->{opts}{even_row} } )
  #
  # The value of each $self->{opts}{...} is a hash-ref. Permissible keys
  # into this hash-ref are "html" (or "color"), "class", and "style", eg
  #     $self->{opts}{table}{html} = "border='1'"
  # For key "html", the value must be a string which can be inserted
  #   directly into the corresponding HTML tag.
  # For key "color", the value must be a legal HTML color specification,
  #   ie. either in #rrggbb format or one of the recognized color names.
  # For key "class", the value must be the name of a CSS class.
  # For key "style", the value must be a string which can be given directly
  #   as value to a <... style="..."> argument of the corresponding HTML tag.
  #
  # The _glue() function is responsible for final formatting of these opts.
  $self->{opts}{ table } = {};
  $self->{opts}{ tr } = {};
  $self->{opts}{ th } = {};
  $self->{opts}{ td } = {};

  $self->{opts}{ first_row } = {};
  $self->{opts}{ odd_row   } = {};
  $self->{opts}{ even_row  } = {};
  $self->{opts}{ last_row  } = {};

  $self->{opts}{ first_col } = {};
  $self->{opts}{ odd_col   } = {};
  $self->{opts}{ even_col  } = {};
  $self->{opts}{ last_col  } = {};

  for my $i ( qw( ROW COL CELL ) ) {
    for my $j ( $HI, $MED, $LOW ) {
      $self->{opts}{ $i . "_TRIGGERS_" . $j } = {};
    }
  }

  # Defaults formats:
  $self->_set_options( 'odd_row', '#eeeeee' );
  $self->_set_options( 'table', 'border="1"' );

  return $self;
}

# For debugging purposes...
sub dump_opts {
  my $self = shift;

  my $out = '';

  $out .= "First:     " . $self->{first} . "\n";
  $out .= "Last:      " . $self->{last} . "\n";
  $out .= "Records:   " . $self->{records} . "\n";
  $out .= "Pagesize:  " . $self->{pagesize} . "\n";
  $out .= "Pagecount: " . $self->get_pagecount() . "\n";
  $out .= "\n";
  $out .= "Captions:  " . join( ' | ', @{ $self->{captions} } ) . "\n";
  $out .= "View:      " . join( ', ', @{ $self->{view} } ) . "\n";

  for my $field ( keys %{ $self->{opts} } ) {
    my @keys = keys %{ $self->{opts}{$field} };
    if( scalar @keys == 0 ) { next; }

    $out .= "\n=== $field ===\n";
    for my $key ( @keys ) {
      $out .= "       $key [ " . $self->{opts}{$field}{$key} . " ]\n";
    }
  }
  return $out;
}

# All of these instance variables can only be set once the data is known.
sub _init_data_defaults {
  my ( $self, $first ) = @_;

  # Index of first data record:
  $self->{first} = $first;

  # Index of last data record:
  $self->{last} = scalar( @{ $self->{data} } ) - 1;

  # Number of records in data set (not counting captions)
  $self->{records}  = 1 + $self->{last} - $self->{first};

  # Number of records in page - defaults to all
  unless( $self->{pagesize} ) {
    $self->{pagesize} = $self->{records};
  }

  # Column indices selected for view - defaults: all in natural order
  unless( @{ $self->{view} } ) {
    $self->{view} = [ 0..( scalar @{ $self->{data}[0] } - 1 ) ];
  }

  # Row indices in sort order - default: natural order
  $self->{sortrank} = [ $self->{first}..$self->{last} ];


  # Further variables referred to in the constructor are:
  # captions   : an array, containing strings to be used as col captions
  # comparator : a sub-ref, used for sorting (cf. set_sort() and _sort_rank() )
  # format     : a hash-ref, keyed on the column, which will receive the
  #              output of the formatter. The value is an array-ref, containing
  #              the formatter sub-ref, and an indicator whether the sub-ref
  #              is a formatter (single argument) or collater (row argument).
}

# -----

sub set_data_without_captions {
  my ( $self, $data ) = @_;
  unless( $data && ref( $data ) eq 'ARRAY' ) { carp "Not an array ref!" }

  $self->{data} = $data;

  $self->_init_data_defaults( 0 );
}

sub set_data_with_captions {
  my ( $self, $data ) = @_;
  unless( $data && ref( $data ) eq 'ARRAY' ) { carp "Not an array ref" }

  $self->{data} = $data;

  $self->set_captions( @{ $data->[0] } );

  $self->_init_data_defaults( 1 );
}

# -----

sub get_query { my $self = shift; return $self->{sql} }

sub set_query_without_captions {
  my ( $self, $dbh, $sql ) = @_;
  $self->{sql} = $sql;

  $self->{data} = $dbh->selectall_arrayref( $sql );

  $self->_init_data_defaults( 0 );
}

sub set_query_with_captions {
  my ( $self, $dbh, $sql ) = @_;
  $self->{sql} = $sql;

  $self->{data} = $dbh->selectall_arrayref( $sql );

  $self->set_captions( @{ $self->{data}[0] } );

  $self->_init_data_defaults( 1 );
}

# -----

# UNIMPLEMENTED!
#
# The idea is to provide a way to set an SQL query, without executing it.
# Later, the query can be executed (using exec_query), while supplying
# values for bind variables.

sub prepare_query_without_captions { }
sub prepare_query_with_captions { }
sub exec_query { } # Takes query parameters

# -----

sub set_sort {
  my ( $self, $sub ) = @_;
  $self->{comparator} = $sub;
}

sub _sort_rank {
  my $self = shift;

  unless( $self->{comparator} ) { return; }

  $self->{sortrank} =
    [ sort { $self->{comparator}( $self->{data}[$a], $self->{data}[$b] ) }
      @{ $self->{sortrank} } ];
}

# -----

# UNIMPLEMENTED!
#
# When there are subsequent rows, which have identical entries in some
# columns it can be neat to neat to suppress (leave blank) the repeated
# entries. These functions would take the col indices of the cols to be
# monitored for repeating behaviour and suppress them during output.

sub set_skip_repeats { }
sub get_skip_repeats { }

# ------------------------------------------------------------

sub set_view { my ( $self, @cols ) = @_; $self->{view} = \@cols; }
sub get_view { my $self = shift; return $self->{view}; }

sub set_captions { my ( $self, @caps ) = @_; $self->{captions} = \@caps; }
sub get_captions { my $self = shift; return $self->{captions}; }

# Setting pagesize to undef, 0, or a negative value turns off pagination
sub set_pagesize {
  my ( $self, $arg ) = @_;

  if( defined $arg && $arg > 0 ) {
    $self->{pagesize} = $arg;
  } else {
    $self->{pagesize} = $self->{records};
  }
}

sub get_pagesize { my $self = shift; return $self->{pagesize}; }

sub get_pagecount {
  my $self = shift;

  if( !defined $self->{pagesize} ) { return 1; } # No pagination: 1 page

  my $full = int( $self->{records}/$self->{pagesize} ); # Count of full pages
  my $frac = $self->{records} % $self->{pagesize}; # Records on last partial pg

  return $full + ( $frac ? 1 : 0 );
}

# ------------------------------------------------------------

# Takes a hash-ref - the slice of $self->{opts} for the selected HTML element
# and glues them together into a string which can be directly embedded
# into an HTML tag.
# In doing so, it makes sure that 'color' options are properly embedded
# into the 'style' argument, etc.

sub _glue {
  my ( $self, $args ) = @_;

  my $out = exists $args->{html} ? $args->{html} . ' ' : '';
  $out .= exists $args->{class} ? 'class="' . $args->{class} .'" ' : '';

  if(       exists $args->{color} &&  exists $args->{style} ) {
    $out .= 'style="' . $args->{style} . '; ';
    $out .= 'background-color: ' . $args->{color} . '" ';

  } elsif( !exists $args->{color} && exists $args->{style} ) {
    $out .= 'style="' . $args->{style} . '" ';

  } elsif(  exists $args->{color} && !exists $args->{style} ) {
    $out .= 'style="background-color: ' . $args->{color} . ';" ';
  }

  return $out;
}

# For pagination: finds the index of the first row to display and the
# index of the first row NOT to display, in other words, use the following
# loop to display:   for( $i=$from; $i<$upto; $i++ )

sub _find_range_for_page {
  my ( $self, $page ) = @_;

  # Find the range of rows to plot:
  my ( $from, $upto ) = ( 0, $self->{records} );

  if( defined $page ) {
    if( $page < 0 || $page > $self->get_pagecount() ) {
      carp "Out of bounds page $page requested - returning all rows.";

    } elsif( defined $self->{pagesize} ) { # only do pagination if switched on
      $from = $page * $self->get_pagesize();
      $upto = $from + $self->get_pagesize();

      if( $upto > $self->{records} ) {
	$upto = $self->{records}; # Fractional last page
      }
    }
  }

  return ( $from, $upto );
}

sub _check_consistency {
  my $self = shift;

  my ( $warn, $fatal ) = ( '', '' );

  my $colcnt = 0;
  if( $self->{records} < 1 ) {
    $warn .= "Empty data set\n";
  } else {
    my @colcount = map { scalar @{ $_ } } @{ $self->{data} };
    $colcnt = $colcount[0];
    if( scalar ( grep { $_ != $colcnt } @colcount ) ) {
      $fatal .= "Data not rectangular. Column lengths: ";
      $fatal .= join( ',', @colcount ) . "\n";
    }
  }

  if( @{ $self->{captions} } && $colcnt &&
      scalar @{ $self->{captions} } != scalar @{ $self->{data}[0] } ) {
    $fatal .= "Number of captions not equal to number of columns\n";
  }

  if( scalar ( grep { $_ < 0 || $_ >= $colcnt } @{ $self->{view} } ) ) {
    $fatal .= "Illegal index in view\n";
  }

  if( $fatal )   { croak "$warn $fatal"; }
  elsif( $warn ) { carp  "$warn"; }
}

# ------------------------------------------------------------
# Output Routines
#
# Tables are built up outside in (table->row->cell->contents).
# For each element, all opts are collected and all rules and
# triggers are evaluated. This leads to a fully formed HTML tag.
# Then the subsequent element (ie after
# is evaluated in a similar fashion.

# -----

# Convention (for the following routines):
# $row, $col   : the indices of the 'true' row or col in the full data set
# $prow, $vcol : the indices of the row in the current page or the column
#                    in the current view
# ------------------------------------------------------------

sub as_text {
  my ( $self, $page ) = @_;

  $self->_check_consistency();

  my ( $from, $upto ) = $self->_find_range_for_page( $page );

  $self->_sort_rank();

  my $body = '';
  if( @{ $self->{captions} } ) {
    # Array slice of @captions, indexed by @view...
    $body .= join( "\t", @{ $self->{captions} }[ @{ $self->{view} } ] ) . "\n";
  }

  my ( $prow, $vcol, $row, $col ) = ( 0, 0, 0, 0 );
  foreach my $idx ( $from..$upto-1 ) {
    $row = $self->{sortrank}[$idx];

    $vcol = 0;
    foreach my $col ( @{ $self->{view} } ) {
      my $token = $self->_content( $prow, $vcol, $row, $col );
      $token =~ s/([\t\n\\])/\\$1/g; # Escape newline, tab, and backslash
      $body .= "$token\t";
      $vcol += 1;
    }
    chop $body; # remove the last tab, then replace with newline
    $body .= "\n";

    $prow += 1;
  }
  # The last newline is NOT chopped - text ends with a newline.

  return $body;
}

sub as_HTML {
  my ( $self, $page ) = @_;

  $self->_check_consistency();

  my ( $from, $upto ) = $self->_find_range_for_page( $page );

  $self->_sort_rank();
  $self->_find_triggered_columns();


  # Find options - only simple options for table-tag:
  my %table = %{ $self->{opts}{table} };

  # Build the body of the table:
  my ( $prow, $body ) = ( 0, '' );
  foreach my $idx ( $from..$upto-1 ) {
    my $row = $self->{sortrank}[$idx];
    $body .= $self->_row( $prow++, $row );
  }

  # Build output:
  my $out = "\n\n";
  $out .= "\n";
  $out .= '_glue( \%table ) . ">\n"; 




445




17





 





 





 





 





93



   $out .= $self->_caption() . "\n"; 




446




17





 





 





 





 





57



   $out .= $body . "\n"; 




447




17





 





 





 





 





19



   $out .= "\n\n";
  $out .= $self->_caption() . "\n";
  $out .= $body . "\n";
  $out .= "

  return $out;
}

# Returns a fully formed caption row:
sub _caption {
  my ( $self ) = @_;

  unless( @{ $self->{captions} } ) { return ''; }

  my %tr = %{ $self->{opts}{tr} };
  my %th = %{ $self->{opts}{th} };
  my $th = '

  my $out = '
  foreach my $col ( @{ $self->{view} } ) {
    $out .= $th . $self->{captions}[$col] . '';
  }
  $out .= '
  return $out . "\n";
}

sub _row {
  my ( $self, $prow, $row ) = @_;

  # Build options:
  my %tr = %{ $self->{opts}{tr} };

  # Odd/Even Row
  if( $prow %2 == 0 ) { %tr = ( %tr, %{ $self->{opts}{even_row} } ); }
  else                { %tr = ( %tr, %{ $self->{opts}{odd_row} } ); }

  # First/Last Row
  if( $prow == 0 ) {
    %tr = ( %tr, %{ $self->{opts}{first_row} } ); # First row
  } elsif( $prow == $self->{pagesize} - 1 ) {
    %tr = ( %tr, %{ $self->{opts}{last_row} } );  # Last row
  }

  # Triggers: Hi->Med->Low
  if( exists $self->{ROW_TRIGGERS} ) {
    for my $prio ( sort { $b <=> $a } keys %{ $self->{ROW_TRIGGERS}{0} } ) {
      my ( $trig, $key ) = @{ $self->{ROW_TRIGGERS}{0}{$prio} };

      if( $trig->( $self->{data}[$row], $prow, $row ) ) {
	%tr = ( %tr, %{ $self->{opts}{$key} } );
	last;
      }
    }
  }

  # Build column body:
  my ( $vcol, $body ) = ( 0, '' );
  foreach my $col ( @{ $self->{view} } ) {
    $body .= $self->_cell( $prow, $vcol++, $row, $col );
  }

  my $out = '

  return $out;
}

sub _cell {
  my ( $self, $prow, $vcol, $row, $col ) = @_;

  my %td = %{ $self->{opts}{td} };


  # Even/odd column
  if( $vcol %2 == 0 ) { %td = ( %td, %{ $self->{opts}{even_col} } ); }
  else                { %td = ( %td, %{ $self->{opts}{odd_col} } ); }

  # First/last column
  if( $vcol == 0 )    {
    %td = ( %td, %{ $self->{opts}{first_col} } );   # First column
  } elsif( $vcol == scalar( @{ $self->{view} } )-1 ) {
    %td = ( %td, %{ $self->{opts}{last_col} } );    # Last column
  }


  # Cell triggers
  my $flag = 0;
  if( exists $self->{CELL_TRIGGERS}{ $col } ) {
    for my $prio ( sort { $b <=> $a } keys %{ $self->{CELL_TRIGGERS}{$col} } ){
      my ( $trig, $key ) = @{ $self->{CELL_TRIGGERS}{ $col }{ $prio } };

      if( $trig->( $self->{data}[$row][$col], $vcol, $col ) ) {
	%td = ( %td, %{ $self->{opts}{$key} } );
	$flag = 1;
	last;
      }
    }
  }


  # Col triggers - only if no cell triggers have fired!
  if( !$flag && exists $self->{fired_col_triggers}{ $col } ) {
    my $key = $self->{fired_col_triggers}{ $col };
    %td = ( %td, %{ $self->{opts}{ $key } } );
  }


  return join '', '
                  $self->_content( $prow, $vcol, $row, $col ), '
}

sub _content {
  my ( $self, $prow, $vcol, $row, $col ) = @_;

  if( exists $self->{format}{$col} ) {
    my ( $format, $type ) = @{ $self->{format}{$col} };

    if( $type eq 'format' ) {
      return $format->( $self->{data}[$row][$col] );
    } else {
      return $format->( @{ $self->{data}[$row] } );
    }
  }

  return $self->{data}[$row][$col];
}

# ------------------------------------------------------------

sub _get_options {
  my ( $self, $opt ) = @_; # $opt must be: first_col, or odd_row, etc

  # Worry about notfound?

  # Return value is always: undef or a hash-ref: key/value (?)

  return $self->{opts}{$opt};
}

sub _set_options {
  my ( $self, $opt, $arg, $val ) = @_;

  # Decide if one or two arguments are present...
  if( !defined $val ) { # One argument - figure out the 'key', arg is 'val'
    my %html = ( table => 1, tr => 1, th => 1, td => 1 );
    my $field = exists $html{$opt} ? 'html' : 'color';

    $self->{opts}{$opt}{$field} = $arg;

  } elsif( $arg eq 'class' || $arg eq 'style' ) { # Two args: key and val
    $self->{opts}{$opt}{$arg} = $val;

  } else {
    carp "Illegal arguments - ,$opt, ,$arg, ,$val,";
  }
}

# ------------------------------------------------------------
# Arguments:
# $htmlargs   ||   class => $class   ||   style => $style

sub set_table { my $s = shift; return $s->_set_options( 'table', @_ ); }
sub set_tr    { my $s = shift; return $s->_set_options( 'tr', @_ ); }
sub set_th    { my $s = shift; return $s->_set_options( 'th', @_ ); }
sub set_td    { my $s = shift; return $s->_set_options( 'td', @_ ); }

sub get_table { my $s = shift; return $s->_get_options( 'table' ); }
sub get_tr    { my $s = shift; return $s->_get_options( 'tr' ); }
sub get_th    { my $s = shift; return $s->_get_options( 'th' ); }
sub get_td    { my $s = shift; return $s->_get_options( 'td' ); }

# ------------------------------------------------------------
# Arguments:
# $color   ||   class => $class   ||   style => $style

sub get_first_row { my $s = shift; return $s->_get_options( 'first_row' ); }
sub get_odd_row   { my $s = shift; return $s->_get_options( 'odd_row' ); }
sub get_even_row  { my $s = shift; return $s->_get_options( 'even_row' ); }
sub get_last_row  { my $s = shift; return $s->_get_options( 'last_row' ); }

sub get_first_col { my $s = shift; return $s->_get_options( 'first_col' ); }
sub get_odd_col   { my $s = shift; return $s->_get_options( 'odd_col' ); }
sub get_even_col  { my $s = shift; return $s->_get_options( 'even_col' ); }
sub get_last_col  { my $s = shift; return $s->_get_options( 'last_col' ); }

# -----

sub set_first_row { my $s = shift;  $s->_set_options( 'first_row', @_ ); }
sub set_odd_row   { my $s = shift;  $s->_set_options( 'odd_row',   @_ ); }
sub set_even_row  { my $s = shift;  $s->_set_options( 'even_row',  @_ ); }
sub set_last_row  { my $s = shift;  $s->_set_options( 'last_row',  @_ ); }

sub set_first_col { my $s = shift;  $s->_set_options( 'first_col', @_ ); }
sub set_odd_col   { my $s = shift;  $s->_set_options( 'odd_col',   @_ ); }
sub set_even_col  { my $s = shift;  $s->_set_options( 'even_col',  @_ ); }
sub set_last_col  { my $s = shift;  $s->_set_options( 'last_col',  @_ ); }

# ------------------------------------------------------------
# Arguments:
# $col, $sub,   $color   ||   class => $class   ||   style => $style

sub _set_trigger {
  my ( $self, $elem, $prio, $col, $sub, @args ) = @_;

  my $trig = join '_', $elem, 'TRIGGERS';
  my $key  = join '_', $trig, $prio;

  $self->{ $trig }{ $col }{ $prio } = [ $sub, $key ];
  $self->_set_options( $key, @args );
}

# sub set_row_trigger { my ( $self, $prio, $sub, @args ) = @_; }
sub set_row_trigger {
  my ( $self, $prio, @args ) = @_;
  $self->_set_trigger( 'ROW', $prio, 0, @args );
}
sub set_row_hi  { my $self = shift; $self->set_row_trigger( $HI,  @_ ); }
sub set_row_med { my $self = shift; $self->set_row_trigger( $MED, @_ ); }
sub set_row_low { my $self = shift; $self->set_row_trigger( $LOW, @_ ); }

# sub set_col_trigger { my ( $self, $prio, $col, $sub, @args ) = @_; }
sub set_col_trigger { my $self = shift; $self->_set_trigger( 'COL', @_); }
sub set_col_hi  { my $self = shift; $self->set_col_trigger( $HI,  @_ ); }
sub set_col_med { my $self = shift; $self->set_col_trigger( $MED, @_ ); }
sub set_col_low { my $self = shift; $self->set_col_trigger( $LOW, @_ ); }

# sub set_cell_trigger { my ( $self, $prio, $col, $sub, @args ) = @_; }
sub set_cell_trigger { my $self = shift; $self->_set_trigger( 'CELL', @_); }
sub set_cell_hi  { my $self = shift; $self->set_cell_trigger( $HI,  @_ ); }
sub set_cell_med { my $self = shift; $self->set_cell_trigger( $MED, @_ ); }
sub set_cell_low { my $self = shift; $self->set_cell_trigger( $LOW, @_ ); }


sub _find_triggered_columns {
  my $self = shift;

  unless( exists $self->{COL_TRIGGERS} ) { return; }

  my $vcol = -1;
  for my $col ( @{ $self->{view} } ) {
    $vcol += 1;

    unless( exists $self->{COL_TRIGGERS}{ $col } ) { next; }

    # Low->Med->Hi : higher priority clobbers earlier results!
    for my $prio ( sort { $a <=> $b } keys %{ $self->{COL_TRIGGERS}{$col} } ) {
      my ( $trig, $key ) = @{ $self->{COL_TRIGGERS}{$col}{$prio} };

      foreach my $idx ( 0..$self->{records} ) {
	my $row = $self->{sortrank}[$idx];
	if( $trig->( $self->{data}[$row][$col], $vcol, $col ) ) {
	  $self->{fired_col_triggers}{$col} = $key;
	  last;
	}
      }
    }
  }
}

# ------------------------------------------------------------
# Arguments:
# $col, $sub

# For each column, a formatting function can be set. The function is called
# for each cell in the column. The return value of the function is used as
# printable content of the cell.
# A 'format' function receives as argument the raw value of the cell.
# A 'collate' function receives as argument the entire row as an array.
#
# Examples:
# format:
#    sub { substr $_[0], 0, 3 } prints only first three chars of cell val
# collate:
#   sub { $_[0] . '=' . $_[1] } concates first and second column value

sub set_format {
  my ( $self, $col, $sub ) = @_;
  $self->{format}{$col} = [ $sub, 'format' ];
}

sub set_collate {
  my ( $self, $col, $sub ) = @_;
  $self->{format}{$col} = [ $sub, 'collate' ];
}

1;

__END__