HTML-Tested-ClassDBI

 view release on metacpan or  search on metacpan

lib/HTML/Tested/ClassDBI/Field.pm  view on Meta::CPAN

}

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};

lib/HTML/Tested/ClassDBI/Field.pm  view on Meta::CPAN

	$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;

lib/HTML/Tested/ClassDBI/Field.pm  view on Meta::CPAN

	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;
	}
}

lib/HTML/Tested/ClassDBI/Upload.pm  view on Meta::CPAN

        $dbh->func($lo_fd, $buf, 4096, 'lo_read');
        ($ct, $buf) = HTML::Tested::ClassDBI::Upload->strip_mime_header($buf);
        my $res = $buf;
        while ($dbh->func($lo_fd, $buf, 4096, 'lo_read')) {
                $res .= $buf;
        }
	$dbh->func($lo_fd, 'lo_close') or confess "Unable to close $loid";
	return ($res, $ct);
}

sub update_column {
	my ($self, $setter, $root, $name) = @_;
	my $val = $root->$name or return;
	my $lo = $self->import_lo_object($self->[0]->db_Main, $val, $self->[2]);
	$setter->($self->[1], $lo);
}

sub get_column_value {}

1;