view release on metacpan or  search on metacpan

examples/thread_usage.pl  view on Meta::CPAN

#!/usr/bin/perl

#
# $Id$
#
# -rm
#

use strict;
use warnings;
use Data::Dumper;

use Glib qw(TRUE FALSE);
use Gtk2 qw/-init -threads-init 1.050/;

die "Glib::Object thread safetly failed"
	unless Glib::Object->set_threadsafe (TRUE);

my $win = Gtk2::Window->new;
$win->signal_connect (destroy => sub { Gtk2->main_quit; });
$win->set_title ($0);
$win->set_border_width (6);
$win->set_default_size (640, 480);

my $hbox = Gtk2::HBox->new (FALSE, 6);
$win->add ($hbox);

my $vbox = Gtk2::VBox->new (FALSE, 6);
$hbox->pack_start ($vbox, FALSE, FALSE, 0);

my $worklog = Log->new;
$hbox->pack_start ($worklog, TRUE, TRUE, 0);

my @workers;
my $worker;
foreach (1..5)
{
	$worker = Worker->new ($worklog);
	$vbox->pack_start ($worker, FALSE, FALSE, 0);
	$worker->set_worker_label ('Worker '.$_);
	push @workers, $worker;
}

my $pending = Gtk2::Label->new ('0 jobs pending');
$vbox->pack_start ($pending, FALSE, FALSE, 0);
Glib::Timeout->add (500, sub {
		$pending->set_text (Worker->jobs_pending.' jobs pending');
		1;
	});

my $count = 0;

my $go = Gtk2::Button->new ('_Go');
$vbox->pack_start ($go, FALSE, FALSE, 0);
$go->signal_connect (clicked => sub {
		foreach (@workers)
		{
			Worker->do_job ($count + rand);
			$count++;
		}
	});

my $quit = Gtk2::Button->new_from_stock ('gtk-quit');
$vbox->pack_start ($quit, FALSE, FALSE, 0);
$quit->signal_connect (clicked => sub { 
		$go->set_sensitive (FALSE);
		$quit->set_sensitive (FALSE);
		Worker->all_fired;
		Gtk2->main_quit;
	});

$win->show_all;
Gtk2->main;

package Worker;

use strict;
use warnings;
use Data::Dumper;

use threads;
use threads::shared;
use Thread::Queue;

use Glib qw(TRUE FALSE);

use base 'Gtk2::HBox';

our $_nworkers : shared = 0;
my $_jobs;

BEGIN
{
	$_jobs = Thread::Queue->new;
}

sub do_job
{
	shift; # class

	$_jobs->enqueue (shift);
}

sub all_fired
{
	shift; # class