====== 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 [[programmazione:perl:intro_perl-gtk2]] con le funzionalita di DBI, il layer piu' usato per diverse tipologie di basi dati di Perl.

{{:programmazione:perl:perl-gtk-intro0.png?200|}}
===== Il codice =====
Fonti per quanto riguarda la parte DBI :[[http://zetcode.com/db/sqliteperltutorial/connect/|http://zetcode.com]]


**db.pl**
<code Perl>
#!/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;

</code>

==== Installazione delle dipendenze su Windows ====
Per prima cosa installare [[http://strawberryperl.com/|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 ===
<file>
ppm install Glib
ppm install Cairo
ppm install Pango
ppm install Gtk2

</file>

=== Installazione DBI per sqlite2 ===
<file>
perl -MCPAN -e shell
cpan> install DBI
cpan[2]> install DBD::SQLite2
</file>

==== 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 [[http://www.gtk.org/download/index.php|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:

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

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

<file>gtk-theme-name = "MS-Windows"  </file>