package Data::Dataset::Rowmap;

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


=head1 NAME

Data::Dataset::Rowmap - lookup by field value

=head1 DESCRIPTION

Generate a static hash from values in a column to rowId.  Instantiate
with L<Data::Dataset>-E<gt>map_colhash or map_rowlist .

Originally this had two modes: rowlist and rowmap.

rowlist would give a permuted or restricted access to the rows of the
source dataset, but continue to use numeric rowId.

rowmap uses a hash to give access to rows of the source dataset,
taking hash keys as rowId and using values to map to the source rowId.
Rows were not ordered because they're just hash keys.  The rowmap hash
was built using values from cells in the source, hence providing
index-by-value access to the source.

New mode is for the caller to supply the rowmap.  In this application
the lack of row ordering is inconvenient, so both rowmap and rowlist
may be present.  When rowlist does not include all the rowmap hash
keys, you may find that C<hasRow> admits to the presence of rowIds
which are not returned by C<rowList>

XXX: this class needs a spring clean

=cut

# $Id: Rowmap.pm,v 1.7 2007/01/08 17:47:07 mca Exp $

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

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

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

    # Old-style map_colhash / map_rowlist handling
    my ($init_meth, @args);
    if (exists $args{-rowscol}) {
	$init_meth = '_init_vals2rowmap';
	@args = (delete $args{-rowscol});

    } elsif (exists $args{-rows} && ref($args{-rows}) eq 'ARRAY') {
	$init_meth = '_init_rowlist';
	@args = (delete $args{-rows});

    } elsif ($args{-rowmap}) {
	$init_meth = '_init_rowhash';
	@args = (delete $args{-rowmap});
	push @args, delete $args{-roworder} if exists $args{-roworder};

    } else {
	my @args = %args;
	croak "Bad Rowmap setup, args remaining = (@args)";
    }

    # XXX: want ($src, $src_rows, $dst_rows)
    #   $src_rows being colId or \@rowId
    #   $dst_rows currently being 0 .. N, do I want the extra swapping or just rowmap again?
    # Could make appendable rowmap; or appendable during config

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

    my $at = "creating rowmap ".$self->description." from ".$src->description;
    $self->{src} = $src;
    $self->_init_cols($at);

    $self->$init_meth($at, @args);

    return @left;
}


sub _init_vals2rowmap {
    # Build rowmap from values in source dataset
    my ($self, $at, $srcColId) = @_;
    my $src = $self->{src};

    # Generate row map
    my %rowmap; # key = value under $srcColId, value = $srcRowId
    foreach my $srcRowId ($src->rowList) {
	my $key = $src->get($srcColId, $srcRowId);
	croak "Cannot rowmap NULL value, found at ('$srcColId', '$srcRowId') $at (colmap it to '' instead?)"
	  unless defined $key;
	croak "Unique key conflict on '$key' in column '$srcColId' $at"
	  if exists $rowmap{$key};
	$rowmap{$key} = $srcRowId;
    }

    $self->{rowmap} = \%rowmap;
}


sub _init_rowlist {
    my ($self, $at, $rowlist) = @_;
    $self->{rowlist} = $rowlist;
    $self->_check_rowlist($at, @$rowlist);
}


sub _init_rowhash {
    my ($self, $at, $rowhash, $rowlist) = @_;
    # $rowlist is optional, without it the rows will come back in hash-key order
    $self->{rowmap} = $rowhash;
    if (defined $rowlist) {
	$self->{rowlist} = $rowlist;
	$self->_check_rowlist($at, @{$rowhash}{@$rowlist});
    } else {
	$self->_check_rowlist($at, values %$rowhash);
    }
}


# Check the destination rowIds - have our surprise now instead of later
sub _check_rowlist {
    my ($self, $at, @rowlist) = @_;
    my $src = $self->{src};

    my %src_rows;
    @src_rows{($src->rowList)} = ();
    for (my $i=0; $i<@rowlist; $i++) {
	my $srcRowId = $rowlist[$i];
#	next unless defined $srcRowId; # allow missing rows
	croak "Found undef source row at #$i when $at" unless defined $srcRowId;
	croak "Found source row id '$srcRowId' at #$i, not in source rowList when $at"
	  unless exists $src_rows{$srcRowId};
    }
}


sub _init_cols {
    my ($self, $at) = @_;
    my $src = $self->{src};
    my @cols = $src->colnames;
    my %col2num;
    @col2num{@cols} = (0 .. $#cols);
    $self->{cols} = \@cols;
    $self->{col2num} = \%col2num;
}


=head2 rowCount

Return number of rows in the rowlist; or if not present the number of
keys in the rowmap.

=cut

sub rowCount {
    my $self = shift;
    return scalar ($self->{rowlist}
		   ?      @{ $self->{rowlist} }
		   : keys %{ $self->{rowmap}  } );
}


=head2 rowList

Return the keys from in the rowlist; or if not present the number of
keys in the rowmap.

=cut

sub rowList {
    my $self = shift;

    if ($self->{rowmap}) {
	# We're hash-mapped.  Return the preferred hash key order if
	# we have one, else just return the keys.
	return ( $self->{rowlist}
		 ? @{ $self->{rowlist} }
		 : keys %{ $self->{rowmap} } );
    }

    # Else we're indexed by number, and rowlist tells the source rowId.
    # Our rowIds are just 0 .. N
    my @rows = (0 .. $#{ $self->{rowlist} }); # avoid using .. in scalar context
    return @rows;
}


sub get {
    my ($self, $colId, $rowId) = @_;
    croak "Object method needs 2 args" unless @_ == 3;
    my $srcRowId = $self->_mapFatal($rowId);
    return $self->{src}->get($colId, $srcRowId);
}

sub canSet {
    my ($self, $colId) = @_;
    return $self->{src}->canSet($colId);
}

sub set {
    my ($self, $colId, $rowId, $value) = @_;
    croak "Object method needs 3 args" unless @_ == 4;
    my $srcRowId = $self->_mapFatal($rowId);
    return $self->{src}->set($colId, $srcRowId, $value);
}

sub hasRow {
    my ($self, $rowId) = @_;
    my $rowmap = $self->{rowmap};
    if ($rowmap) {
	return exists $rowmap->{$rowId};
    } else {
	return exists $self->{rowlist}->[$rowId];
    }
}

sub _mapFatal {
    my ($self, $rowId) = @_;
    my $rowmap = $self->{rowmap};
    if ($rowmap) {
	croak "Row id '$rowId' not found in ".$self->description
	  unless exists $rowmap->{$rowId};
	return $rowmap->{$rowId};
    } else {
	my $rowlist = $self->{rowlist};
	croak "Row id '$rowId' not found in ".$self->description
	  unless exists $rowlist->[$rowId]; # yes it works on ARRAY too!
	return $rowlist->[$rowId];
    }
}

1;
