Segmentation fault while using threads with perl tk
pooja
i am using threads with perl tk in my application , on the main window
close event the program displays segmentation fault. Can anyone help?
here is the code
###############[Code]#############
#!/usr/bin/perl-w;
use Tk;
use threads;
use threads::shared;
my $o:shared;
my $scale:shared;
my $position:shared;
my($p,$o,$e,$c,$thr,$file_progress,$canvas);
&share({$p});
&share({$e});
&share({$c});
&share({$file_progress});
$|++;
use mltpp;
mltpp::mlt_factory_init( undef );
my $file = $ARGV[0];
$SIG{TERM} = sub {\&bye; };
$p = new mltpp::Producer( $file );
my $mw = MainWindow->new;
my $id = $mw->repeat(10,\&file_moved);
$mw->geometry("350x300+110+30");
$mw->maxsize(350,300);
$mw->protocol(WM_DELETE_WINDOW => \&bye);
$file_progress = $mw->Scale(-bg => 'white',-orient =>
'horizontal',-command => sub{ &seek; },-activebackground =>
'white',-showvalue => '0',-variable => \$scale)->pack(-side =>
'bottom',-anchor => 'center',-expand => '1',-fill => 'x');
$canvas = $mw->Canvas(-bg => 'white')->pack(-fill => 'x',-ipady =>
'240');
$ENV{SDL_WINDOWID} = $canvas->id;
$o = ($p->get("out") - $p->get("in"));
$thr = threads->new(\&play);
$file_progress->configure(-from => 1);
$file_progress->configure(-to => $o);
MainLoop;
sub seek
{
if(defined($p))
{
$p->seek($scale);
}
}
sub play
{
sleep(1);
if ( $p->is_valid( ) )
{
$p->set( "eof", "pause" );
$c = new mltpp::FilteredConsumer( "sdl" );
$c->set( "rescale", "none" );
$c->connect( $p );
$e = $c->setup_wait_for( "consumer-stopped" );
$c->start;
$c->wait_for( $e );
$e = undef;
$c = undef;
$p = undef;
}
else
{
print "Unable to open $ARGV[0]\n";
}
}
sub file_moved
{
$position = $p->position();
$file_progress->set($position);
}
sub bye
{
mltpp::mlt_factory_close( );
$id->cancel;
$p = undef;
$c = undef;
$e = undef;
$o = undef;
exit;
}
zentara
>i am using threads with perl tk in my application , on the main window
>close event the program displays segmentation fault. Can anyone help?
>here is the code
Your problem comes because you are letting Tk code get copied
into your thread, by starting it late in the script. When a thread gets
launched, a copy of the main thread is made, so if there are Tk widgets
already in existence, they get copied in. Even if you don't use the Tk
code in the thread, it can cause problems, and will be unreliable.
So...... create your thread first, before starting any Tk widget code.
Also you don't show what is in mltpp, but don't try to
access objects across thread boundaries. Try to
keep thread code self-contained, and you will have
fewer problems.
>
>###############[Code]#############
>
>#!/usr/bin/perl-w;
>use Tk;
>use threads;
>use threads::shared;
>
>
>my $o:shared;
>my $scale:shared;
>my $position:shared;
>my($p,$o,$e,$c,$thr,$file_progress,$canvas);
>&share({$p});
>&share({$e});
>&share({$c});
>&share({$file_progress});
>$|++;
>use mltpp;
>mltpp::mlt_factory_init( undef );
>my $file = $ARGV[0];
>$SIG{TERM} = sub {\&bye; };
>$p = new mltpp::Producer( $file );
$thr = threads->new(\&play);
>
>my $mw = MainWindow->new;
>my $id = $mw->repeat(10,\&file_moved);
>$mw->geometry("350x300+110+30");
>$mw->maxsize(350,300);
>$mw->protocol(WM_DELETE_WINDOW => \&bye);
>$file_progress = $mw->Scale(-bg => 'white',-orient =>
>'horizontal',-command => sub{ &seek; },-activebackground =>
>'white',-showvalue => '0',-variable => \$scale)->pack(-side =>
>'bottom',-anchor => 'center',-expand => '1',-fill => 'x');
>
> $canvas = $mw->Canvas(-bg => 'white')->pack(-fill => 'x',-ipady =>
>'240');
>$ENV{SDL_WINDOWID} = $canvas->id;
>
> $o = ($p->get("out") - $p->get("in"));
# NOT HERE !!!!!! Tk widgets already going
# $thr = threads->new(\&play);
--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html
pooja
it is difficult for me to create thread before creating widgets since
I am selecting Mpeg files from a list box and trying to play (using MLT
framework) in a seperate thread.
So how can i create the thread before creating the widgets,
Can you please help??
Thanks & regards
Pooja
zentara
Just make a "sleeping thread" and control it with shared variables.
When you make the thread asleep, then use a button press callback,
or a $mw->waitvisibility to wake it up.
Here is an example which uses a sleeping thread. You wake it up
(or put it to sleep) with a shared variable. Don't get confused
by the complexity of the hash, the thread code block is at the
bottom. You should be able to see how it sits in a nested while
loop, testing to see if it should wake up and do something, or
go back to sleep.
#!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;
#works on Windows
my $data = shift || 'date'; #sample code to pass to thread
my %shash;
#share(%shash); #will work only for first level keys
my %hash;
my %workers;
my $numworkers = 3;
foreach my $dthread(1..$numworkers){
share ($shash{$dthread}{'go'});
share ($shash{$dthread}{'progress'});
share ($shash{$dthread}{'timekey'}); #actual instance of the thread
share ($shash{$dthread}{'frame_open'}); #open or close the frame
share ($shash{$dthread}{'handle'});
share ($shash{$dthread}{'data'});
share ($shash{$dthread}{'pid'});
share ($shash{$dthread}{'die'});
$shash{$dthread}{'go'} = 0;
$shash{$dthread}{'progress'} = 0;
$shash{$dthread}{'timekey'} = 0;
$shash{$dthread}{'frame_open'} = 0;
$shash{$dthread}{'handle'} = 0;
$shash{$dthread}{'data'} = $data;
$shash{$dthread}{'pid'} = -1;
$shash{$dthread}{'die'} = 0;
$hash{$dthread}{'thread'} = threads->new(\&work,$dthread);
}
use Tk;
use Tk::Dialog;
my $mw = MainWindow->new(-background => 'gray50');
my $lframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
->pack(-side =>'left' ,-fill=>'y');
my $rframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
->pack(-side =>'right',-fill =>'both' );
my %actives = (); #hash to hold reusable numbered widgets used for
downloads
my @ready = (); #array to hold markers indicating activity is needed
#make 3 reusable downloader widget sets-------------------------
foreach(1..$numworkers){
push @ready, $_;
#frames to hold indicator
$actives{$_}{'frame'} = $rframe->Frame( -background => 'gray50' );
$actives{$_}{'stopbut'} = $actives{$_}{'frame'}->Button(
-text => "Stop Worker $_",
-background => 'lightyellow',
-command => sub { } )->pack( -side => 'left', -padx => 10 );
$actives{$_}{'label1'} = $actives{$_}{'frame'} ->Label(
-width => 3,
-background => 'black',
-foreground => 'lightgreen',
-textvariable => \$shash{$_}{'progress'},
)->pack( -side => 'left' );
$actives{$_}{'label2'} = $actives{$_}{'frame'} ->Label(
-width => 1,
-text => '%',
-background => 'black',
-foreground => 'lightgreen',
)->pack( -side => 'left' );
$actives{$_}{'label3'} = $actives{$_}{'frame'} ->Label(
-text => '',
-background => 'black',
-foreground => 'skyblue',
)->pack( -side => 'left',-padx =>10 );
}
#--------------------------------------------------
my $button = $lframe->Button(
-text => 'Get a worker',
-background => 'lightgreen',
-command => sub { &get_a_worker(time) }
)->pack( -side => 'top', -anchor => 'n', -fill=>'x', -pady =>
20 );
my $text = $rframe->Scrolled("Text",
-scrollbars => 'ose',
-background => 'black',
-foreground => 'lightskyblue',
)->pack(-side =>'top', -anchor =>'n');
my $repeat;
my $startbut;
my $repeaton = 0;
$startbut = $lframe->Button(
-text => 'Start Test Count',
-background => 'hotpink',
-command => sub {
my $count = 0;
$startbut->configure( -state => 'disabled' );
$repeat = $mw->repeat(
100,
sub {
$count++;
$text->insert( 'end', "$count\n" );
$text->see('end');
}
);
$repeaton = 1;
})->pack( -side => 'top', -fill=>'x', -pady => 20);
my $stoptbut = $lframe->Button(
-text => 'Stop Count',
-command => sub {
$repeat->cancel;
$repeaton = 0;
$startbut->configure( -state => 'normal' );
})->pack( -side => 'top',-anchor => 'n', -fill=>'x', -pady => 20 );
my $exitbut = $lframe->Button(
-text => 'Exit',
-command => sub {
foreach my $dthread(keys %hash){
$shash{$dthread}{'die'} = 1;
$hash{$dthread}{'thread'}->join
}
if ($repeaton) { $repeat->cancel }
#foreach ( keys %downloads ) {
# #$downloads{$_}{'repeater'}->cancel;
#}
# $mw->destroy;
exit;
})->pack( -side => 'top',-anchor => 'n', -fill=>'x', -pady => 20
);
#dialog to get file url---------------------
my $dialog = $mw->Dialog(
-background => 'lightyellow',
-title => 'Get File',
-buttons => [ "OK", "Cancel" ]
);
my $hostl = $dialog->add(
'Label',
-text => 'Enter File Url',
-background => 'lightyellow'
)->pack();
my $hostd = $dialog->add(
'Entry',
-width => 100,
-textvariable => '',
-background => 'white'
)->pack();
$dialog->bind( '<Any-Enter>' => sub { $hostd->Tk::focus } );
my $message = $mw->Dialog(
-background => 'lightyellow',
-title => 'ERROR',
-buttons => [ "OK" ]
);
my $messagel = $message->add(
'Label',
-text => ' ',
-background => 'hotpink'
)->pack();
$mw->repeat(10, sub{
if(scalar @ready == $numworkers){return}
foreach my $set(1..$numworkers){
$actives{$set}{'label1'}->
configure(-text =>\$shash{$set}{'progress'});
if(($shash{$set}{'go'} == 0) and
($shash{$set}{'frame_open'} == 1))
{
my $timekey = $shash{$set}{'timekey'};
$workers{ $timekey }{'frame'}->packForget;
$shash{$set}{'frame_open'} = 0;
push @ready, $workers{$timekey}{'setnum'};
if((scalar @ready) == 3)
{ }
$workers{$timekey} = ();
delete $workers{$timekey};
}
}
});
$mw->MainLoop;
###################################################################
sub get_a_worker {
my $timekey = shift;
$hostd->configure( -textvariable => \$data);
if ( $dialog->Show() eq 'Cancel' ) { return }
#----------------------------------------------
#get an available frameset
my $setnum;
if($setnum = shift @ready){print "setnum->$setnum\n"}
else{ print "no setnum available\n"; return}
$workers{$timekey}{'setnum'} = $setnum;
$shash{$setnum}{'timekey'} = $timekey;
$workers{$timekey}{'frame'} = $actives{$setnum}{'frame'};
$workers{$timekey}{'frame'}->pack(-side =>'bottom', -fill => 'both' );
$workers{$timekey}{'stopbut'} = $actives{$setnum}{'stopbut'};
$workers{$timekey}{'stopbut'}->configure(
-command => sub {
$workers{$timekey}{'frame'}->packForget;
$shash{ $workers{$timekey}{'setnum'} }{'go'} = 0;
$shash{ $workers{$timekey}{'setnum'} }{'frame_open'} = 0;
push @ready, $workers{$timekey}{'setnum'};
if((scalar @ready) == $numworkers)
{ }
$workers{$timekey} = ();
delete $workers{$timekey};
});
$workers{$timekey}{'label1'} = $actives{$setnum}{'label1'};
$workers{$timekey}{'label1'}->configure(
-textvariable => \$shash{$setnum}{'progress'},
);
$workers{$timekey}{'label2'} = $actives{$setnum}{'label2'};
$workers{$timekey}{'label3'} = $actives{$setnum}{'label3'};
$workers{$timekey}{'label3'}->configure(-text => $timekey);
$shash{$setnum}{'go'} = 1;
$shash{$setnum}{'frame_open'} = 1;
#--------end of get_file sub--------------------------
}
##################################################################
sub work{
my $dthread = shift;
$|++;
while(1){
if($shash{$dthread}{'die'} == 1){ goto END };
if ( $shash{$dthread}{'go'} == 1 ){
eval( system( $shash{$dthread}{'data'} ) );
foreach my $num (1..100){
$shash{$dthread}{'progress'} = $num;
print "\t" x $dthread,"$dthread->$num\n";
select(undef,undef,undef, .5);
if($shash{$dthread}{'go'} == 0){last}
if($shash{$dthread}{'die'} == 1){ goto END };
}
$shash{$dthread}{'go'} = 0; #turn off self before returning
}else
{ sleep 1 }
}
END:
}
#####################################################################