lib/Object/Remote/GlobProxy.pm

   1 use strictures 1;
   2
   3 package Object::Remote::GlobProxy;
   4 require Tie::Handle;
   5 our @ISA = qw( Tie::Handle );
   6
   7 sub TIEHANDLE {
   8   my ($class, $glob_container) = @_;
   9   return bless { container => $glob_container }, $class;
  10 }
  11
  12 my @_delegate = (
  13   [READLINE => sub { wantarray ? $_[0]->getlines : $_[0]->getline }],
  14   (map { [uc($_), lc($_)] } qw(
  15     write
  16     print
  17     printf
  18     read
  19     getc
  20     close
  21     open
  22     binmode
  23     eof
  24     tell
  25     seek
  26   )),
  27 );
  28
  29 for my $delegation (@_delegate) {
  30   my ($from, $to) = @$delegation;
  31   no strict 'refs';
  32   *{join '::', __PACKAGE__, $from} = sub {
  33     $_[0]->{container}->$to(@_[1 .. $#_]);
  34   };
  35 }
  36
  37 1;