package ATR::Dataset;

use strict;
use warnings;

use ATR::Dataset::Grid;
use ATR::Dataset::Colmap;
use ATR::Dataset::Rowmap;


=head1 NAME

ATR::Dataset - contains rows, field definitions and accessors

=head1 DESCRIPTION

=head2 Missing things

List of sources used in constructing the object.  Tricky because a
colmap CODE column may have invisible dependencies.

"Data is comprehensive/all fetched" flag, to allow rowmap caches to
stop doing negative hit caching.

General flags area?  %$self

Multi-get methods (getcols, getcolshash) are convenient but not
efficient.  They could be accelerated for a subclass which only used
DBI-style data, but the first wrapper Dataset would hide the
optimisation.  Optimisation: not yet!

new_sqlfetch (Dataset Grid) is now writable, but there should be
another class for DB-linked data which does update queries when
written.  Keep the plain Grid as a basis for lazy-pop etc..

=cut

# $Id: Dataset.pm,v 1.23 2005/05/23 16:04:48 mca Exp $

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


=head1 CLASS METHODS

=head2 new_sqlfetch($name, \@fields, \@rows)

Class method to generate a simple collection of ordered rows.

C<$name> is a name of the object, mostly for use in debugging or error
messages.

C<@fields> is the list of column names for the data in each row.  May
be partial, empty or contain C<undef>s, in which case the missing
column names will be padded out with generated strings.

When generating column names, number of columns will match the first
row of the given data (if present), else the size of the given
C<@fields> list.  This could mean there are sometimes no columns,
which will cause errors later.

C<@rows> is the row-list from L<DBI> or L<SqlEngine2>, passed by
reference.
 my $cell = (\@rows)-E<gt>[$rownum]-E<gt>[$colnum];

Could provide a "copy each field" option to regenerate the rows' data
structure hence avoiding interference from outside

=cut

sub new_sqlfetch {
    my ($proto, $name, $fields, $rows) = @_;

    my $self = ATR::Dataset::Grid->_new($name);
    $self->_init($fields, $rows);

    return $self;
}

{
    my $id = 'a';
    sub __getNextIdent { $id++ }
}


sub _new { # private constructor-like thing...  requires the caller to do _init
    my ($proto, $name) = @_;
    my $class = ref($proto) || $proto;
    my $self = bless {}, $class;

    # Name
    $self->{name} = defined $name ? $name : "anon".$self->__getNextIdent();

    return $self;
}


=head2 ATR::Dataset-E<gt>new_colmap($name, @items)
or $item1-E<gt>new_colmap($name, @more_items)

As an object method, C<@items> will be taken as C<($item1, @more_items)>

Build a new object containing no 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.)

If $value is C<undef> the named column will be removed from the map,
but may be replaced by later items.

If $value is a blessed ref, it will be taken as a Dataset in which to
look up the named column.

If $value is an unblessed CODE ref, a C<$obj-E<gt>get(colname,
$rowId)> will call it with arguments C<($obj, $rowId)> and propagate
the return value.

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.

C<$name> as for C<new_sqlfetch>.

=cut

sub new_colmap {
    my ($proto, $name, @items) = @_;
    unshift @items, $proto if ref($proto); # called as object method, use that object as a source

    my $self = ATR::Dataset::Colmap->_new($name);
    $self->_init(@items);

    return $self;
}


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

=head1 OBJECT METHODS

=head2 $obj2 = $obj1-E<gt>map_colhash($name, $colId)

Construct and return a hash rowmapped Dataset from an existing
Dataset.

C<$name> as for other constructors.

C<$colId> identifies the column whose values will be used as
C<$rowId>s in the new Dataset.

=cut

sub map_colhash {
    my ($src, $name, $colId) = @_;
    my $dst = ATR::Dataset::Rowmap->_new($name);
    $dst->_init_hash($src, $colId);
    return $dst;
}


=head2 $obj2 = $obj1-E<gt>map_rowlist($name, @rowIds)

Construct and return an array-rowmapped Dataset from an existing
Dataset.

C<$name> as for other constructors.

C<@rowIds> lists the row IDs to be used from $obj1, in the order for
the new $obj2.

Undefs could in principle be allowed in @rowIds, to make rows which
don't exist/could be populated later, but this is currently not
allowed.

=cut

sub map_rowlist {
    my ($src, $name, @rowIds) = @_;
    my $dst = ATR::Dataset::Rowmap->_new($name);
    $dst->_init_list($src, \@rowIds);
    return $dst;
}


=head2 name()

Object method returns debugging name.

=cut

sub name { $_[0]->{name} }


=head2 colnum2name($column_number)

Object method.  Returns the name (colname) of the column indexed from
0.  Returns C<undef> if there are not that many columns.

=head2 colnames()

Returns list (size of list in scalar context) of the names of the
columns.

=head2 colid2num($colId)

Return column number (aka. C<$colnum>) for the given column id
C<$colId>, which may be a column name or number.

Error if the $colId is invalid.

=head2 hasColid($colId)

Return a true value (happens to be non-numeric, so you can't
accidentally use it as an index) if the C<$colId> is valid.

=cut

sub colnum2name { $_[0]->{cols}->[$_[1]] }

sub colnames {@{ $_[0]->{cols} }}

sub colid2num {
    my ($self, $id) = @_;
    return $self->{col2num}->{$id} if defined $self->{col2num}->{$id};
    return $id if $id =~ /^\d+$/ && defined $self->{cols}->[$id];
    die "Unknown column id '$id' for ".$self->name;
}

sub hasColid {
    my ($self, $id) = @_;
    return 't' if defined $self->{col2num}->{$id};
    return 't' if $id =~ /^\d+$/ && defined $self->{cols}->[$id];
    return undef;
}


=head2 rowList()

Return a list of valid C<$rowId> values, in the order of the dataset
if it has one, else in no particular order.

This might be a large list.  If that becomes a problem, make another
method (rowLister?) which returns a CODE ref which when called
repeatedly will return rowIds until it runs out of them.

=cut

sub rowList {
    my $self = shift;
    my $num = $self->rowCount;
    die "Dataset '".$self->name."' has no row count, cannot list the rows here" unless defined $num;
    return (0 .. ($num-1));
}


=head2 rowCount()

Returns number of rows held, if available.

Colmap objects: give consensus row count if there is one.

=cut


=head2 get($colId, $rowId)

Object method.  Returns the value in the cell, which may be C<undef>
(i.e. C<NULL>).

Arguments ordered using the (x, y) convention, rather than the DBI
de-referencing convention!

C<$rowId> must be a rownum, unless accessing some subclass which does
name conversions or index lookups.  When this is an array index,
negative rownumbers will work in the usual way ...  relying on this
might not be a good idea.

C<$colId> may be a colnum or a colname.  NB. If the C<$colId> is a
number which is also a valid colname, it will be treated as such (so
don't do that).

For Colmap objects, does the delegation/value generation.  Errors for
unknown columns; whether unknown rows generate errors will depend on
the column.

For Grid (new_sqlfetch) objects die if you dereference a cell which
doesn't exist.

=head2 set($colId, $rowId, $value)

Converse of C<get>: set the value for the given cell.  C<undef> is
acceptable.  See also C<canSet> - the method will die if this is
false, or may not even exist.

=head2 canSet($colId)

Return flag (0 = read-only, 1 = settable) to indicate whether existing
cells in the column may be written with the C<set> method.  If there
are no settable columns, the C<set> method doesn't need to be
implemented.

=head2 canInsert()

NOT IMPLEMENTED

=head2 canDelete()

NOT IMPLEMENTED

=cut

# sub set { my ($self, $colId, $rowId, $value) = @_; die "Can't set ($colId, $rowId) = $value"; }

sub canSet {
    my ($self, $colId) = @_;
    return 0; # no setting provided, by default
}


=head2 getcols($rowId, @colId)

Convenience wrapper to make multiple calls C<get($colId[$i], $rowId)>
for each $i.  Returns the values in order.

nb. $rowId is now first.

=cut

sub getcols {
    my ($self, $rowId, @colId) = @_;
    my @val;
    for (my $i=0; $i<@colId; $i++) {
	push @val, $self->get($colId[$i], $rowId);
    }
    warn "Expected list context" unless wantarray;
    return @val;
}


=head2 getcolshash($rowId, @colId)

Another convenience wrapper, for building hashes.  Calls
C<get($colId[$i], $rowId)>.  If @colId is empty, it will first be
filled by a call to C<colnames> so that all columns are fetched.

Returns C<($colname =E<gt> $value)> pairs in the requested order.

nb. $rowId is now first.

XXX: a tied hash generator might be more useful? could be made with a colmap CODE column

=cut

sub getcolshash {
    my ($self, $rowId, @colId) = @_;
    @colId = $self->colnames unless @colId;

    # protect myself against stupidity
    die "getcolshash choked on deep recursion in ".$self->name." for cols (@colId)"
      if defined caller(750); # XXX: magic numbers bad

    my @val;
    for (my $i=0; $i<@colId; $i++) {
	push @val, $colId[$i], $self->get($colId[$i], $rowId);
    }
    warn "Expected list context" unless wantarray;
    return @val;
}


=head2 getrows($colId, @rowId)

Convenience wrapper to make multiple calls C<get($colId, $rowId[$i])>
for each $i.  Returns the values in order.

=cut

sub getrows {
    my ($self, $colId, @rowId) = @_;
    my @val;
    for (my $i=0; $i<@rowId; $i++) {
	push @val, $self->get($colId, $rowId[$i]);
    }
    warn "Expected list context" unless wantarray;
    return @val;
}


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

=head1 GUI OBJECT METHODS

=head2 setUpdateEntry($colId, $rowId, $ue, \%extra_accs)

Link cell for reading; writing if possible.

Use addition accessors %extra_accs if provided, these may override the
default ones.

=cut

sub setUpdateEntry {
    my ($self, $colId, $rowId, $ue, $extra_accs) = @_;
    my %accs = $extra_accs ? %$extra_accs : ();

    $accs{-load} ||= sub { $self->get($colId, $rowId) };

## not much point in this when they only write to arrays
#    if ($self->canSet($colId)) {
#	$accs{-save} ||= sub { $self->set($colId, $rowId) };
#	$accs{-finish} ||= sub { undef }; # no checks, by default
#    }

    $ue->setFieldAccessors(%accs);
}

1;
