Wishlist: tieing an object

[p5pRT]

Migrated from rt.perl.org#9740 (status was 'resolved')

Searchable as RT9740$

[p5pRT]

From Nikolaus@rath.org

Created by Nikolaus@rath.org

Hello.

I would love to tie a filehandle to an *existing* object\, i.e. give tie the object instead of the (class|package) name as second parameter.

Use​: Backing up tied objects​:

  my $tied = tied *STDOUT;   tie *STDOUT\, "myfilter";   call_other_module_that_prints_to_stdout();   untie *STDOUT;   tie *STDOUT\, $tied;  
Yes\, i could use local for this​:

  {   local(*STDOUT);   tie *STDOUT\, "myfilter";   call_other_module_that_prints_to_stdout();   }

But not in this case (mod_perl handler)​:

# Implement a filter sub handler($$) {   my($class\, $r) = @​_;   my($output);

  # Save previous handler\, we can't use local because   # the handler routine doesn't know witch other routine   # has to be called. Therefore handler() *must* return.   $output = tied *STDOUT;   tie *STDOUT\, $class\, $r\, $output; }

# Make filter object sub TIEHANDLE {   my $class = ref $_->[0] ? ref shift : shift;   return bless { "r" => shift\,   "output" => shift }\, $class; }

# Receive input and prepare output to previous # handler sub PRINT {   my $this = shift;   local(*STDOUT);   # Doesn't work\, because we can't tie to an existing object   tie *STDOUT\, $this->{output};   $this->filter(@​_); }

# Do filtering\, this method should be overridden # by inherited classes sub filter {   return @​_; }

I would be pleased if someone could comment my wish.  
bye Nikolaus

Perl Info

``` Flags: category=core severity=wishlist Site configuration information for perl v5.6.1: Configured by bod at Fri Jan 11 04:14:18 EST 2002. Summary of my perl5 (revision 5.0 version 6 subversion 1) configuration: Platform: osname=linux, osvers=2.4.13, archname=i386-linux uname='linux duende 2.4.13 #1 wed oct 31 19:18:07 est 2001 i686 unknown ' config_args='-Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=i386-linux -Dprefix=/usr -Dprivlib=/usr/share/perl/5.6.1 -Darchlib=/usr/lib/perl/5.6.1 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.6.1 -Dsitearch=/usr/local/lib/perl/5.6.1 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Uusesfio -Duseshrplib -Dlibperl=libperl.so.5.6.1 -Dd_dosuid -des' hint=recommended, useposix=true, d_sigaction=define usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef useperlio=undef d_sfio=undef uselargefiles=define usesocks=undef use64bitint=undef use64bitall=undef uselongdouble=undef Compiler: cc='cc', ccflags ='-DDEBIAN -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64', optimize='-O2', cppflags='-DDEBIAN -fno-strict-aliasing -I/usr/local/include' ccversion='', gccversion='2.95.4 (Debian prerelease)', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 alignbytes=4, usemymalloc=n, prototype=define Linker and Libraries: ld='cc', ldflags =' -L/usr/local/lib' libpth=/usr/local/lib /lib /usr/lib libs=-lgdbm -ldb -ldl -lm -lc -lcrypt perllibs=-ldl -lm -lc -lcrypt libc=/lib/libc-2.2.4.so, so=so, useshrplib=true, libperl=libperl.so.5.6.1 Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic' cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib' Locally applied patches: @INC for perl v5.6.1: /usr/local/lib/perl/5.6.1 /usr/local/share/perl/5.6.1 /usr/lib/perl5 /usr/share/perl5 /usr/lib/perl/5.6.1 /usr/share/perl/5.6.1 /usr/local/lib/site_perl . Environment for perl v5.6.1: HOME=/home/nikratio LANG=C LANGUAGE (unset) LC_ADDRESS=de_DE@euro LC_COLLATE=de_DE@euro LC_CTYPE=de_DE@euro LC_MEASUREMENT=de_DE@euro LC_MONETARY=de_DE@euro LC_NAME=de_DE@euro LC_PAPER=de_DE@euro LC_TELEPHONE=de_DE@euro LC_TIME=de_DE@euro LD_LIBRARY_PATH=/usr/opt/j2sdk1.4.0/jre/lib/i386/client:/usr/opt/j2sdk1.4.0/jre/lib/i386 LOGDIR (unset) PATH=~/bin:~/scripts:/usr/local/jdk1.3/bin:/usr/local/bin:/usr/bin:/bin:/usr/bin/X11:/usr/games PERL_BADLANG (unset) SHELL=/bin/bash ```

[p5pRT]

From @mjdominus

----------------------------------------------------------------- [Please enter your report here]

Hello.

I would love to tie a filehandle to an *existing* object\, i.e. give tie the object instead of the (class|package) name as second parameter.

Your wish is granted!

Do this​:

  sub UniversalTie​::TIEHANDLE { $_[0] }

  tie *HANDLE\, 'UniversalTIE'\, $any_object;

HANDLE is now tied to $any_object.

tied(HANDLE) will return $any_object.

print HANDLE "Hello" will call $any_object->PRINT("Hello").

[p5pRT]

From [Unknown Contact. See original ticket]

Nikolaus Rath asked

I would love to tie a filehandle to an *existing* object\, i.e. give tie the object instead of the (class|package) name as second parameter.

and Mark-Jason Dominus replied on 24 June 2002 17​:17

Your wish is granted!

Do this​:

    sub UniversalTie​::TIEHANDLE \{ $\_\[0\] \}

    tie \*HANDLE\, 'UniversalTIE'\, $any\_object;

HANDLE is now tied to $any_object.

tied(HANDLE) will return $any_object.

print HANDLE "Hello" will call $any_object->PRINT("Hello").

This is an interesting idea (I had no idea it was possible\, thank you). But the code above is a touch minimal (and slightly buggy ;-)

I threw together the following as a slighting more complete example​:

package ObjTie; use strict;

sub TIEHANDLE { my $self=shift;   return $self if ref $self;   return $self->new();   } sub new {   my $class=shift;   bless {}\,$class; }

sub PRINT {   my $self=shift;   print "You printed with $self​:".join($\,||""\,@​_).($\||""); } 1; package main; use strict; my $foo=ObjTie->new();

tie *FOO\, $foo; # Tie to $foo tie *BAR\, 'ObjTie'; # Tie to a new ObjTie object

print FOO "Hello there\n"; print BAR "And again\n"; __END__

Anyway\, an illuminating question and answer thanks a lot both of you.

Yves / Demerphq

_________________________________________________________________ Send and receive Hotmail on your mobile device​: http​://mobile.msn.com

[p5pRT]

From @mjdominus

But the code above is a touch minimal

That is an advantage\, not a disadvantage.

(and slightly buggy ;-)

Yes\, my error. The $_[0] should have been a $_[1].
What a pity you did not say what the error was.

I threw together the following as a slighting more complete example​:

I think this really misses the point of what I was trying to do\, and adds a bunch of extra machinery for no useful purpose. Here's the example I would have used​:

================================================================

# Suppose that this class is pre-existing\, perhaps loaded by "use AppendHandle;". # It could do anything at all; its internals are completely unimportant. package IndentedHandle;

sub TIEHANDLE {   my $class = shift;   bless {} => $class; }

sub PRINT {   my $self = shift;   my $text = shift;   print "-----> "\, $text; }

# Example program begins here package main;

sub UniversalTie​::TIEHANDLE { $_[1] } # not $_[0]

$object = tie *A\, 'IndentedHandle'; tie *B\, 'UniversalTie'\, $object;

# *B and *A are now tied to the exact same object print B "I like pie\n"; # So this calls IndentedHandle​::PRINT

exit;

[p5pRT]

From [Unknown Contact. See original ticket]

Mark-Jason Dominus justifiably chastised Yves Orton on 24 June 2002 18​:50

But the code above is a touch minimal

That is an advantage\, not a disadvantage.

Ah\, but it makes it a touch harder for us mere mortals to grok it immediately. :-)

(and slightly buggy ;-)

Yes\, my error. The $_[0] should have been a $_[1]. What a pity you did not say what the error was.

Actually\, I assumed that was intentional\, hence the way I misapplied your idea. The mistake was a slight one indeed. In the call to tie() you spelt it 'UniversalTIE'\, but the sub was in the package 'UniversalTie'. As i said (with a happy face too)\, a tiny error.

I threw together the following as a slighting more complete example​:

I think this really misses the point of what I was trying to do\,

And I agree wholeheartedly. Thank you for the clarification. I was impressed with the idea the first time\, and now even more so. I thought that you were just pointing out that TIEHANDLE need not be passed a class name\, but an object instead. I didnt realize you were making a more generally useful tool.

and adds a bunch of extra machinery for no useful purpose. Here's the example I would have used​:

Which is very cool. Some of us on PM were discussing this. Maybe you should post a meditation. No doubt it would be well recieved.

================================================================

# Suppose that this class is pre-existing\, perhaps loaded by "use AppendHandle;". # It could do anything at all; its internals are completely unimportant. package IndentedHandle;

sub TIEHANDLE { my $class = shift; bless {} => $class; }

sub PRINT { my $self = shift; my $text = shift; print "-----> "\, $text; }

# Example program begins here package main;

sub UniversalTie​::TIEHANDLE { $_[1] } # not $_[0]

$object = tie *A\, 'IndentedHandle'; tie *B\, 'UniversalTie'\, $object;

# *B and *A are now tied to the exact same object print B "I like pie\n"; # So this calls IndentedHandle​::PRINT

exit;

A much better example\, and as I said\, a very cool idea. Thank you. [Dominus]++

Yves / Demerphq ps (If I offended you\, let me assure you that I did not mean to.)

_________________________________________________________________ MSN Photos is the easiest way to share and print your photos​: http​://photos.msn.com/support/worldwide.aspx

[p5pRT]

From @mjdominus

Mark-Jason Dominus justifiably chastised Yves Orton on 24 June 2002 18​:50

But the code above is a touch minimal

That is an advantage\, not a disadvantage.

Ah\, but it makes it a touch harder for us mere mortals to grok it immediately. :-)

Making two errors in one line of code also makes it hard for mere mortals to understand. My apologies to both you and Nikolaus.

Thank you for the clarification.

Likewise.

ps (If I offended you\, let me assure you that I did not mean to.)

If I appeared in any way offended\, let me assure you that I did not mean to.

Thanks\,

-D.

[p5pRT]

p5p@spam.wizbit.be - Status changed from 'open' to 'resolved'