Commit | Line | Data |
ed5a8a8e |
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; |