Blame t/lib/TieLC.pm

Packit d18d0a
package TieLC;
Packit d18d0a
Packit d18d0a
sub TIEHANDLE 
Packit d18d0a
{
Packit d18d0a
 my $class = shift;
Packit d18d0a
 my $fh    = \do { local *HANDLE};
Packit d18d0a
 bless $fh,$class;
Packit d18d0a
 $fh->OPEN(@_) if (@_);
Packit d18d0a
 $fh->BINMODE(':utf8');
Packit d18d0a
 return $fh;
Packit d18d0a
}
Packit d18d0a
Packit d18d0a
sub EOF     { eof($_[0]) }
Packit d18d0a
sub TELL    { tell($_[0]) }
Packit d18d0a
sub FILENO  { fileno($_[0]) }
Packit d18d0a
sub SEEK    { seek($_[0],$_[1],$_[2]) }
Packit d18d0a
sub CLOSE   { close($_[0]) }
Packit d18d0a
sub BINMODE { binmode($_[0],$_[1]) }
Packit d18d0a
Packit d18d0a
sub OPEN
Packit d18d0a
{
Packit d18d0a
 $_[0]->CLOSE if defined($_[0]->FILENO);
Packit d18d0a
 @_ == 2 ? open($_[0], $_[1]) : open($_[0], $_[1], $_[2]);
Packit d18d0a
}
Packit d18d0a
Packit d18d0a
sub READ     { read($_[0],$_[1],$_[2]) }
Packit d18d0a
sub READLINE { "hello world\n" }
Packit d18d0a
sub GETC     { getc($_[0]) }
Packit d18d0a
Packit d18d0a
sub WRITE
Packit d18d0a
{
Packit d18d0a
 my $fh = $_[0];
Packit d18d0a
 print $fh substr($_[1],0,$_[2])
Packit d18d0a
}
Packit d18d0a
Packit d18d0a
sub PRINT {
Packit d18d0a
  my ($self, @what) = @_;
Packit d18d0a
  my $buf = lc join('', @what);
Packit d18d0a
  $self->WRITE($buf, length($buf), 0);
Packit d18d0a
}
Packit d18d0a
Packit d18d0a
sub UNTIE { 1 }; # suppress warnings about references
Packit d18d0a
Packit d18d0a
1;