allow glob references to be transferred

[scpubgit/Object-Remote.git] / lib / Object / Remote / GlobProxy.pm

diff --git a/lib/Object/Remote/GlobProxy.pm b/lib/Object/Remote/GlobProxy.pm
new file mode 100644 (file)
index 0000000..a246fb7
--- /dev/null
+++ b/lib/Object/Remote/GlobProxy.pm
@@ -0,0 +1,37 @@
+use strictures 1;
+
+package Object::Remote::GlobProxy;
+require Tie::Handle;
+our @ISA = qw( Tie::Handle );
+
+sub TIEHANDLE {
+  my ($class, $glob_container) = @_;
+  return bless { container => $glob_container }, $class;
+}
+
+my @_delegate = (
+  [READLINE => sub { wantarray ? $_[0]->getlines : $_[0]->getline }],
+  (map { [uc($_), lc($_)] } qw(
+    write
+    print
+    printf
+    read
+    getc
+    close
+    open
+    binmode
+    eof
+    tell
+    seek
+  )),
+);
+
+for my $delegation (@_delegate) {
+  my ($from, $to) = @$delegation;
+  no strict 'refs';
+  *{join '::', __PACKAGE__, $from} = sub {
+    $_[0]->{container}->$to(@_[1 .. $#_]);
+  };
+}
+
+1;