# ColumnFixture.pm
#
# Copyright (c) 2002 Cunningham & Cunningham, Inc.
# Released under the terms of the GNU General Public License version 2 or later.
#
# Perl translation by Dave W. Smith <dws@postcognitive.com>

package ColumnFixture;

use base qw(Fixture);
use strict;
use TypeAdapter;

sub new {
    my $pkg = shift;

    return $pkg->SUPER::new(columnBindings => [],
                            hasExecuted => 0,
                            @_);
}

sub doRows {
    my $self = shift;
    my($rows) = @_;

    $self->bind($rows->parts());
    $self->SUPER::doRows($rows->more());
}

sub doRow {
    my $self = shift;
    my($row) = @_;

    $self->{'hasExecuted'} = 0;
    eval {
	$self->reset();
    };
    if ( $@ ) {
	$self->exception($row->leaf(), $@);
    }
    $self->SUPER::doRow($row);
}

sub doCell {
    my $self = shift;
    my($cell, $column) = @_;

    my $adapter = $self->{'columnBindings'}->[$column];
    eval {
	my $string = $cell->text();
	if ( $string eq "" ) {
	    # skip cell
	}
	elsif ( not defined($adapter) ) {
	    $self->ignore($cell);
	}
	elsif ( $adapter->field() ) {
	    $adapter->set($adapter->parse($string));
	}
	elsif ( $adapter->method() ) {
	    $self->check($cell, $adapter);
	}
    };
    if ( $@ ) {
	$self->exception($cell, $@);
    }
}

sub check {
    my $self = shift;
    my($cell, $adapter) = @_;

    if ( ! $self->{'hasExecuted'} ) {
	eval {
	    $self->execute();
	};
	if ( $@ ) {
	    $self->exception($cell, $@);
	}
	$self->{'hasExecuted'} = 1;
    }

    $self->SUPER::check(@_);
}

sub reset {
    my($self) = @_;

    # about to process first cell of row
}

sub execute {
    my($self) = @_;

    # about to process first method call of row
}

sub bind {
    my($self, $heads) = @_;
    my $column = 0;

    $self->{'columnBindings'} = [];
    while ( $heads ) {
	my $name = $heads->text();
	eval {
	    if ( $name eq "" ) {
		$self->{'columnBindings'}->[$column] = undef;
	    }
	    elsif ( $name =~ /^(.*)\(\)$/ ) {
		$self->{'columnBindings'}->[$column] = $self->bindMethod($1);
	    }
	    else {
		$self->{'columnBindings'}->[$column] = $self->bindField($name);
	    }
	};
	if ( $@ ) {
	    $self->exception($heads, $@);
	}
	$heads = $heads->more();
        ++$column;
    }
}

sub bindMethod {
    my $self = shift;
    my($name) = @_;

    return TypeAdapter::onMethod($self, $name);
}

sub bindField {
    my $self = shift;
    my($name) = @_;

    return TypeAdapter::onField($self, $name);
}

sub getTargetClass {
    my $self = shift;

    ref($self);
}

1;

__END__
