package Data::Dataset::Colmap;

use strict;
use warnings;
use base qw(Data::Dataset);


=head1 NAME

Data::Dataset::Colmap - column delegation and data generation

=head1 DESCRIPTION

Subclass provides additional columns for existing dataset object(s),
by calculating the column's value during get or by horizontally
joining columns from another dataset.

Objects of Colmap do not provide additional storage per se, but the
CODE that generates the columns may rely on storage found elsewhere;
either Perl variables, another Dataset object or columns in their own
object.

Multiple existing Dataset objects may be joined, provided each has the
same number of rows.

=head2 Example and diagram

Given a 3x3 inner dataset C<$D> which looks like this,

 +- $D --+
 | A B C |
 +-------+
 | 1 2 3 |
 | 4 5 6 |
 | 7 8 9 |
 +-------+

and the creation of the outer Dataset C<$D2>

 my $D2 = Data::Dataset::Colmap->new(-def => [ $D, sum => sub {
     my ($o, $rowId) = @_;
     my ($a, $b, $c) = $o->getcols($rowId, qw( A B C ));
     return $a + $b + $c;
   },
   C => sub { return 10; },
 ]);

it will contain four columns: two pass-through defintions which
provide access to the data of C<$D>, one derived column which provides
a sum of values and one shadowing or override column.

 +- $D2 -----------+
 | A B       C sum |
 +---------+       |
           |       |
 +- $D --+ |       |
 | A B C | |       |
 +-------+ +-------+
 | 1 2 3 | | 10 13 |
 | 4 5 6 | | 10 19 |
 | 7 8 9 | | 10 25 |
 +-------+ +-------+

The values (13, 19, 25; 10, 10, 10) are not retrieved from storage,
they are calculated on demand.

The values (3, 6, 9) are not accessible via C<$D2>, they are shadowed
by the new definition of column C.  They may of course still be
accessed via C<$D>, if you have access to that.  The sum includes the
new definition of C not the old one, because this is the value passed
in for C<$o> in the anonymous function.

The column C comes before sum because it was first defined by the
import of $D in the definition order.

=head2 Example usage

(mostly, a dump of ideas off the whiteboard)

=over 4

=item Derived or composite data

 my $person = Data::Dataset::Grid->new(-name => 'person', -cols => [qw[forename surname ...]], -rows => \@rows);
 my $composite = $person->colmap('person2', fullname => sub {
    my ($me, $rowId) = @_;
    return join " ", $me->getcols($rowId, 'forename', 'surname');
 });

Such derived data is useful for display in GUI widgets, but harder to
make editable.

=item Fetching nested Dataset

CODE column can run another query and return a nested Dataset object.

Cache by scalar ref trick below or other lazy-pop Dataset.

Useful for hierarchical GUI components, e.g. HList.

=item Adjoin columns from elsewhere

Adjoin columns of SCALAR refs provides convenient storage per row for
caching or flags.

Transparent, live dict lookups...  but requires CODE column creation
for each column of the adjoining data, unless there is 1:1 row
correspondence.

Probably best done with a dedicated class for making joins.  The
joiner needs to know how to reverse-map a set in the dict, back to
setting the relevant id in some other column.

=item getDict

Function (or dataset?) to return Dataset for a named dictionary,
possibly including extra colmap fields where useful (%pluscols).
Cached, possibly with refetch timeout.  Useful for joins...

Access to getDict should be via Dataset metadata?

=item __gencol__dict_join

Colmap code for doing SQL-style join to dict.  Works, but would be
neater if done with another Dataset subclass?

=item Event observation

CODE columns can do notification, but there should probably be a
better way.

=back

=head2 Missing things & bugs

Writing to CODE columns will be tricky, unless their definition is
changed (to a hash of CODE?) or extended (different calling pattern).

Caching of CODE-generated fields can be done by the SCALAR refs trick,
but isn't tidy.  Going via a lazy-pop Dataset would be better.

Caching of generated rows isn't possible.

Renaming columns can only be done with a CODE column each, although it
could be made simpler.  Easier to pick your names carefully.

It isn't clear what happens when CODE decides to return a list instead
of a scalar.  It works as expected at the moment, at least when
fetching the column directly with C<get>, but it's likely to cause
chaos with the multi-fetch methods and may end up being evaluated in
scalar context in other places.  Better to define CODE as being called
in scalar context, then ensure this happens?

Create-on-demand or regex-match columns.  Would avoid the need for the
HTML table generator to predefine many columns, if it could instead
define a rule to say "columns named 'foo>html' shall be the result of
escapeHTML(get('foo'))"

=cut

# $Id: Colmap.pm,v 1.11 2007/01/09 12:01:32 mca Exp $

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

=head2 new(-name => $name, -def => \@items, -src => $first)

Old style construction params, due to change.

If C<-src =E<gt> $first> is supplied, it should be a Dataset.  It will
be inserted at the start of @items.

See also C<$item-E<gt>colmap>

XXX: Old docs follow,

Build a new object containing no additional data but links to other
Dataset object(s).

The column map is built taking C<@items> in turn, and later ones may
replace or remove earlier ones.

When an item is a blessed ref, it will be taken as a Dataset and all
columns imported to the map.  (This is just a shortcut for doing each
column as key/value pairs, below.)

When the item is not a reference, it will be taken as the first of a
C<colname =E<gt> $value> pair.  (Error if $value missing.)

=over 4

=item $value is C<undef>

The named column will be removed from the map, but may be replaced by
later items.

=item $value is an unblessed CODE ref

A C<$obj-E<gt>get($colId, $rowId)> will cause $value to be called in
scalar context with arguments C<($obj, $rowId, $colname)> and
propagate the return value.

Note that this call signature is equivalent to being called as a
method on the resulting object (without inheritance complications),
but any suitable piece of CODE may be used.

=item $value is a blessed ref

Will be taken as a Dataset in which to look up the named column.

=item Other - not supported

If $value is a colname or colnum string, we might expect to be
re-titling a column within the resulting dataset (allows duplication
but not renaming) OR renaming a column in the most recently mentioned
source (requires more complex structure for colname2info).

More complex structures should allow joins.  See
ATR::Tk::ColonyEd::__gencol__dict_join for example.

=back

Column order will be the order they were first seen.  Error if the row
counts don't match up across possible data sources.
(or there are no rows...?  XXX: doesn't give an error in my test, and an zero rows is a fair case)

B<nb.> to the extent that setting Datasets is supported at all, it may
be supported to a different degree for the various types of colmap
definition.  Currently, CODE cannot be poked.

=cut

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

    %args = $self->SUPER::_init(%args);
    # XXX: name not present until after SUPER::_init, needed in _init_colmap

    my $items = delete $args{-def};
    my $src = delete $args{-src};

    die $self->description.": Colmap->new requires -def => [ items... ]" unless ref($items) eq 'ARRAY';
    my @items = @$items; # avoid modifying users array
    unshift @items, $src if $src;

    $self->_init_colmap(@items);

    return %args;
}


sub _init_colmap {
    my ($self, @items) = @_;
    my $descr = $self->description;

    # Generate column map
    my (%colmap, @col_order);
    while (@items) {
	my $item = shift @items;
	die "Found undef 'item' while making $descr" if !defined $item;
	if (ref($item) eq 'CODE') {
	    die "Bad colmap, perhaps you forgot the '\$name' parameter again?";
	} elsif (ref($item)) {
	    # assume it's blessed, since we have no other meanings
	    # do the "all columns" shortcut
	    my @src_col = $item->colnames;
	    unshift @items, map {( $_ => $item )} @src_col;
	    next;
	} # else not a ref: it's a key, value should follow

	die "Missing value on item '$item' while making $descr" unless @items;
	my ($colname, $value) = ($item, shift @items);
	push @col_order, $colname; # remove dups later
	if (!defined $value) {
	    # unmap it
	    delete $colmap{$colname}; # @col_order entry will be filtered later
	} elsif (ref($value) eq 'CODE' || UNIVERSAL::isa($value, 'Data::Dataset')) {
	    # CODE or a Data::Dataset
	    $colmap{$colname} = $value;
	} else {
	    die "Unrecognised colmap definition type ($colname => $value) while making $descr";
	}
    }

    # Whittle out dups from @col_order, collect %sources (key = value = target Dataset)
    my (@cols, %seen, %sources);
    foreach my $colname (@col_order) {
	next if $seen{$colname};
	if (exists $colmap{$colname}) {
	    push @cols, $colname;
	    my $value = $colmap{$colname};
	    $sources{$value} = $value if ref($value) && ref($value) ne 'CODE';
	}
	$seen{$colname} = 1;
    }
    my @sources = values %sources;
    $self->{sources} = \@sources;
    $self->{colmap} = \%colmap;
    $self->{cols} = \@cols;
    my %col2num;
    @col2num{@cols} = (0 .. $#cols);
    $self->{col2num} = \%col2num;

    my $junk = $self->rowCount; # check we have one, at least to start with
}


=head2 colname2info($column_name)

Object method.  Returns the respective column number (colnum), or
C<undef> if the name isn't known.

On an object generated with C<colmap>, may return another
L<Data::Dataset> object or CODE ref; in this case, that object is being
delegated for the operation.

=cut

sub colname2info { $_[0]->{colmap}->{$_[1]} }


sub rowCount {
    my $self = shift;

    # Check the row count; don't cache it 'cos we have no change observer
    my $rows = undef;
#warn "  : sourcecount = ".@{ $self->{sources} }, "\n";
    foreach my $src (@{ $self->{sources} }) {
	my $new_rows = $src->rowCount;
#warn "  : source ".$src->description." = $new_rows\n";
	last unless defined $new_rows; # object doesn't know, we can't do anything  XXX: surely 'next'???  needs a test and some thought
	if (defined $rows) {
	    die "Conflicting row counts (so far: $rows; ".$src->description.": $new_rows) in ".$self->description
	      unless $new_rows == $rows;
	} else {
	    $rows = $new_rows;
	}
    }
    return $rows;
}


=head2 rowList

Mostly this returns 0 .. N the same as the superclass, but...

XXX: special case: colmap of a rowmap(hash), because that has named rows instead of numbers

Worse, if we have a mixture of rowmap(hash) and anything else,
checking that the row counts match is not enough to guarantee
compatibility!

XXX:BUG because of the "colmap of rowmap(hash)" exception above, a
colmap may also have named rows; therefore any colmap may be a
liability.  At this point, checking the row count is not enough to
ensure fetches are possible.

=cut

sub rowList {
    my $self = shift;
    if (@{ $self->{sources} } == 1 && ref($self->{sources}->[0]) eq 'Data::Dataset::Rowmap') {
	return $self->{sources}->[0]->rowList;
    } else {
	return $self->SUPER::rowList;
    }
}


sub get {
    my ($self, $colId, $rowId) = @_;
    die "Object method needs 2 args" unless @_ == 3;

    my $colnum = $self->colid2num($colId);
    my $colname = $self->colnum2name($colnum);

    my $target = $self->colname2info($colname);

    if (ref($target) eq 'CODE') {
	# a generated column
	return scalar $target->($self, $rowId, $colname);
    } elsif (ref($target)) {
	# a colmap'd delegation
	# Use colname: we can't use _our_ colnum (hence, possibly, our colId) on $target
	return $target->get($colname, $rowId);
    } else {
	# unknown column name or unexpected target flavour
	$target = '[undef]' if !defined $target;
	die "Column id '$colId' is unknown (colmap: $colname => $target) in '".$self->name."'";
    }
}


sub set {
    my ($self, $colId, $rowId, $value) = @_;
    die "Object method needs 3 args" unless @_ == 4;

    my $colnum = $self->colid2num($colId);
    my $colname = $self->colnum2name($colnum);

    my $target = $self->colname2info($colname);

    die "setting CODE column is not (yet) implemented " if ref($target) eq 'CODE';

    return $target->set($colname, $rowId, $value) if ref($target); # delegation

    # unknown column name or unexpected target flavour
    $target = '[undef]' if !defined $target;
    die "Column id '$colId' is unknown (colmap: $colname => $target) in ".$self->description;
}

sub canSet {
    my ($self, $colId) = @_;

    my $colnum = $self->colid2num($colId);
    my $colname = $self->colnum2name($colnum);

    my $target = $self->colname2info($colname);

    return 0 if ref($target) eq 'CODE'; # no plan has formed, but this will be needed
    return $target->canSet($colname) if ref($target); # delegation

    return 0; # unknown column or type
}


1;
