/usr/lib/perl5/Tk/Event/IO.pm is in perl-tk 1:804.031-1build1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | package Tk::Event::IO;
use strict;
use Carp;
use vars qw($VERSION @EXPORT_OK);
$VERSION = '4.009'; # sprintf '4.%03d', q$Revision: #8 $ =~ /\D(\d+)\s*$/;
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);
unless ($obj && $obj->isa('Tk::Event::IO'))
{
$obj = tie *$file,'Tk::Event::IO', $file;
}
if (@_ == 3)
{
# query return the handler
return $obj->handler($imode);
}
else
{
# set the handler
my $h = $obj->handler($imode,$cb);
undef $obj; # Prevent warnings about untie with ref to object
unless ($h)
{
untie *$file;
}
}
}
1;
__END__
|