Tk::DBI::Form - Megawidget to offering edit, delete or insert a record.
my $mw = MainWindow->new; my $tkdbi = $mw->DBIForm( -dbh => $dbh, -table => 'Inventory', -editId => 'yes', -readonly => { changed_by => 'xpix', created => 'NOW', ... }, -required => { name => 1, state => 1, owner => 1, ... }, -test_cb => { type_id => sub{ my ($save, $name) = @_; if($save->{type_id} and $save->{type_id} !~ /^\d+$/) { $dbh->do(sprintf("INSERT INTO Type (name) VALUES ('%s')", $save->{type_id})); $save->{type_id} = $dbh->{'mysql_insertid'}; } return undef; # Alles ok! }, ... }, -link => { type_id => { table => 'Type', display => 'name', id => 'id', }, ... }, -validate_cb => { serial_no => sub { my ($entry, $save, $input) = @_; $save->{id} = 0 unless(defined $save->{id}); $entry->configure( -bg => ( exists $SERIAL->{$input} ? 'red' : 'green' ), -fg => ( exists $SERIAL->{$input} ? 'white' : 'black' ), ); return 1 ; }, ... }, -images => { id => $pics{F1}, parent_id => $pics{F2}, ... }, -balloon => { id => 'This the a unique id.', parent_id => 'A parent_id, in other words the father.', ... }, -events => { '<KeyRelease-F1>' => sub { $DBIFORM->{entrys}->{id}->focus; }, ... }, -addButtons => { Logs => { -type => ['update'], -callback => sub{ my ($save, $name) = @_; &launch_browser_log($save->{id}); }, }, ..., }, -alternateTypes => { filename => { type => 'file', directory => $DOCUPATH, }, ... }, -debug => 1, ); my $ok = $tkdbi->editRecord($row->{id});
Tk::DBI::Form is a Megawidget offering edit, delete or insert operations for table records. At this time if this widget only compatible to MySQL Database.
The database handle to get the information from the Database.
Name of the table you intend to modify records from.
Switch the debug output to the standart console on.
This widget have a locking mechanism. The timeout is default 0 and will wait of unlock the row in seconds. If try a client edit a row in the same table and a other client have this open to update this row with the same widget, then have the first client a error Message:
Sorry, but this id <%s> is locked! Please try again later.
This allows to edit the ID-Number on the form, this is normaly a unique and autoincrement Field for each column.
List of fields that are granted update priviliges on. Only these fields are visible on the Update Form
List of fields that are granted insert priviliges on. Only these fields are displayed on the Insert Form.
This is a special Feature for fields located in a different table than given in -table. Often data from further tables is used, this data usually has an id number and a description. The id number from this table is mostly in the table to edit as id number. Here you can display the Description for this id and the user can change this choice. I.e.:
-link => { parent_id => { table => 'Inventory', display => 'name', where => 'WHERE type_id = 1', id => 'id', }, type_id => { table => 'Type', display => 'name', id => 'id', }, }
Ok, here we have two linktables. This will display a Listwidget, thes have the column 'name' to display in this Listbox. But the form write the id in the original column.
Here you can mark the fields where an entry is mandatory on the Form, is case no entry will be provided, the form will raise an error MessageBox displaying 'col1 is a required field!'.
-required => { changed_by => 1, deadline => 1, Server => 1, }
This option will set the columns as read only. The values are displayed but the user cannot change the data
-readonly => { changed_by => $USER, deadline => 'NOW', Server => $HOST, }
This option sets the default values for the listed fields that will be displayed on the form. I.e.:
-default => { changed_by => $USER, deadline => 'NOW', Server => $HOST, }
This option will set a Ballon message for a help message. This message is display if the user move over the input.
-balloon => { parent_id => 'This is a parent_id.', }
This option allow an additional Field in the form, both (value, type) Options is required. This Field will NOT save in the database, of course ;-) You can get the result with $tkdbi->{SAVE}->{Name} after user submit.
I.e.:
-addFields => { LogEntry => { value => '', type => 'text', } }, ... my $value = $tkdbi->{SAVE}->{LogEntry};
This option sets the Image Object for an icon that will be displayed next to the input or widget.
Here you can set a alternativeType to display. I.E.:
-alternateTypes => { filename => { type => 'file', directory => $DOCUPATH, }, password => { type => 'password', }, mime => { type => 'mimetype', file => '/baa/foo.pdf', }, },
This parameter results in displaying an entry and a button, the user can click on this button and a Fileselector will pop up on the form to select the right file and path.
This will display an entry with hidden letters as stars on the form.
This will display a pulldown menu with a lot of mimetypes. you can give optional a filename or a shorttype and the pulldownmneu will select this entry.
This option lets you add your personal events. I.E.:
-events => { '<KeyRelease-F1>' => sub { $DBIFORM->{entrys}->{id}->focus; },
Here you can add a callback to test the input from the user in realtime. The parameter for the subroutine is the entry, save hash with data from the Form and the input from the User. I.E.:
serial_no => sub { my ($entry, $save, $input) = @_; $save->{id} = 0 unless(defined $save->{id}); $entry->configure( -bg => ( exists $SERIAL->{$input} ? 'red' : 'green' ), -fg => ( exists $SERIAL->{$input} ? 'white' : 'black' ), ); return 1 ; },
This changes the foreground and background color of the entry if the serial number exists in the table. The subroutine can return a undef value, then the widget will igrnore this Userinput. I.e.:
only_numbers => sub { my ($entry, $save, $input) = @_; return undef unless($input =~ /[^0-9]+/); return 1 ; },
Here you can add a callback to test the user input AFTER submission of the form. The parameter for the subroutine is the save hash and the name of the field. I.E.:
-test_cb => { id => sub{ my ($save, $name) = @_; if($DBIFORM->type() eq 'insert' and $save->{id}) { my $answer = qsure($top,sprintf('You will REPLACE row <%s>?', $save->{id})); return 'NOMESSAGE' unless($answer); # Back without message } return undef; # All OK ... }, parent_id => sub{ my ($save, $name) = @_; my $pid = sprintf('%010d', $save->{parent_id}); unless(exists $INV->{$pid}) { my $msg = sprintf('Parent ID %s not exists', $pid); return $msg; } return undef; # All OK! }, }
The first example will pop up a MessageBox if the User makes an Insert with an id number (replace). The second example will reformat the parent_id Number to 0000000012. If the parent_id does not exist in the Hash, an Errormessage (MessageBox) with the returned text. 'NOMESSAGE' as return doesnt pop up a MessageBox. Return undef, all ok.
Here you can add a callback when the User activates the Cancel Button.
Here you can add a Button to the FormBox. The -type option will only display the button in the following state (insert, update or delete). The callback has one parameter. The save hash. I.e.:
-addButtons => { Logs => { -type => ['update'], -callback => sub{ my ($save, $name) = @_; &launch_browser_log($save->{id}); }, }, },
The example will display a logbrowser when the user click on the Button 'Logs'.
This will only display row data.
This will display the update form with the following id number for an update.
This will display the insert form with the following id number for a Replace operation.
my $datahash = $DBH->selectall_hashref(select * from table where id = 12); delete $datahash->{id}; $DBIFORM->newRecord( { default => $datahash, }, );
Here you see a trick to copy a column, also display a insert form with the values from column 12.
This will display the delete form with the following id number for a delete operation.
This returns true if the table was modified the last_time (seconds at epoche).
The Widgets in the form are advertised with 'wi_namecolumn'.
$Log: Form.pm,v $ Revision 1.15 2003/11/06 17:55:52 xpix ! bugfixes in refresh_id * not hudge load for tree Revision 1.14 2003/08/13 12:30:26 xpix * new Option addFields Revision 1.13 2003/07/17 14:59:53 xpix ! many little bugfixes Revision 1.12 2003/06/24 16:40:15 xpix * add locking mechanism Revision 1.11 2003/06/20 15:07:07 xpix ! never change a running Widget, push a var and not a ref in @values Revision 1.9 2003/06/05 15:32:48 xpix * with new Module Tk::Program ! unitialized values in tm2unix Revision 1.8 2003/05/04 23:36:50 xpix * add docu for dsplRecord Revision 1.7 2003/05/04 20:53:39 xpix * new method dsplRecord for only display a record Revision 1.6 2003/04/29 16:34:46 xpix * add Doku tag Changes
Frank (xpix) Herrmann. <xpix@cpan.org>
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
Tk::JBrowseEntry, Tk::XDialogBox, Tk::NumEntry, Tk::Date, Tk::LabFrame, Tk::FBox
To install Tk::DBI::Form, copy and paste the appropriate command in to your terminal.
cpanm
cpanm Tk::DBI::Form
CPAN shell
perl -MCPAN -e shell install Tk::DBI::Form
For more information on module installation, please visit the detailed CPAN module installation guide.