use strict;
use warnings FATAL => 'all';
package HTML::Tested::ClassDBI::Field::Column;
use Carp;
sub verify_arg {
        my ($class, $root, $w, $arg) = @_;
        my $gr = $w->options->{cdbi_group};
        confess($w->name . ": $arg - unknown column. Wrong cdbi_bind usage")
                unless $root->_CDBI_Class->{$gr}->find_column($arg);
        $root->_PrimaryFields->{$gr}->{ $w->name } = [ $arg ]
                if $w->options->{cdbi_primary};
}
sub bless_arg {
        my ($class, $root, $w, $arg) = @_;
        $class->verify_arg($root, $w, $arg);
        return bless([ $arg ], $class);
}
sub get_column_value {
        my ($self, $cdbi) = @_;
        my $c = $self->column_name;
        return exists $cdbi->{$c} ? $cdbi->{$c} : $cdbi->$c;
}
sub column_name { return shift()->[0]; }
sub update_column {
        my ($self, $setter, $root, $name) = @_;
        $setter->($self->[0], $root->$name) unless $root->ht_get_widget_option(
                $name, "cdbi_readonly");
}
my %_dt_fmts = (date => '%x', 'time' => '%X', timestamp => '%c');
sub setup_datetime_from_info {
        my ($self, $w, $info) = @_;
        return unless $info->{type};
        my ($t) = ($info->{type} =~ /^(\w+)/);
        $w->setup_datetime_option($_dt_fmts{$t}) if ($_dt_fmts{$t});
}
sub setup_type_info {
        my ($self, $root, $w, $info) = @_;
        ($info ||= $root->pg_column_info($self->[0])) or return;
        $w->options->{cdbi_column_info} = $info;
        $w->options->{is_integer} = 1 if ($info->{type} eq 'integer'
                        || $info->{type} eq 'smallint');
        $w->push_constraint([ 'defined', '' ]) unless 
                ($w->options->{cdbi_readonly} || $info->{is_nullable});
        $self->setup_datetime_from_info($w, $info);
}
package HTML::Tested::ClassDBI::Field::Primary;
use base 'HTML::Tested::ClassDBI::Field::Column';
sub verify_arg {
        my ($class, $root, $w, $arg) = @_;
        my @pc = map { $_->name } $root->_CDBI_Class->{
                        $w->options->{cdbi_group} }->primary_columns;
        $root->_PrimaryFields->{ $w->options->{cdbi_group} }
                ->{ $w->name } = \@pc;
        $root->ht_set_widget_option($w->name, "is_sealed", 1)
                unless exists $w->options->{is_sealed};
        $root->ht_set_widget_option($w->name, "cdbi_readonly", 1)
                unless exists $w->options->{cdbi_readonly};
}
sub get_column_value {
        my ($self, $cdbi) = @_;
        my @pvals = map { $cdbi->$_ } $cdbi->primary_columns;
        return join('_', @pvals);
}
sub update_column {}
sub setup_type_info {
        my ($self, $root, $w) = @_;
        my @pc = $root->primary_columns;
        return if @pc > 1; 
        $self->SUPER::setup_type_info($root, $w, $root->pg_column_info($pc[0]));
}
package HTML::Tested::ClassDBI::Field::Array;
sub bless_arg {
        my ($class, $root, $w, $arg) = @_;
        return bless([ map { HTML::Tested::ClassDBI::Field->do_bless_arg(
                                $root, $w, $_) } @$arg ]);
}
sub get_column_value {
        my ($self, $cdbi) = @_;
        return [ map { $_->get_column_value($cdbi) } @$self ];
}
sub update_column {}
sub setup_type_info {
        my ($self, $root, $w) = @_;
        for (my $i = 0; $i < @$self; $i++) {
                my $iopts = $w->options->{$i} || {};
                $self->[$i]->setup_datetime_from_info($w, $iopts);
                $w->options->{$i} = $iopts if %$iopts;
        }
}
package HTML::Tested::ClassDBI::Field;
use HTML::Tested::ClassDBI::Upload;
sub do_bless_arg {
        my ($class, $root, $w, $arg) = @_;
        if (ref($arg) eq 'ARRAY') {
                $class .= "::Array";
        } elsif ($arg eq 'Primary') {
                $class .= "::Primary";
        } else {
                $class .= "::Column";
        }
        return $class->bless_arg($root, $w, $arg);
}
sub new {
        my ($class, $root, $w) = @_;
        return HTML::Tested::ClassDBI::Upload->new($root
                        , $w->options->{cdbi_upload} || $w->name)
                if (exists $w->options->{cdbi_upload});
        return HTML::Tested::ClassDBI::Upload->new($root
                        , $w->options->{cdbi_upload_with_mime} || $w->name, 1)
                if (exists $w->options->{cdbi_upload_with_mime});
        return unless exists $w->options->{cdbi_bind};
        my $arg = $w->options->{cdbi_bind} || $w->name;
        return $class->do_bless_arg($root, $w, $arg);
}
1;