Foro - Perl en Español

La comunidad de programadores en Perl de habla hispana.
http://perlenespanol.com/foro/

Un fork en perl-gtk2

http://perlenespanol.com/foro/un-fork-en-perl-gtk2-t6647.html

Página 1 de 1

Un fork en perl-gtk2

NotaPublicado: 2011-12-07 07:00 @333
por morago
Hola.

He creado un proceso en un programilla de perl-gtk2 y Glade con la intención de que los widgets me sigan respondiendo mientras se desarrolla el proceso.

Tengo dos botones. Uno que arranca el proceso y otro que lo detiene. Al arrancar el proceso pongo el botón que lo arranca insensible ($btn_arrancar->sensitive('0')) y el cursor con un reloj de espera.

El caso es que si detengo el proceso con el botón de detener, tanto el cursor como el estado del otro botón vuelven a la normalidad. Sin embargo, cuando el proceso se detiene por sí mismo el estado del botón continúa insensible y el cursor de reloj se mantiene. No doy con el modo de que vuelva a la normalidad tras el fin natural del proceso.

Gracias por la atención.

Este es el código:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/perl
  2.  
  3. use strict;
  4. use Gtk2 'init';
  5. use Gtk2::GladeXML;
  6.  
  7. use vars qw($nproc);
  8.  
  9. my $glade_app      = Gtk2::GladeXML->new("$ENV{'HOME'}/bin/Glade/GtkCNMV/pruebas/gtkfork.xml");
  10. my $cursor_normal  = Gtk2::Gdk::Cursor->new('left_ptr');
  11. my $cursor_ocupado = Gtk2::Gdk::Cursor->new('watch');
  12.  
  13. my $win          = $glade_app->get_widget('window1');
  14. my $btn_arrancar = $glade_app->get_widget('button1');
  15. my $btn_detener  = $glade_app->get_widget('button2');
  16.  
  17. $btn_arrancar->signal_connect( 'clicked' => \&arrancar );
  18. $btn_detener->signal_connect( 'clicked' => \&detener );
  19. $win->signal_connect( 'delete_event' => sub { Gtk2->main_quit; } );
  20.  
  21. $win->show_all;
  22. Gtk2->main;
  23.  
  24. sub arrancar {
  25.     $btn_arrancar->set_sensitive('0');
  26.     $btn_arrancar->window->set_cursor($cursor_ocupado);
  27.  
  28.     my $PID = fork();
  29.     if ($PID) {
  30.         $nproc = $$;
  31.  
  32.         # Mi manera cutre de pasar el número de proceso :)
  33.         open( TMP, ">/tmp/nproc" ) or die "Error: $!\n";
  34.         print TMP $nproc;
  35.         close TMP;
  36.  
  37.         foreach ( 0 .. 3 ) {
  38.             print ">> $_\n";
  39.             sleep 1;
  40.             detener() if ( $_ >= 3 );
  41.         }
  42.     }
  43.     else { return "No hay fork: $!\n"; }
  44.  
  45.     return;
  46. }
  47.  
  48. sub detener {
  49.     $btn_arrancar->set_sensitive('1');
  50.     $btn_arrancar->window->set_cursor($cursor_normal);
  51.  
  52.     open( TMP, "</tmp/nproc" ) or die "Error: $!\n";
  53.     $nproc = $_ while (<TMP>);
  54.     close TMP;
  55.  
  56.     print "Terminando $nproc...\n";
  57.     kill TERM => $nproc;
  58.  
  59.     return;
  60. }
  61.  
Coloreado en 0.005 segundos, usando GeSHi 1.0.8.4

Re: Un fork en perl-gtk2

NotaPublicado: 2011-12-07 12:29 @561
por explorer
No lo he mirado mucho, pero veo algunas cosas...

En la línea 28 se hace el fork(). En ese momento se crea un proceso hijo que es idéntico al padre, y los dos siguen en ese mismo punto.

En la línea 29 se pregunta por el valor de $PID.

Si $PID está definido y es positivo, resulta que somos el padre ($PID es el número de proceso del hijo).

Entonces, el padre entra en el bucle de espera de 3 segundos, al final de los cuales, se detiene.

En cambio, el hijo al llegar a la línea 29, recibe un valor 0 (el $PID dentro del hijo vale 0), con lo que salta directamente a la línea 43, donde hace un return y termina el proceso asociado a la pulsación del botón, y se queda esperando. (No es cierto lo que pones en la línea 43, de que no se ha generado el fork(). Para saber si el fork() ha funcionado bien o no, debes comprobar si el valor devuelto por fork() está definido o no (undef).)

Más información en perldoc -f fork .

Re: Un fork en perl-gtk2

NotaPublicado: 2011-12-08 10:29 @478
por salva
El problema es que tanto el padre como el hijo están accediendo a la interfaz gráfica y eso no funciona.

La forma correcta de enfocar este tipo de problemas es hacer que un solo proceso (normalmente el padre) se encargue en exclusiva de controlar la interfaz gráfica a la vez que habla con el hijo (habitualmente mediante pipes) que hará otro tipo de tareas (algún cálculo, acceder a algún servicio de red, etc).

Una vez que el hijo termina, tiene que llamar a POSIX::_exit() para salir sin llamar a los métodos DESTROY ni a los bloques END, lo cual también interferiría con el GUI.

Re: Un fork en perl-gtk2

NotaPublicado: 2011-12-11 13:07 @588
por morago
Gracias por vuestras respuestas. He encontrado un par de scripts que muestran el uso de threads en Gtk2:
http://code.google.com/p/saaral-soft-search-spider/
http://cpansearch.perl.org/src/FLORA/Gtk2-1.223/examples/thread_usage.pl

El autor del primero dice que Gtk2::GladeXML no se lleva muy bien con los hilos.

Re: Un fork en perl-gtk2

NotaPublicado: 2011-12-13 19:17 @845
por morago
Parece que el uso de threads supone una solución muy simple y limpia. Aunque aún no lo he probado con glade, este es el ejemplo que me ha quedado:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/env perl
  2.  
  3. use strict;
  4. use warnings;
  5. use threads;
  6. use LWP::Simple;
  7. use Glib qw(TRUE FALSE);
  8. use Gtk2 qw/-init -threads-init/;
  9.  
  10.  
  11. my $hebra_down;
  12. my $deb = ( 'firefox_8.0+build1-0ubuntu0.11.10.3_amd64.deb' );
  13. my $firefox = ( "http://security.ubuntu.com/ubuntu/pool/main/f/firefox/$deb" );
  14.  
  15. die "Glib::Object thread safetly failed"
  16.         unless Glib::Object->set_threadsafe (TRUE);
  17.  
  18. my $win = Gtk2::Window->new;
  19. $win->signal_connect (destroy => sub { Gtk2->main_quit; });
  20. $win->set_title ($0);
  21. $win->set_border_width (10);
  22. $win->set_default_size (400, 200);
  23. $win->set_position('center');
  24.  
  25. my $hbox = Gtk2::HBox->new (FALSE, 6);
  26. $win->add ($hbox);
  27.  
  28. my $vbox = Gtk2::VBox->new (FALSE, 6);
  29. $hbox->pack_start ($vbox, FALSE, FALSE, 0);
  30.  
  31. my $btn_iniciar = Gtk2::Button->new ('Iniciar');
  32. $vbox->pack_start ($btn_iniciar, FALSE, FALSE, 0);
  33.  
  34. my $btn_parar = Gtk2::Button->new ('Parar');
  35. $vbox->pack_start ($btn_parar, FALSE, FALSE, 0);
  36. $btn_parar->set_sensitive(FALSE);
  37.  
  38. my $pending = Gtk2::Label->new ('Pulsar para iniciar la descarga');
  39. $vbox->pack_start ($pending, FALSE, FALSE, 0);
  40.  
  41. $btn_iniciar->signal_connect (clicked => sub {
  42.                 local $SIG{KILL} = sub { threads->exit };
  43.  
  44.                 $btn_iniciar->set_sensitive (FALSE);
  45.                 $btn_parar->set_sensitive(TRUE);
  46.                 $pending->set_label('Descargando');
  47.                
  48.                 $hebra_down = threads->create(\&procesa_descarga);
  49.                 });
  50.  
  51. $btn_parar->signal_connect (clicked => sub {
  52.                 $hebra_down->kill('KILL')->detach;
  53.                
  54.                 $btn_iniciar->set_sensitive (TRUE);
  55.                 $btn_parar->set_sensitive(FALSE);
  56.                 $pending->set_label('Descarga cancelada');
  57.                 });
  58.  
  59. $win->show_all;
  60. Gtk2->main;
  61.  
  62.  
  63. sub procesa_descarga
  64.   {
  65.         my $ua = LWP::UserAgent->new();
  66.         $ua->timeout(10);
  67.         my $response = $ua->get( $firefox );
  68.  
  69.         if ($response->is_success)
  70.           {
  71.           open (FF, ">$deb") or return "Error volcando a disco: $!\n";
  72.           print FF $response->decoded_content();
  73.           close FF;
  74.  
  75.           $btn_iniciar->set_sensitive(TRUE);
  76.           $btn_parar->set_sensitive(FALSE);
  77.  
  78.           if ($response->status_line eq '200 OK')
  79.             {
  80.             $pending->set_label("Descarga completa\n" . $response->status_line);
  81.             return $response->status_line;
  82.             }
  83.           else
  84.             {
  85.             $pending->set_label("Se ha producido un error\n" . $response->status_line);
  86.             return $response->status_line;
  87.             }
  88.           }
  89.         else {
  90.             $pending->set_label("Se ha producido un error\n" . $response->status_line);
  91.             return $response->status_line;
  92.             }
  93.   }
  94.  
Coloreado en 0.004 segundos, usando GeSHi 1.0.8.4
Todos los horarios son UTC - 6 horas [ DST ]
Página 1 de 1
Powered by phpBB® Forum Software © phpBB Group
https://www.phpbb.com/