Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

djberg96 (2603)

djberg96
  (email not shown publicly)

Journal of djberg96 (2603)

Thursday June 03, 2004
03:32 PM

A database interface in 5 minutes or less

[ #19078 ]
If you're in a rush and can't find any GUI interface for your favorite database engine, you can use this. I had to do this for a Sybase database I suddenly realized we needed to connect to (proxy code removed to protect the guilty). Enjoy! ;)

use strict;
use Tk;
use Tk::MListbox;
use DBI;

my $user = "user";
my $pass = "XXX";
my $db   = "db";
my $vendor = "Oracle"; # or whatever

my $dbh = DBI->connect("dbi:$vendor:$db",
   $user,$pass,{PrintError=>1,RaiseError=>1});

my $mw = MainWindow->new;
$mw->title("DSSI"); # Dan's super simple interface

my $top_frame = $mw->Frame;
my $middle_frame = $mw->Frame;
my $bottom_frame = $mw->Frame;

my $editor = $middle_frame->Scrolled("Text"); $editor->pack(-side=>"top");

my $submit_button = $top_frame->Button(
   -text=>"Submit",
   -command=>\&execute_sql
);
$submit_button->pack(-side=>"right", -anchor=>"e");

my $exit_button = $bottom_frame->Button(-text=>"Exit",-command=>\&exit_app);
$exit_button->pack(- side=>"right",-anchor=>"e");

my $ml = $middle_frame->Scrolled("MListbox");
$ml->columnInsert("end",-text=>"#");
$ml- >pack(-side=>"bottom",-expand=>"nsew", -anchor=>"w", -fill=>"both");

$top_frame->pack(-side=>"top"); $middle_frame->pack(-side=>"top");
$bottom_frame->pack(-side=>"top");

sub execute_sql{
   $ml->delete(0,"end");
   $ml->columnDelete(1,"end");
   my $sql = $editor->get("1.0","end");
   my $sth = $dbh->prepare($sql);
   $sth->execute;
   my $n = 0;
   my $row = 1;
   my @columns;
   while(my $rec = $sth->fetchrow_hashref){
      if($n == 0){
         $n++;
         @columns = keys(%$rec);
         foreach my $col(@columns){
            $ml->columnInsert("end",-text=>$col)
         }
      }
      my @values = values(%$rec);
      unshift(@values,$row);
      $ml->insert("end",[@values]);
      $row++;
   }
   $sth->finish;
}

sub exit_app{
   $dbh->disconnect;
   exit;
}

MainLoop;

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.
  • It'd be interesting to try that result box with a grid manager, I think. Maybe I should do a column on that. {grin}
    --
    • Randal L. Schwartz
    • Stonehenge
  • I'd probably get the column names before the fetch with NAME_uc or NAME_lc and so display the names whether or not there are any rows fetched, then just do a straight 'fetch' rather than 'fetchrow_hashref' (in fact, that's what I'm now doing). I know, everyone's a critic :-) Thanks.
    • To see column names even with no rows:

      sub execute_sql{
         $ml->delete(0,"end");
         $ml->columnDelete(1,"end");
         my $sql = $editor->get("1.0","end");
         my $sth = $dbh->prepare($sql);
         $sth->execute;
         foreach my $col(@{ $sth->{NAME_uc} }){
            $ml->columnInsert("end",-text=>$col)
         }
         my $row = 1;
         while(my $rec = $sth->fetch){
            $ml->insert("end",[$row+

      • Yah, that's better. Well, if I had spent 5 extra minutes, I would have cleaned that up. :)
        • ...also, I'd take out the 'finish' since all rows are being fetched. Though I'd also add another data field to allow the user to only fetch the first N rows...in which case I'd leave in the 'finish'. Since I don't know Tk, it may take me more than five minutes :-)