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 )