Creazione di programmi con Perl, DBI, GTK

Autore: Fabio Di Matteo
Ultima revisione: 03/02/2015 - 15:15

In questo articolo vedremo come creare applicazioni Perl (script) che fanno uso di interfacce grafiche e di accesso a basi di dati. Espanderemo il codice dell'articolo intro_perl-gtk2 con le funzionalita di DBI, il layer piu' usato per diverse tipologie di basi dati di Perl.

Il codice

Fonti per quanto riguarda la parte DBI :http://zetcode.com

db.pl

#!/usr/bin/perl
 
 
use Glib qw/TRUE FALSE/;
use Gtk2 '-init';
use Gtk2::SimpleList; 
use DBI;
 
#Questa funzione è da usare solo su sqlite2. 
#Sqlite3 supporta le query "... IF NOT EXIST..."
sub tableExist
{
	#Connessione al database
	my $dbh = DBI->connect(          
		"dbi:SQLite2:dbname=$_[0]", 
		"",                          
		"",                          
		{ RaiseError => 1 },         
	) or die $DBI::errstr;
 
	#Conta le tabelle con nome $_[1] 
	my $sth = $dbh->prepare("SELECT count(*) FROM sqlite_master WHERE type='table' AND name='$_[1]';");
	$sth->execute();
 
	#Mette il risultato della conta nell'array @row. Ovviamente prenderemo
	#in considerazione solo @row[0] ;
	my $row;
	@row = $sth->fetchrow_array();
 
	#Se @row[0] è uguale a 1 la tabella esiste, altrimenti no.
	if (@row[0]=='1'){ return TRUE } else{ return FALSE} ;
 
}
 
 
sub createTable
{
	#Se la tabella esiste non la crea
	if (tableExist("test.db","persone")) { return ;}
 
 
	#Connessione al database
	my $dbh = DBI->connect(          
		"dbi:SQLite2:dbname=test.db", 
		"",                          
		"",                          
		{ RaiseError => 1 },         
	) or die $DBI::errstr;
 
	#Creo la tabella
	$dbh->do('CREATE TABLE "persone" (
						  "id" INTEGER NOT NULL ,
						  "nome" varchar(1) ,
						  "cognome" varchar(256) ,
						  "email" varchar(256) ,
						  PRIMARY KEY ("id") 
						);');
 
	#Disconnessione
	$dbh->disconnect();
 
 
}
 
 
sub updateGrid
{
	#Cancella tutti glielementi  della griglia
	splice @{$slist->{data}} ;
 
 
	#Connessione al database
	my $dbh = DBI->connect(          
		"dbi:SQLite2:dbname=test.db", 
		"",                          
		"",                          
		{ RaiseError => 1 },         
	) or die $DBI::errstr;
 
 
 
	my $sth = $dbh->prepare("SELECT * FROM persone;");
	$sth->execute();
 
	my $row;
	while ($row = $sth->fetchrow_hashref()) 
	{
		#Prelevo i dati dalla query nella seguente forma $row->{NOMECAMPO}
 
		#Aggiungo una riga al widget SimpleList (tratto $slist come un normalisimo array)
		push @{$slist->{data}}, [ $row->{id}, $row->{nome},$row->{cognome}, $row->{email}];
	}
	$sth->finish();
	$dbh->disconnect();
 
}
 
 
#Le callbacks dei bottoni
sub exit
{
	my ($widget, $window) = @_;
	$window->destroy;
 
}
 
sub delete_event
{
	$window->destroy;
	return TRUE;
}
 
 
sub add
{
	my ($widget, $window) = @_;
 
	#Connessione al database
	my $dbh = DBI->connect(          
		"dbi:SQLite2:dbname=test.db", 
		"",                          
		"",                          
		{ RaiseError => 1 },         
	) or die $DBI::errstr;
 
	#Inserisco qualche dato
	$nome=$txtNome->get_text();
	$cognome=$txtCognome->get_text();
	$email=$txtEmail->get_text();
	$dbh->do("INSERT INTO persone VALUES(null,'$nome','$cognome','$email')");
 
	#Disconnessione
	$dbh->disconnect();
	clearText();
	updateGrid();
}
 
sub del
{
	#Prende il valore delle cella nascosta contenente l'id
	@sel = $slist->get_selected_indices;
	$id=$slist->{data}[@sel[0]][0];
 
	#Connessione al database
	my $dbh = DBI->connect(          
		"dbi:SQLite2:dbname=test.db", 
		"",                          
		"",                          
		{ RaiseError => 1 },         
	) or die $DBI::errstr;
 
	$dbh->do("DELETE from persone where id=$id ;");
 
	#Disconnessione
	$dbh->disconnect();
	clearText();
	updateGrid();
 
 
	clearText();#svuota le entry
}
 
sub get
{
	#Prende l'indice selezionato e visualizza i dati nelle entry
	@sel = $slist->get_selected_indices;
 
	#Il metodo "$slist->get_selected_indices" prende un array di righe (@sel)
	#selezionate. Noi andremo a prendere solo una di queste righe in quanto
	#la selezione è singola nel nostro caso.
 
	#Riga selezionata
	$txtId->set_text($slist->{data}[@sel[0]][0]);
	$txtNome->set_text($slist->{data}[@sel[0]][1]);
	$txtCognome->set_text($slist->{data}[@sel[0]][2]);
	$txtEmail->set_text($slist->{data}[@sel[0]][3]);
 
}
 
sub save
{
	#Prende il valore delle cella nascosta contenente l'id
	@sel = $slist->get_selected_indices;
	$id=$slist->{data}[@sel[0]][0];
 
	#Connessione al database
	my $dbh = DBI->connect(          
		"dbi:SQLite2:dbname=test.db", 
		"",                          
		"",                          
		{ RaiseError => 1 },         
	) or die $DBI::errstr;
 
	#Prendo i valori delle entry
	$nome=$txtNome->get_text();
	$cognome=$txtCognome->get_text();
	$email=$txtEmail->get_text();
 
 
	$sql="UPDATE  persone SET  	nome =  '$nome', cognome =  '$cognome',	email =  '$email' 	WHERE  id =$id ;";
 
	$dbh->do($sql);
 
	#Disconnessione
	$dbh->disconnect();
	clearText();
	updateGrid();
}
 
sub clearText
{
	#Questa funzione cancella soltanto il contenuto delle entry
	$txtId->set_text('');
	$txtNome->set_text('');
	$txtCognome->set_text('');
	$txtEmail->set_text('');
 
}
 
 
#Crea la tabella se non esiste
createTable();
 
 
 
 
# crea la finestra principale e la collega ad alcune callback
$window = Gtk2::Window->new('toplevel');
$window->signal_connect(delete_event => \&delete_event);
$window->signal_connect(destroy => sub { Gtk2->main_quit; });#alla chiusura quit
 
 
# Alcune prprietà della finestra
$window->set_border_width(10);
$window->set_size_request(640, 600);
$window->set_title("Rubrica");
$window->set_position('center');
 
 
#Entry e label per l'inserimento e modifica
$txtId = Gtk2::Entry->new();
$txtId->set_editable (FALSE);
$txtNome = Gtk2::Entry->new();
$txtCognome = Gtk2::Entry->new();
$txtEmail = Gtk2::Entry->new();
$lblId = Gtk2::Label->new ("ID:");
$lblNome = Gtk2::Label->new ("Nome:");  
$lblCognome = Gtk2::Label->new ("Cognome:");
$lblEmail = Gtk2::Label->new ("Email:");
 
#Bottoni per le azioni
$btnDel = Gtk2::Button->new("Elimina");
$btnExit = Gtk2::Button->new("Esci");
$btnAdd = Gtk2::Button->new("Aggiungi");
$btnSave = Gtk2::Button->new("Salva");
#Callbacks bottoni
$btnExit->signal_connect(clicked => \&exit, $window);
$btnAdd->signal_connect(clicked => \&add, $window);
$btnDel->signal_connect(clicked => \&del, $window);
$btnSave->signal_connect(clicked => \&save, $window);
 
 
#Colonne della griglia e relativo tipo
$slist = Gtk2::SimpleList->new (
                'ID'    => 'text',
                'Nome'    => 'text',
                'Cognome'  => 'text',
                'email'     => 'text',
              );
 
#Nascondo alla vista la colonna ID
$idColumn = $slist->get_column (0);
$idColumn->set_visible(FALSE);
 
 
#Aggiorno la griglia con i contnuti del db
updateGrid();
 
#Dimensioni della griglia
$slist->set_size_request(400,400);
 
 
#Al doppioclick su una riga esegui la funzione "get"
$slist->signal_connect(row_activated => \&get, $window); 
 
 
 
 
 
$hbox0 = Gtk2::HBox->new(); 		#contenitore dell'intera area
$vbox0 = Gtk2::VBox->new(); 		#contenitore griglia e bottoni
$vbox1 = Gtk2::VBox->new();			#contenitore caselle di testo ed etichette
 
 
#Aggiungo ad hbox0 gli altri contenitore vbox0 e vbox1
$hbox0->pack_start($vbox0, TRUE, FALSE, 0);
$hbox0->pack_start($vbox1, TRUE, FALSE, 0);
 
#Aggiungo al cntenitore vbox1 i vari campi testo con le relative etichette
$vbox1->pack_start($lblId, FALSE, TRUE, 0);
$vbox1->pack_start($txtId, FALSE, TRUE, 0);
 
 
$vbox1->pack_start($lblNome, FALSE, TRUE, 0);
$vbox1->pack_start($txtNome, FALSE, TRUE, 0);
 
$vbox1->pack_start($lblCognome, FALSE, FALSE, 0);
$vbox1->pack_start($txtCognome, FALSE, FALSE, 0);
 
$vbox1->pack_start($lblEmail, FALSE, FALSE, 0);
$vbox1->pack_start($txtEmail, FALSE, FALSE, 0);
 
 
#Aggiungo al contenitore vbox0 la griglia e i bottoni sotto di essa
$vbox0->pack_start($slist, TRUE, FALSE, 0);
$vbox0->pack_start($btnAdd, TRUE, FALSE, 0);
$vbox0->pack_start($btnSave, TRUE, FALSE, 0);
$vbox0->pack_start($btnDel, TRUE, FALSE, 0);
$vbox0->pack_start($btnExit, TRUE, FALSE, 0);
 
 
 
# Aggiungo box0 a $window
$window->add($hbox0);
 
 
 
# mostra tutto
$window->show_all;
 
#Ciclo principale delle Gtk
Gtk2->main;
 
0;

Installazione delle dipendenze su Windows

Per prima cosa installare strawberryperl Perl e le runtime GTK (http://downloads.sourceforge.net/gladewin32/gtk-2.8.20-win32-1.exe) poi impartire i seguenti comandi dal terminale di windows(cmd):

Installazione delle Gtk2 per Perl

ppm install Glib
ppm install Cairo
ppm install Pango
ppm install Gtk2

Installazione DBI per sqlite2

perl -MCPAN -e shell
cpan> install DBI
cpan[2]> install DBD::SQLite2

Caricare il tema grafico delle GTK per Windows

Purtroppo per utilizzare il tema grafico per windows sembra che bisogna fare alcuni interventi manuali. Prima di tutto scaricare il bundle con le Gtk2, 32 o 64bit a seconda della versione installata di Strawberry Perl.

Dopodicchè entriamo nella cartella del bundle gtk e copiamo le cartelle “bin” ,“lib”, “etc” e “share” nella sottocartella di Strawberry [inst. di Strawberry]\perl\site\lib\auto\Gtk2 . Fatto questo possiamo caricare il tema nel nostro codice per con:

#Per caricare il tema grafico solo su windows.
if ($^O=='MSWin32') {Gtk2::Rc->set_default_files ("gtkrc")};

Il file “gtkrc” lo possiamo mettere dove vogliamo e deve contenere il seguente testo:

gtk-theme-name = "MS-Windows"