############################################
# HASBUF MOD - READ HANDLE CHECKING BUFFER #
############################################

  my (%HASBUF_READ_open , %HASBUF_head_pos , %HASBUF_head_ID) ;

##########
# HASBUF #
##########

sub HASBUF {
  my $ret_type = 1 ; if ( $_[2] =~ /^io$/i  ) { $ret_type = 2 ; pop (@
+_) ;}
  my ( $head_io , $head_fd , $time ) = @_ ;
  if ( $#_ < 0 ) { return( undef ) ;}
  
  if ( ref($head_io) !~ /glob/i ) { $head_io = \*$head_io ;}
  if ( ref($head_fd) eq '' && $head_fd !~ /^\d+$/ ) { $head_fd = filen
+o($head_fd) ;}
  
  if ( $#_ < 2 ) {
    $head_fd = fileno($head_io) ;
    if ( $_[1] =~ /^\d+$/ ) { $time = $_[1] ;}
  }
  
  if    ( $time < 0.01 ) { $time = 0.01 ;}
  elsif ( $time > 10 ) { $time = 10 ;}
  
  #############
  # CHK ERROR #
  #############

  my $ID = "$head_fd$head_io" ;
  my $head_pos = tell($head_io) ;
  $HASBUF_head_pos{$ID} += $head_pos ;
  if ( $head_pos == 0 && $HASBUF_head_pos{$ID} > 0) { $HASBUF_head_ID{
+$ID} = 'ERROR' ;}
  
  ###########
  # CHK BUF #
  ###########
  
  my $bits ;
  if ( $head_fd < 0 ) { return( undef ) ;}
  vec($bits,$head_fd,1) = 1 ;
  my $hasbuf = select($bits,undef,undef,$time) ;
  
  ###########
  # CHK EOF #
  ###########
  
  my ($val_pos,$val_buf) = (0,0) ;
  if ($head_pos < 0) { $val_pos = -1 ;} elsif ($head_pos > 0) { $val_p
+os = 1 ;}
  if ($hasbuf   < 0) { $val_buf = -1 ;} elsif ($hasbuf   > 0) { $val_b
+uf = 1 ;}  
  my $head_eof ;
  if ( "$val_pos$val_buf" eq '11' && $HASBUF_head_ID{$ID} ne 'ERROR') 
+{ $head_eof = eof($head_io) ;}
  if ( $head_eof == 1 ) { $HASBUF_head_ID{$ID} = 'ERROR' ;}
  
  ##########
  # RETURN #
  ##########
  
  my $buf_stat = 0 ;
  if ( $val_buf > 0 && $HASBUF_head_ID{$ID} ne 'ERROR') { $buf_stat = 
+1 ;}
  if ( $ret_type == 1 ) {
    if ( $buf_stat ) { return( 1 ) ;}
    if ( $val_buf > 0 ) { return( 'closed' ) ;}
  }
  elsif ( $ret_type == 2 && $buf_stat ) { return( $head_io ) ;}
  return( undef ) ;
}

###############
# HASBUF_READ #
###############

sub HASBUF_READ {
  my ( $io , $time , $read , $cmd ) = @_ ;
  my ($buffer,$n) ;
  my $ID = join ("#", fileno($io) , @_[0..2]) ;
  
  my $rd_line = 0 ;
  if ( $read =~ /^(li?n?e?|<\w*>)$/i ) { $rd_line = 1 ;}
  else { $read =~ s/\D//g ;}
  
  if ( ref($cmd) =~ /CODE/i) { eval(q` \$cmd = \&$cmd ;`) ;}
  elsif ( $cmd =~ /^\\?&?\w+/ ) { $cmd =~ s/^\\?&//g ; eval(q` \$cmd =
+ &{$cmd} ;`) ;}
  $_ = '' ;

  if (! $HASBUF_READ_open{$ID}) { $HASBUF_READ_open{$ID} = 1 ;}
  if ( &HASBUF($io,$time) ) {
    if ( $rd_line == 1 ) { $buffer = <$io> ; $n = length($buffer) ;}
    elsif ($read > 1) { for(1..$read) { $n = sysread($io,$buffer,$read
+, length($buffer) ) ;}  }
    else { $n = sysread($io,$buffer,1) ;}
    $HASBUF_READ_open{$ID} = $n ;
    if ($HASBUF_READ_open{$ID} >= 1) {
      $_ = $buffer ;
      if ($buffer eq '0') { return(1) ;}
      return( $buffer ) ;
    }
    else { delete($HASBUF_READ_open{$ID}) ; return( undef ) ;}
  }
  else {
    if ( $cmd ) {
      eval(q`&{$cmd}()`) ;    
    }
    return( 1 ) ;
  }
}

#######
# END #
#######

1;

### EXAMPLES:

  ...

  if ( &HASBUF($sock , 1) ) {
    $line = <$sock> ;
  }
  
  ...
  
  while( &HASBUF_READ($sock,1,'line',\&cmd) ) {
    if ( $_ ne '' ) { print $_ ;}
    else { ... }
  }
  
  sub cmd {
    ...
  }
[download]

Edit by tye

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.