#!/usr/bin/perl
#
# app2.pl
#
# Autor: Marco Antonio Manzo <[email protected]>
#
# Descripción:
#   Programa3 de ejemplo - Tutorial Gtk2-Perl
#
# Licencia:
# Este programa puede ser redistribuido y/o modificado bajo
# los mismos términos de la licencia artística de Perl.
#

use strict;
use warnings;

use Glib qw( TRUE FALSE );
use Gtk2 '-init';
use Gtk2::SimpleMenu;
use Gtk2::SimpleList;

# Módulos necesarios para el funcionamiento de nuestra aplicación.
use DBI;
use YAML qw( LoadFile );
use UNIVERSAL 'isa';

sub _init {
    # Variable que utilizaremos para mantener el estado
    # entre algunos objetos de nuestra aplicación.
    my $args = { }; 

    # Creamos todos los widgets principales de nuestra aplicación,
    # utilizando nuevamente funciones fabricadas por nosotros para
    # encapsular dichos objetos.
    my $window = create_window( $args );
    my $query_frame = create_query_frame( $args );
    my $results_frame = create_results_frame( $args );
    my $menu = create_menu( $args );
    my $hbbox = create_app_buttons( $args );

    # Caja vertical que contiene todos nuestros widgets creados,
    # listos para ser mostrados.
    my $vbox = Gtk2::VBox->new( FALSE, 1 );
    $vbox->pack_start( $menu->{widget}, FALSE, FALSE, 1 );
    $vbox->pack_start( Gtk2::HSeparator->new, FALSE, FALSE, 1 );
    $vbox->pack_start( $query_frame, TRUE, TRUE, 3 );
    $vbox->pack_start( $results_frame, TRUE, TRUE, 3 );
    $vbox->pack_end( $hbbox, FALSE, FALSE, 1 );

    $window->add( $vbox );

    # Un AccelGroup es la clase que nos permite tener 'teclas rápidas'
    # de acceso, en nuestro caso, para el menú creado con Gtk2::SimpleMenu.
    # Automáticamente nuestro Gtk2::SimpleMenu contiene entre sus atributos
    # el accelgroup generado usando nuestro árbol de menú. Lo utilizamos como
    # parámetro en la ventana principal.
    $window->add_accel_group( $menu->{accel_group} );
    $window->show_all;
    return;
}

# Esta función nos regresa un objeto de tipo Gtk2::HButtonBox el cual contiene
# agrupados los botones principales de nuestra aplicación.
sub create_app_buttons {
    my $args = shift;

    # A diferencia de los otros constructores, new_from_stock() te permite crear
    # un botón utilizando imágenes y nombres del stock de GTk. Una vez creado
    # cada botón conectamos su señal de 'clicked' correspondiente.
    my $exit_btn = Gtk2::Button->new_from_stock( 'gtk-quit' );
    $exit_btn->signal_connect( clicked => \&on_window_destroy, $args );
    my $clear_btn = Gtk2::Button->new_from_stock( 'gtk-refresh' );
    $clear_btn->signal_connect( clicked => \&clear_results, $args );
    my $exe_btn = Gtk2::Button->new_from_stock( 'gtk-execute' );
    $exe_btn->signal_connect( clicked => \&exec_query, $args );

    # Gtk2::Tooltips nos permite generar algunos mensajes emergentes a la hora
    # de posicionarnos sobre el widget que establezcamos como parámetro, nuestro
    # caso los botones principales.
    my $tooltips = Gtk2::Tooltips->new;
    $tooltips->set_tip( $exit_btn, 'Salir de la aplicación' );
    $tooltips->set_tip( $clear_btn, 'Limpiar area de resultados' );
    $tooltips->set_tip( $exe_btn, 'Ejecutar Query' );
    $tooltips->enable;

    # Utilizamos un Gtl2::HButtonBox para agrupar un conjunto de botones los cuales
    # queremos que se dispersen a lo largo de la área de la aplicación( 'spread' ),
    # con un espaciado de 15px entre c/u de ellos.
    my $hbbox = Gtk2::HButtonBox->new;
    $hbbox->set_layout( 'spread' );
    $hbbox->set_spacing( 15 );

    $hbbox->add( $exe_btn );
    $hbbox->add( $clear_btn );
    $hbbox->add( $exit_btn );
    return $hbbox;
}

sub create_menu {
    my $args = shift;
    
    # Nuestro menú ahora será creado utilizando la clase Gtk2::SimpleMenu, la
    # cual require como parámetro un arbol con todos los nodos, callbacks,
    # aceleradores e hijos correspondientes.
    my $menu_tree = [
		  _Archivo =>
		  {
		   item_type => '<Branch>',
		   children => [
				'_Cargar Configuración' => {
							    callback => \&on_open_file,
							    callback_action => 0,
							    accelerator => '<ctrl>C',
							    callback_data => $args
							   },
				Separator => {
					      item_type => '<Separator>'
					     },
				'_Salir' => {
					     callback => sub {
						 $args->{db}->disconnect
						   if exists $args->{db};
						 Gtk2->main_quit
					     },
					     callback_action => 1,
					     accelerator => '<ctrl>S',
					    }
			       ]
		  },
		  A_yuda =>
		  {
		   item_type => '<Branch>',
		   children => [
				'Acerca de...' => {
						   callback => \&on_about,
						   callback_action => 2,
						   accelerator => '<ctrl>H'
						  }
			       ]
		  }
		 ];

    # Generamos nuestro menú.
    my $menu = Gtk2::SimpleMenu->new( menu_tree => $menu_tree );
    return $menu;
}

sub create_window {
    my $args = shift;
    my $window = Gtk2::Window->new( 'toplevel' );
    $window->set_title( 'Gtk2-Perl: Cliente SQL' );
    $window->set_default_size( 500, 400 ); # Tamaño inicial
    $window->set_border_width( 5 ); # Tamaño del borde
    $window->signal_connect( destroy => \&on_window_destroy, $args );
    return $window;
}

# Esta función se encargará de crear un frame con el área de texto donde
# podremos escribir nuestra sentencia de SQL.
sub create_query_frame {
    my $args = shift;
    # Un Gtk2::TextView nos servirá para poder almacenar un buffer con texto
    # el cual utilizaremos para escribir nuestra sentencia de SQL.
    my $textview = Gtk2::TextView->new;
    $textview->set_size_request( 0, 100 );

    # Es necesario guardar referencia sobre este objeto para poder manipularlo
    # mas delante.
    $args->{textwidget} = $textview;

    # nuestro Frame a retornar
    my $frame = Gtk2::Frame->new( '  SQL Query  ' );
    $frame->set_border_width( 5 );
    $frame->add( $textview );
    return $frame;
}

# Esta función retorna otro frame en el cual se podrán visualizar los resultados
# de la sentencia de SQL escrita.
sub create_results_frame {
    my $args = shift;
    my $frame = Gtk2::Frame->new( '  Resultados  ' );
    $frame->set_border_width( 5 );
    $frame->set_size_request( 0, 200 );

    # Gtk2::SimpleList nos permite generar una Lista de valores con tipos
    # de datos tales como texto, pixbufs, entre otros. Para nuestro propósito
    # Solamente utilizaremos campos de texto.
    $args->{results} = Gtk2::SimpleList->new(
					     name => 'text',
					     value => 'text'
					    );
    # Una ventana con barra de desplazamiento nos será de mucha ayuda en caso de
    # que la cantidad de filas retornadas por la base de datos sea muy grande.
    my $sc = Gtk2::ScrolledWindow->new;
    # La barra de desplazamiento aparecerá automáticamente, es decir solo cuando
    # sea necesaria.
    $sc->set_policy( 'automatic', 'automatic' ); 
    $sc->add( $args->{results} );
    $frame->add( $sc );
    # Guardamos referencia a nuestro widget para utilizarlo posteriormente
    $args->{scwin} = $sc;
    return $frame;
}

sub on_open_file {
    my $args = shift;
    my $fc = Gtk2::FileChooserDialog->new( 'Selecciona archivo de configuración', 
					   undef, 'open',
					   'gtk-ok' => 'ok',
					   'gtk-cancel' => 'cancel'
					 );
    if( $fc->run eq 'ok' ) {
	# Al seleccionar nuestro archivo de configuración, lo cargamos en una
	# estructura de datos.
	my $yaml = LoadFile( $fc->get_filename );
	my $dsn = make_dsn( $yaml ); # generamos nuestro DSN para la BD
	# Si todo sale bien, DBI->connect nos retorna una referencia a un objeto
	# de tipo DBI, caso contrario muere nuestra aplicación.
	$args->{db} = DBI->connect( $dsn, $yaml->{username}, $yaml->{password},
				    { RaiseError => 1 } ) or die $DBI::errstr;
    }
    $fc->destroy;
    return TRUE;
}

sub on_about {
    my $about = Gtk2::Dialog->new( 'Acerca de...', undef, 'modal',
				   'gtk-ok' => 'ok' );
    
    my $text =<<INFO;
Programa de prueba para
el Tutorial de Gtk2-Perl.

Autor: Marco Antonio Manzo

Consol 2005
INFO

    $about->vbox->pack_start( Gtk2::Label->new( $text ), FALSE, FALSE, 4 );
    $about->vbox->show_all;
    $about->destroy if $about->run;
    return TRUE;
}

# Manejador para el evento 'destroy'
sub on_window_destroy {
    my( $pwidget, $args ) = @_;
    # Desconecta nuestro manejador de la BD si este fué creado.
    $args->{db}->disconnect if exists $args->{db};
    Gtk2->main_quit;
    return;
}

# Esta función nos retorna una cadena con el DSN generado apartir del archivo
# de configuración.
sub make_dsn {
    my $yaml = shift;
    my $dsn = sprintf( "dbi:%s:dbname=%s;host=%s", $yaml->{dbdriver},
		       $yaml->{dbname}, $yaml->{dbhost} );
    return $dsn;
}

# Esta función limpiará el área de resultados cuando presionemos el botón
# Actualizar.
sub clear_results {
    my( $widget, $args ) = @_;
    # Si nuestra área de resultados se trata de un Gtk2::TextView, simplemente
    # borramos el buffer actual, sino, se trata obviamente de un Gtk2::SimpleList
    # entonces borramos su área de datos.
    unless( $args->{results}->isa( 'Gtk2::SimpleList' ) ) {
	$args->{results}->get_buffer->set_text( '' );
	return TRUE;
    }
    $args->{results}->set_data_array( [] );
    return TRUE;
}

# Nos despliega un cuadro de diálogo con el mensaje de error recibido.
sub error_window {
    my $msg = shift;
    my $dialog = Gtk2::Dialog->new( 'Error', undef, 'modal',
				    'gtk-ok' => 'ok' );
    $dialog->vbox->pack_start( Gtk2::Label->new( $msg ), FALSE, FALSE, 4 );
    $dialog->vbox->show_all;
    $dialog->destroy if $dialog->run;
    return TRUE;

}

# Esta función es la que, dependiendo del tipo de query, serán los resultados
# visualizados, y se manda llamar cuando presionamos el botón Ejecutar.
sub exec_query {
    my ( $widget, $args ) = @_;

    # Si el archivo de configuración no está cargado, despliega un mensaje
    # de error.
    error_window( "Faltar cargar configuración" ) and return
      unless $args->{db};

    # Gtk2::TextView contiene dentro un objeto de tipo Gtk2::TextBuffer, el cual
    # contiene  el texto que nosotros escribimos, es necesario obtenerlo para
    # poder ejecutar el query.
    my $buffer = $args->{textwidget}->get_buffer;
    my $query = $buffer->get_text( $buffer->get_start_iter, 
				   $buffer->get_end_iter, TRUE );

    # Si el buffer está vacío, significa que el usuario presionó ejecutar
    # sin escribir una sentencia de SQL.
    error_window( "No hay query a ejecutar" ) and return
      unless $query;

    my $sth = $args->{db}->prepare( $query );
    $sth->execute;

    my $newwidget; # Aqui almacenamos el widget a utilizar para los resultados
    if( $query =~ /^select/i ) {
	# Si se trata de un SELECT entonces utilizaremos un Gtk2::SimpleList
	# para mostrar los resultados.
	my( @ret, $row );
	push @ret, $row while $row = $sth->fetchrow_hashref;
	# Retornamos los nombres de las columnas
	my @columns = get_columns_ready( $ret[0] );
	$newwidget = Gtk2::SimpleList->new( @columns );
	# Establecemos el área de datos de nuestra lista.
	$newwidget->set_data_array( get_column_values( \@ret ) );
    } else {
	# Si se trata de cualquier otra cosa que no sea SELECT utilizaremos
	# un Gtk2::TextView para mostrar las filas afectadas.
	my $count = $sth->rows;
	my $msg = "$count fila(3Cs) afectada(s)";
	$newwidget = Gtk2::TextView->new;
	$buffer = Gtk2::TextBuffer->new;
	$buffer->set_text( $msg );
	$newwidget->set_buffer( $buffer );
    }
    $sth->finish;

    $args->{scwin}->remove( $args->{results} );
    $args->{scwin}->add( $newwidget );
    # Guardamos nuestro nuevo widget de resultados para su futura
    # utilización.
    $args->{results} = $newwidget;
    $args->{scwin}->show_all;
    return TRUE;
}

# Esta función nos retorna el nombre de las columnas utilizadas
# por la sentencia en SQL.
sub get_columns_ready {
    my $row = shift;
    my @ret;
    push( @ret, $_, 'text' ) for keys %{ $row };
    return @ret;
}

# Esta función nos retorna una referencia a un array con los valores
# retornados por la sentencia de SQL, el cual utilizaremos con nuestro
# Gtk2::SimpleList
sub get_column_values {
    my $rows = shift;
    my $ret;
    @{$ret} = map{ [ values %{ $_ } ] } @$rows;
    return $ret;
}

_init;

Gtk2->main;