#!/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__
[download]