Thread recv im Hintergrund ausführen (5 answers)
Opened by campbell-bs at 2011-11-30 08:26

topeg
 2011-12-01 11:32
#154585 #154585
User since
2006-07-10
2611 Artikel
BenutzerIn

user image
Wenn es jemanden interessiert. Ein kleines Modul, es erlaubt Befehle in einem extra Prozess zu starten. Zurück gegeben werden kann nur ein String. Ich hab es benutzt um mehre Sockets zu ordentliche handhaben zu können.

more (27.8kb):
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143

package fork_bufferd_read;
use IO::Pipe;
use strict;
use warnings;

my %running=();
$SIG{CHLD}=\&__child_died;

# new instance
# $obj=fork_bufferd_read->new(<code>);
sub new
{
  my $class=shift;
  my $code=shift;

  my $self={};
  $self->{pipe} = undef;
  $self->{pid}  = undef;
  $self->{running}=0;
  $self->{code}=$code;

  return undef unless(_start($self));

  bless($self,$class);
  return $self;
}

# read buffer
# $str=$obj->read();
sub read
{
  my $self=shift;
  my $buffer='';
  if($self->{running})
  {
    my $pipe=$self->{pipe};
    if($pipe->opened())
    {
      kill('USR1',$self->{pid});

      local $/=undef;
      $buffer=<$pipe>;
      $buffer='' unless(defined($buffer));
    }
    else
    { $self->_finish(); }
  }
  return $buffer;
}

sub running { $_[0]->{running}; }

########################################################################
sub DESTROY
{
  my $self=shift;
  $self->_finish();
}

sub _finish
{
  my $self=shift;
  local $SIG{CHLD}='IGNORE';
  if($self->{running})
  {
    kill(15,$self->{pid});
    $self->{running}=0;
    $self->{pipe}=undef;
  }
  delete($running{$self->{pid}}) if($self->{pid});
}

sub _start
{
  my $self=shift;
  return 1 if(defined($self->{pipe}) && $self->{pid} && $self->{running});

  return 0 unless(ref($self->{code}) eq 'CODE');

  my $pipe=IO::Pipe->new();
  return 0 if(!defined($pipe));

  my $pid=fork();
  return 0 if(!defined($pid));

  if($pid)
  {
    $pipe->reader();
    $pipe->blocking(0);

    $self->{pipe} = $pipe;
    $self->{pid}  = $pid;
    $self->{running}=1;
    $running{$pid}=$self;

    return 1;
  }

  $pipe->writer();
  $pipe->autoflush(1);
  __child_process($pipe, $self->{code});
  die("ERROR RUNN CHILD\n");
}

sub __child_died
{
  my $pid=wait();
  if(exists($running{$pid}))
  {
    $running{$pid}->{running}=0;
    $running{$pid}->{pipe}=undef;
    $running{$pid}->{pid}=undef;
    delete($running{$pid});
    return 1;
  }
  return 0;
}

sub __child_process
{
  my $pipe=shift;
  my $code=shift;
  die() unless(ref($code) eq 'CODE');

  local $SIG{CHLD}='IGNORE';
  local $SIG{TERM}=sub{ exit(); };

  my $buffer='';
  local $SIG{USR1}=sub{
      print $pipe $buffer;
      $buffer='';
    };

  while($code->(\$buffer))
  { 1; }

  while(length($buffer)>0)
  { select(undef,undef,undef,0.01); }

  exit();
}

1;


Beispiel:
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

#!/usr/bin/perl
use strict;
use warnings;
use fork_bufferd_read;

my $count=0;
my $fbr=fork_bufferd_read->new(sub{
    my $buf=shift;
    $count++;
    select(undef,undef,undef,0.5);
    $$buf.="$count\t";
    return 0 if($count>35);
    return 1;
  });

die ("NO FORK!\n") unless($fbr);

for(0..10)
{
  sleep 3;
  print "READ $_ :".$fbr->read()."\n";
  unless($fbr->running())
  {
    print "CHILD EXIT!\n";
    last;
  }
}

View full thread recv im Hintergrund ausführen