#!/usr/bin/perl use warnings; use strict; use DBI; use Tk; $| = 1; #just a simple demo....lacks error checking my $dbh; #only create foo db once if( ! -e 'foo' ){ #create sqlite db $dbh = DBI->connect("dbi:SQLite:dbname=foo", "", ""); $dbh->{AutoCommit} = 1; $dbh->do("CREATE TABLE P (p1, p2, p3)"); #insert some sample data $dbh = DBI->connect("dbi:SQLite:dbname=foo", "", ""); my $sth = $dbh->prepare("INSERT INTO P VALUES (?, ?, ?)"); my $rows = $sth->execute("Zen", "Zentara", "zentara.net"); $dbh->func('last_insert_rowid'); $sth->execute("test", "test1", "1"); $sth->execute("test", "test2", "2"); $sth->execute("test", "test3", "3"); $dbh->disconnect; } #make Main Window my $mw = MainWindow->new; # little title label $mw->Label(-text => "Tk SQLite db demo")->pack(); # Frames my $entry_frame = $mw->Frame->pack(); my $results_frame = $mw->Frame->pack(); my $button_frame = $mw->Frame->pack(); my $p1_entry = $entry_frame->Entry( -width =>10, )->pack(-side=>'left',-padx=>10); my $p2_entry = $entry_frame->Entry( -width =>10, )->pack(-side=>'left',-padx=>10); my $p3_entry = $entry_frame->Entry( -width =>10, )->pack(-side=>'left',-padx=>10); my $listbox = $results_frame->Scrolled("Listbox", -width => 40, -scrollbars => "osoe", )->pack(-fill=>'both',); $button_frame->Button(-text => "Insert", -command => \&insert ) ->pack(-side=>'left', -padx=>10); $button_frame->Button(-text => "Get All", -command => \&get_all ) ->pack(-side=>'left', -padx=>10); $button_frame->Button(-text => "Delete", -command => \&delete_entry ) ->pack(-side=>'left', -padx=>10); $button_frame->Button(-text => "Exit", -command => sub{ exit } ) ->pack(-side=>'right', -padx=>10); MainLoop; sub insert{ #insert some data from entry boxes $dbh = DBI->connect("dbi:SQLite:dbname=foo", "", ""); my $sth = $dbh->prepare("INSERT INTO P VALUES (?, ?, ?)"); my $p1 = $p1_entry->get(); my $p2 = $p2_entry->get(); my $p3 = $p3_entry->get(); my $rows = $sth->execute($p1, $p2, $p3); $dbh->disconnect; get_all(); } sub get_all{ #clear result box $listbox->delete( 0, 'end' ); #retreive some data $dbh = DBI->connect("dbi:SQLite:dbname=foo", "", "", { RaiseError => 1 }); my $sth = $dbh->prepare("SELECT * FROM P"); $sth->execute; my @row; while ( @row = $sth->fetchrow_array() ) { $listbox->insert('end', join " ", @row); } $sth->finish; $dbh->disconnect; } sub delete_entry{ #get current selection my $selected; my $selection_index = $listbox->curselection(); if ( $selection_index eq '' ) { $selected = "Nothing selected"; } else { $dbh = DBI->connect("dbi:SQLite:dbname=foo", "", "", { RaiseError => 1 }); $selected = $listbox->get($selection_index); #taking shortcut here, just for demo, where #I split string on spaces and take first word as key my (@sel) = split /\s+/, $selected; print "$sel[0]\n"; my $sth = $dbh->prepare("delete from P where p1=?") or warn DBI::errstr $!; $sth->execute( $sel[0] ) or warn DBI::errstr $!; $sth->finish; $dbh->disconnect; &get_all(); } } __END__