use strict; use warnings; use Tkx; my $esub =0; use Getopt::Long; my %optdef=("esub=i" => \$esub); GetOptions (%optdef) or die("Error in command line arguments\n"); print "encapulated sub=$esub\n"; my $mw=Tkx::widget->new("."); my $connct=0; my $tkxfsr={}; $tkxfsr->{server}{port}=123; my $buf='hi'; my $remote='1234'; $connct++; my $id=time.'_'.$tkxfsr->{server}{port}.'_c'.$connct; my $afterid='serverq-'.$id; print 'SCMD '.$id.' '.$buf."\n"; $tkxfsr->{after}{$afterid}{q}=[]; for my $i (1..10){ push @{$tkxfsr->{after}{$afterid}{q}},$id.' '.$buf.' '.$i.('-'x10);} $tkxfsr->{after}{$afterid}{sub}=sub{ return unless ($tkxfsr->{after} && $tkxfsr->{after}{$afterid} && $tkxfsr->{after}{$afterid}{q}); if (scalar(@{$tkxfsr->{after}{$afterid}{q}})) { accept_out_cclose_after($tkxfsr,$afterid,int(rand(2000))); my $msg=shift @{$tkxfsr->{after}{$afterid}{q}}; print 'LIST '.$msg."\n"; } else { print 'DONE '.$id.' 0'."\n"; delete $tkxfsr->{after}{$afterid}; } }; accept_out_cclose_after($tkxfsr,$afterid,500); my $d_id=Tkx::after( 20000 , sub{$mw->g_destroy}); sub accept_out_cclose_after { my $tkxfsr=shift; my $afterid=shift; my $delay=shift; my $send_id; if ($esub) { $send_id=Tkx::after( $delay , sub{&{$tkxfsr->{after}{$afterid}{sub}}});} else { $send_id=Tkx::after( $delay , $tkxfsr->{after}{$afterid}{sub} ); } $tkxfsr->{after}{$afterid}{eventid}=$send_id; $tkxfsr->{after}{$afterid}{delay}=$delay; } Tkx::MainLoop; if ( $tkxfsr->{after}{$afterid}{sub}) { print 'sub:'.$tkxfsr->{after}{$afterid}{sub}."\n"; }