[Vienna-pm] Nicht erlaubter seek ??

Carl A. Schreiber gooly at gmx.at
Mon May 23 08:03:07 PDT 2005


Hallo Armin,

> > so funktioniert's erst einmal, jetzt muss ich noch hinkriegen, dass ich
> > non_blocking vom $reader lesen kann, aber jetzt kommt  schon mal 'was an!
>
> schau dir IO::Select an. ansosnten musst du mit sysopen/sysread arbeiten.

Ich hab's so (siehe unten) hingekriegt (ohne sysopen, sysread ;-) 
  -  Was meinst Du dazu?
Es zeigt auch die Seek-Warning (jedenfalls bei mir).
>
> > Übrigens die (warn-) Melduung: nicht erlaubter Seek beim Schreiben auf
> > dem $writer wird weiterhin produziert.
>
> komisch. perl version? os?
SuSe 9.2 (inkl updates) Perl 5.8.3-32.4
>
> Ciao,
> 	Armin
> --
> armin at xos.net                        pgp public key on request        CU

#!/usr/bin/perl -w
use strict;


  use IO::Handle;
  my ($readPIPE,$writePIPE, $pid);
  pipe $readPIPE, $writePIPE;
  $writePIPE->autoflush(1);
  $pid = fork;

  if ( !$pid ) {   # child
    close($writePIPE);
    nonBlockingRead( $readPIPE );
    exit;
  } else { # parent
      close($readPIPE);
      my ($n,$s) = (0,0);
      while (1) {
        $s = (int(rand( 5 )));
        sleep $s;
        my $err = print $writePIPE "Dad: line ",++$n," after sleep $s sec\n";
	print "Error: $!\n" if $err; # das sollte den seek-Error zeigen
      }
  }

sub nonBlockingRead {
    use IO::Select;
    my $PIPE = ( shift );
    my $SEL = IO::Select->new( $PIPE );
	 my ($sleep, $send) = (10,0);
    my @LINES = qw ( ini deafault array size );
    IO::Handle->new_from_fd(fileno( $PIPE ),"r")->blocking(0);

    while ( $SEL->exists( $PIPE ) ) {
      ($sleep,$send) = doWait( $sleep, scalar @LINES );
      @LINES = ();
      foreach my $h ( $SEL->can_read(0) ) {
        push @LINES, ( <$h> );
      }
      foreach my $l ( @LINES ) {
        &doSomething( $l );
      }
    }
}
sub doSomething { print shift; }
sub doWait {
    my $sec = (shift);
    my $NoL = (shift); #: every whole min
    $sec = ($NoL>20)?($sec/2):(($NoL< 5)?($sec+1):$sec);
    my $m = 60 - (time%60);
    if ( ( $m - $sec/2 ) < $sec ) {
      sleep ($m-0.2);
      return ($sec, 1); # ok full Min
    } else {
      sleep ($sec);
      return ($sec, 0); # default
    }
  }


More information about the Vienna-pm mailing list