package ATR::Dataset::Colmap;

use strict;
use warnings;
use base 'ATR::Dataset';


=head1 NAME

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

=head1 DESCRIPTION

Subclass is instantiated from L<ATR::Dataset>-E<gt>new_colmap .  Docs
are there.

=head2 Example usage

(mostly, a dump of ideas off the whiteboard)

=over 4

=item Derived or composite data

 my $person = ATR::Dataset->new_sqlfetch('person', [qw[forename surname ...]], \@rows);
 my $composite = $person->new_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 Event observation

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

=back

=head2 Missing things

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.

=cut

# $Id: Colmap.pm,v 1.8 2005/05/23 16:04:37 mca Exp $

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

sub _init {
    my ($self, @items) = @_;
    my $name = $self->name;

    # Generate column map
    my (%colmap, @col_order);
    while (@items) {
	my $item = shift @items;
	die "Found undef 'item' while making '$name'" if !defined $item;
	if (ref($item) eq 'CODE') {
	    die "Bad new_colmap call, 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;
	}

	die "Missing value on item '$item' while making '$name'" unless @items;
	my ($colname, $value) = ($item, shift @items);
	push @col_order, $colname; # remove dups later
	if (!defined $value) {
	    # unmap it
	    delete $colmap{$colname};
	} else {
	    # should be CODE, ATR::Dataset or maybe a number
	    $colmap{$colname} = $value;
	}
    }

    # 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<new_colmap>, may return another
L<ATR::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;
    foreach my $src (@{ $self->{sources} }) {
	my $new_rows = $src->rowCount;
	last unless defined $new_rows; # object doesn't know, we can't do anything
	if (defined $rows) {
	    my $name2 = $src->name;
	    die "Conflicting row counts (so far: $rows, $name2: $new_rows) in '".$self->name."'"
	      unless $new_rows == $rows;
	} else {
	    $rows = $new_rows;
	}
    }
    return $rows;
}


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 $target->($self, $rowId);
    } 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 ($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 ($target) in '".$self->name."'";
}

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;
