Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / Tk / Event / IO.pm

package Tk::Event::IO;

use vars qw($VERSION @EXPORT_OK);
$VERSION = '3.036'; # $Id: //depot/Tk8/Event/Event/IO.pm#12 $ +24

use base qw(Exporter);
use Symbol ();

@EXPORT_OK = qw(READABLE WRITABLE);

sub PrintArgs
{
my $func = (caller(1))[3];
print "$func(",join(',',@_),")\n";
}

sub PRINT
{
my $obj = shift;
$obj->wait(WRITABLE);
my $h = $obj->handle;
return print $h @_;
}

sub PRINTF
{
my $obj = shift;
$obj->wait(WRITABLE);
my $h = $obj->handle;
return printf $h @_;
}

sub WRITE
{
my $obj = $_[0];
$obj->wait(WRITABLE);
return syswrite($obj->handle,$_[1],$_[2]);
}

my $depth = 0;
sub READLINE
{
my $obj = shift;
$obj->wait(READABLE);
my $h = $obj->handle;
my $w = <$h>;
return $w;
}

sub READ
{
my $obj = $_[0];
$obj->wait(READABLE);
my $h = $obj->handle;
return sysread($h,$_[1],$_[2],defined $_[3] ? $_[3] : 0);
}

sub GETC
{
my $obj = $_[0];
$obj->wait(READABLE);
my $h = $obj->handle;
return getc($h);
}

sub CLOSE
{
my $obj = shift;
$obj->unwatch;
my $h = $obj->handle;
return close($h);
}

sub EOF
{
my $obj = shift;
my $h = $obj->handle;
return eof($h);
}

sub FILENO
{
my $obj = shift;
my $h = $obj->handle;
return fileno($h);
}

sub imode
{
my $mode = shift;
my $imode = ${{'readable' => READABLE(),
               'writable' => WRITABLE()}}{$mode};
croak("Invalid handler type '$mode'") unless (defined $imode);
return $imode;
}

sub fileevent
{
my ($widget,$file,$mode,$cb) = @_;
my $imode = imode($mode);
unless (ref $file)
 {
  no strict 'refs';
  $file = Symbol::qualify($file,(caller)[0]);
  $file = \*{$file};
 }
my $obj = tied(*$file);
$obj = tie *$file,'Tk::Event::IO', $file unless $obj && $obj->isa('Tk::Event::IO');
if (@_ == 3)
 {
  return $obj->handler($imode);
 }
else
 {
  my $h = $obj->handler($imode,$cb);
  undef $obj;
  untie *$file unless $h;
 }
}

1;
__END__