Thread Zugriff auf laufendes Perl-Skript (10 answers)
Opened by kami at 2011-02-15 08:42

topeg
 2011-02-15 14:38
#145674 #145674
User since
2006-07-10
2611 Artikel
BenutzerIn

user image
FiFos (Named Pipes) sind eine der einfachen Wege um eine Kommunikation zwischen verschiedenen unabhängigen Prozessen zu ermöglichen. Sie sind so was wie erweiterte Pipes. Es wird eine spezielle Datei angelegt, in die von mehreren Prozessen geschrieben und von der Gelesen werden kann. Der Inhalt wird nur vom BS gepuffert und nicht gespeichert.

Leider hat das ganze ein paar Fußangeln über die man Bescheid wissen sollte. Ich hatte mir ein kleines Modul geschrieben um nicht immer wieder die selben Probleme zu haben.

Dieses Modul erzeugt ein FiFo und erlaubt den nicht blockierenden Zugriff darauf. In der jetzigen Form ist nur der lesende Zugriff implementiert und Möglicherweise funktioniert es unter Windows nicht.

more (25.6kb):
Modul: Tools/IO/FiFo.pm
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
144
145
146
147
148

package Tools::IO::FiFo;
use POSIX;
use IO::Select;
use strict;
use warnings;

# create new fifo handler
sub new
{
  my $class=shift;
  my $file=shift;

  my $self={};
  $self->{file}=$file;

  bless($self,$class);
}

sub DESTROY{ shift()->close(); }

# open pipe
sub open
{
  my $self=shift;
  my $pid = open(my $ch, "-|");

  __child($self->{file}) if($pid==0);

  return undef unless($pid);

  $self->{child_pid}=$pid;
  $self->{child_fh}=$ch;
  $self->{child_sel}=IO::Select->new($ch);
}

# close pipe
sub close
{
  my $self=shift;
  delete($self->{child_sel});

  unlink($self->{file});

  if($self->{child_pid} && kill(0,$self->{child_pid}))
  {
    kill(10,$self->{child_pid});
    waitpid($self->{child_pid},0);
  }

  close($self->{child_fh}) if($self->{child_fh});
  delete($self->{child_fh});

  delete($self->{child_pid});
}

# read pipe
sub read
{
  my $self=shift;
  my $nonblock=shift;
  $nonblock=1 unless(defined($nonblock));

  my $data='';

  if($self->{child_pid} && kill(0,$self->{child_pid}))
  {
    if($nonblock)
    {
      my $buf='';
      $data.=$buf  while(
            $self->{child_fh} &&
            $self->{child_sel}->can_read(0) &&
            sysread($self->{child_fh},$buf,1024)
        );
    }
    else
    {
      my $f=$self->{child_fh};
      $data=<$f>;
    }
  }

  return $data;
}

# handle fifo in childprocess
# fifos (named pipes) are special.
#
# A nonblocking read (sysopen fifo file with "O_NONBLOCK") is not possible on all platforms.
# It will crash the writing process, because the fifo is closed to early from the reading process
#
# Most systems also wait on "open" when a fifo is used not at "read".
# so an "alarm" handler has to be installed there to get an eventloop
# but alarm can only take seconds and that's to slow.
sub __child
{
  my $file=shift;

  exit(0) if(-p $file);

  # fifo erzeugen
  POSIX::mkfifo($file, 0666) or exit(0);

  my $do_exit=sub{
      CORE::close(STDOUT);
      unlink($file);
      exit(0);
    };

  # Signale verbinden
  # SIGTERM (15)
  $SIG{TERM}=$do_exit;
  # SIGUSR1 (10)
  $SIG{USR1}=$do_exit;

  my $sel=IO::Select->new(\*STDOUT);

  while(-p $file)
  {

    # STDOUT closed?
    $do_exit->() unless ($sel->can_write(0));

    eval{
      local $SIG{ALRM}=sub{die()};

      # open and wait for input
      alarm(1);
      CORE::open(my $fh, '<', $file);

      # read
      alarm(1);
      print <$fh>;

      alarm(0);
      CORE::close($fh);

      # wait vor 1/5 second
      # slow systems need some time for clean up.
      select(undef,undef,undef,0.2);
    };

  }
  $do_exit->();
  exit(0);
}

1;


Anwendungsbeispiel:
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

#!/usr/bin/perl
use strict;
use warnings;
use Tools::IO::FiFo;

my $file='test.fifo';

# neues FiFo Objekt
my $fifo=Tools::IO::FiFo->new($file);

# fifo öffnen
$fifo->open() or die("ERROR create fifo $file ($!)\n");

my $cnt=0;
while(1)
{
  # print Counter
  print $cnt++,"\n";

  # read fifo
  my $txt=$fifo->read();

  # wenn text empfangen
  if($txt)
  {
    print "$txt\n";

    # hier exit wenn String "quit" auftaucht
    last if($txt=~/quit/);
  }

  # alles andere...
  read_serial();
}

# fifo schießen
$fifo->close();

exit();

########################################################################

sub read_serial
{
  # dummy ...
  sleep(1);
}


EDIT:
Das schreiben in die FiFo bei dem Beispiel kann so erfolgen:
Code: (dl )
echo "quit" > test.fifo

Last edited: 2011-02-15 15:04:19 +0100 (CET)

View full thread Zugriff auf laufendes Perl-Skript