Tk-DBIx

 view release on metacpan or  search on metacpan

DBIx/Form.pm  view on Meta::CPAN

	foreach my $name (@$fields) {
		$c++;
		next if(! $c && ! $obj->{editId});

		my $namedisplay = $1 if($name =~ /AS\s+(\S+)/i);
		my $value = $rows->[0][$c] || $opt->{default}->{$name} || (defined $fieldtypes->{$name}->{Default} and $fieldtypes->{$name}->{Default} ne 'NULL' ? $fieldtypes->{$name}->{Default} : undef);
		my $feldtyp = $fieldtypes->{$name}->{Type};
		$feldtyp = $obj->{alternateTypes}->{$name}->{type}
			if(defined $obj->{alternateTypes}->{$name}->{type});
		my $NotNull = $name if($obj->{required}->{$name});
		$required = $NotNull unless($required);

		my $label = $dialog->Label(
			-fg 	 => ($NotNull ? 'red' : 'black'),
			-justify => 'left',
			-text    => ($namedisplay || $name).($NotNull ? '*' : ''),
		);

		my $image = $dialog->Label(
			-image	 => $obj->{images}->{$name},
		);


		if (defined $obj->{readonly}->{$name} || $opt->{all_readonly}) {
			$obj->{entrys}->{$name} = $obj->_readonly_widget($dialog, $name, $value, $save, $feldtyp);
		} elsif ( defined $obj->{'link'}->{$name} ) {
			$obj->{entrys}->{$name} = $obj->_link_widget($dialog, $name, $value, $save);
		} elsif ( $feldtyp =~ /(time|date|timestamp)/i ) {
			$obj->{entrys}->{$name} = $obj->_time_widget($dialog, $name, $value, $save, $feldtyp);
		} elsif ( $feldtyp =~ /^(enum|set)\((.+)\)/i ) {
			$obj->{entrys}->{$name} = $obj->_choice_widget($dialog, $name, $value, $save, $label);
		} elsif ( $feldtyp =~ /(int|float|double|real|numeric)/i ) {
			$obj->{entrys}->{$name} = $obj->_integer_widget($dialog, $name, $value, $save);
		} elsif ( $feldtyp =~ /decimal/i ) {
			$obj->{entrys}->{$name} = $obj->_decimal_widget($dialog, $name, $value, $save);
		} elsif ( $feldtyp =~ /text/i ) {
			$obj->{entrys}->{$name} = $obj->_text_widget($dialog, $name, $value, $save);
		} elsif ( $feldtyp eq 'file' ) { # SPEZIAL TYPES
			$obj->{entrys}->{$name} = $obj->_file_widget($dialog, $name, $value, $save);
		} elsif ( $feldtyp eq 'password' ) {
			$obj->{entrys}->{$name} = $obj->_password_widget($dialog, $name, $value, $save);
		} elsif ( $feldtyp eq 'mimetype' ) {
			$obj->{entrys}->{$name} = $obj->_mimetype_widget($dialog, $name, $value, $save);
		} else {
			$obj->{entrys}->{$name} = $obj->_string_widget($dialog, $name, $value, $save);
		}
		$obj->Advertise(sprintf('wi_%s', $name) => $obj->{entrys}->{$name});

		$obj->{BAL}->attach( 
			$obj->{entrys}->{$name}, 
			-balloonmsg => $obj->{balloon}->{$name} 
		) if(defined $obj->{balloon}->{$name}); 

		$label->grid( $image, $obj->{entrys}->{$name}, -sticky => 'nw' );
	}

	$dialog->Label(
		-fg 	 	=> 'red',
		-justify 	=> 'left',
		-textvariable   => \$obj->{ status },
	)->grid(-sticky => 'nw', -columnspan => 2);

	return $save;
}

# ------------------------------------------
sub cancel {
# ------------------------------------------
	my $obj = shift || warn "Kein Objekt!";

	$obj->{dialog}->Subwidget('B_Cancel')->invoke
		if(defined $obj->{dialog} && defined $obj->{dialog}->Subwidget('B_Cancel'));
	$obj->{dialog}->Subwidget('B_Ok')->invoke
		if(defined $obj->{dialog} && defined $obj->{dialog}->Subwidget('B_Ok'));
}


# ------------------------------------------
sub deleRecord {
# ------------------------------------------
	my $obj = shift || warn "Kein Objekt!";
	my $id = shift;
	my $nowarn = shift || 0;
	my $idx = $obj->{update}->[0] || $obj->{insert}->[0];
	my $table = $obj->{table};

	return "Sorry, no id to delete"
		unless($id);

	my $answer = $obj->messageBox(
		-message => 'Are you sure?',
		-title => "Delete Row from ".$table,
		-type => 'okcancel',
		-default => 'cancel')
			unless($nowarn);

	$obj->type('delete');

	if ( (defined $answer and $answer =~ /ok/i) || $nowarn) {
		my $info;
		my $sql = sprintf("DELETE FROM %s WHERE %s = '%s'",
					$table,
					$idx,
					$id);
		$obj->debug($sql);
		$info = $obj->{dbh}->do($sql)
			or return $obj->{dbh}->error();
	}
	1;
}

# ------------------------------------------
sub newRecord {
# ------------------------------------------
	my $obj = shift || warn "Kein Objekt!";
	my $options = shift;
	delete $obj->{Last_Insert_Id};
	$obj->editRecord(0, $options);
}

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



( run in 1.126 second using v1.01-cache-2.11-cpan-5a3173703d6 )