On Jul 27, 2007, at 10:01 AM, Jeffrey Ratcliffe wrote:
> I have an application which has the option to read image files
> including TIFF and PDF. I use tiffsplit or pdfimages to extract the
> multiple images from these files and then read them one by one.
>
> As this can take a few seconds, I am adding a ProgressBar, forking a
> process to extract the images and examine them, passing various info,
> including the filename, back to the parent process, which updates the
> GUI.
Is it the handling in the parent that takes a while, or in the
child? I notice you have a sleep(2) in the loop in the gui,
presumably to simulate the gui taking al ong time...
> Whilst I realise that I can write the info to a file, rather than the
> socket (or pipe), or I could maintain a buffer, rather than reading
> from the pipe a line at a time. Is there a Right Way to do this? Maybe
> some way of signalling to the child process when the parent has
> finished?
If your child doesn't produce huge amounts of output, the socket
should buffer just fine. In fact, the child should be blocked until
the parent has read enough for the child to continue writing.
With some very minor changes, i get this example to work just fine.
(No need to go dorking around with the insanity of threads... ;-)
>
> Regards
>
> Jeff
>
> #!/usr/bin/perl
>
> use warnings;
> use strict;
> use Socket;
> use Gtk2 -init;
> use Glib qw(TRUE FALSE); # To get TRUE and FALSE
> use FileHandle;
> use POSIX;
>
> # Create the windows
> my $window = Gtk2::Window->new('toplevel');
> my $box = Gtk2::VBox->new;
> my $pbar = Gtk2::ProgressBar->new;
> my $buttonQuit = Gtk2::Button->new('Quit');
> my $buttonStart = Gtk2::Button->new('Start');
>
> $window->add ($box);
> $box->add ($pbar);
> $box->add($buttonQuit);
> $box->add($buttonStart);
>
> my %helperTag;
>
> # We should also link this to the destroy message on the main window,
> # this is just quick and dirty
> $buttonQuit->signal_connect(clicked => \&on_quit_clicked);
> $buttonStart->signal_connect(clicked => \&start_process);
> $window->show_all;
> Gtk2->main;
>
>
> # Process the exit of the child. If you were doing something useful,
> # you might keep things like information about what data needs
> # to be reloaded when a child process exits.
>
> sub sig_child {
> my $pid = wait;
> if ($pid >= 0) {
> delete $helperTag{$pid};
> }
> }
>
> $SIG{CHLD} = \&sig_child;
>
> sub start_process {
> my $pid;
>
> my ($reader, $writer);
> $reader = FileHandle->new;
> $writer = FileHandle->new;
> socketpair($reader, $writer, AF_UNIX, SOCK_STREAM, PF_UNSPEC);
>
> $pid = fork();
>
> if ($pid) {
> # We're still in the parent, set up to watch the streams:
>
> shutdown($writer, 0);
> my $line;
> $helperTag{$pid} = Glib::IO->add_watch($reader->fileno(), ['in',
> 'hup'], sub {
> my ($fileno, $condition) = @_;
>
> if ($condition & 'in') { # bit field operation. >= would also work
> my $line = <$reader>;
Two things here: You're shadowing the $line lexical, which is also
used outside this block. Once this block exits, the previous $line,
which was empty, is restored, and your code below doesn't work
right. Fixing this was part one.
$line = <$reader>;
Normally, i'd admonish you for using the <> operator in an io_watch
callback, since this has potential to block the main loop while
waiting for the rest of the line to show up... but implementing line
buffering manually is a pain in the butt, and it doesn't seem to have
an impact on this example, which is communicating with messages made
of small lines of text.
If small lines of text are what you have, you might actually want to
use datagram sockets, because you'll get guaranteed delivery of
entire messages.
> if ($line =~ /(\d*\.?\d*)(.*)/) {
> my $fraction=$1;
> my $text=$2;
> $pbar->set_fraction($fraction);
> $pbar->set_text($text);
> print "reading $text\n";
This sleep blocks the gui from updating, and more events show up,
which send us right back to sleep, so, you're simply not letting the
gui update. You can fix that with a simple
Gtk2->main_iteration while Gtk2->events_pending;
> sleep(2);
> }
> }
>
> # Can't have elsif here because of the possibility that both in and
> hup are set.
> # Only allow the hup if sure an empty buffer has been read.
> if (($condition & 'hup') and (! defined($line) or $line eq '')) { #
> bit field operation. >= would also work
> return FALSE; # uninstall
> }
> return TRUE; # continue without uninstalling
> });
> }
> else {
> # We're in the child. Do whatever processes we need to. We *must*
> # exit this process with POSIX::_exit(...), because exit() would
> # "clean up" open file handles, including our display connection,
> # and merely returning from this subroutine in a separate process
> # would *really* confuse things.
>
> shutdown($reader, 1);
> $pid = getpid();
> my $n = 4;
> for (my $i = 0; $i <= $n; $i++) {
> sleep(1);
> print "writing $i of $n\n";
> $writer->write($i/$n."Running $i of $n\n");
> $writer->flush;
> }
> POSIX::_exit(0);
> }
> }
>
>
> # We should clean up after ourselves so that we don't
> # leave dead processes flying around.
> sub on_quit_clicked {
> # 15 = SIGTERM
> kill 15, $_ foreach (keys %helperTag);
> Gtk2->main_quit;
> }
> _______________________________________________
> gtk-perl-list mailing list
> gtk-perl-list@gnome.org
> http://mail.gnome.org/mailman/listinfo/gtk-perl-list
--
If the monkey could type one keystroke every nanosecond, the expected
waiting time until the monkey types out Hamlet is so long that the
estimated age of the universe is insignificant by comparison ... this
is not a practical method for writing plays.
-- Gian-Carlo Rota
_______________________________________________
gtk-perl-list mailing list
gtk-perl-list@gnome.org
http://mail.gnome.org/mailman/listinfo/gtk-perl-list
