Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer

Tying objects

by Alien (Monk)
on Feb 07, 2009 at 20:52 UTC ( #742166=perlquestion: print w/replies, xml ) Need Help??
Alien has asked for the wisdom of the Perl Monks concerning the following question:

I have the following class :
package Link; sub FETCH { my $this = shift; return $this->{"site"}; } sub STORE { my ($self,$site) = @_; $self->{"site"} = $site; } sub print_method { my $self = shift; print $self->{"site"}; } sub TIESCALAR { my $class = shift; my $link = shift; my $this = {}; bless($this,$class); $this->{"site"} = $link; return $this; } 1;
and the following code :
use Link; tie my $var,"Link",""; $var = ""; $var->print_method; print $var;
Running the code above results in a runtime error : Can't call method "print_method" without a package or object reference at line 4. . I think I understand why : when fetched , the method returns a string , which doesn't respond to "print_method" . I would like to be able to do the following things : if fetched , print the site's address , if stored , change the address . I would also like to be able to call methods on the object . I am aware that if I return $self from fetch , I will accomplish the "call methods objective" , but that will invalidate the first objective ( fetch ) . Is there a way I could accomplish all of them ?

Replies are listed 'Best First'.
Re: Tying objects
by Arunbear (Prior) on Feb 07, 2009 at 20:59 UTC
    Use tied to get to the actual object that implements the behaviour of $var:
      To elaborate on this, what tie accomplishes is to make Perl pretend that a reference object is something else. That is, it acts here as if $var is a simple scalar, not a reference object. (It's probably easier to see that this must be the case when tieing an array or a hash.)
Re: Tying objects
by shmem (Chancellor) on Feb 08, 2009 at 11:29 UTC

    A tied scalar shadows an object whose class provides methods for creation, assignment and destruction. The tied scalar behaves like a scalar, so you can neither bless it into a package, nor call methods on it (would need to be blessed, first).

    You are pretty out of luck if you want to use the same thingy as a scalar and an object at the same time. Your FETCH would need to know what the fetch is for - not just void/scalar/list context, but look ahead in the opstack to see whether the result it is about to return is for a method deref. I'm sure that can be done somehow (TheDamian, would you like to? ;-), but it probably would involve too much magic...

    Use the object returned by tie to do method calls:

    use Link; my $var_o = tie my $var,"Link",""; $var = ""; $var_o->print_method; print $var;

    Or what Arunbear said.

Re: Tying objects
by Herkum (Parson) on Feb 08, 2009 at 02:59 UTC

    I always thought of tied hashes as poor man's objects. If I had to support this code I would rather the code written as an perl object than an implement via tie.

Re: Tying objects
by pajout (Curate) on Feb 08, 2009 at 09:24 UTC
    Yes, if I undestand you correctly :>) I paste a piece of my code here, which demonstrates the object and tied hash simultaneously.
    package XML::Trivial::Element; use Scalar::Util 'weaken'; use strict; use warnings; sub new { my ($class, $aref, $nsstack) = @_; tie my %h, $class, $aref || [], $nsstack; my $self = bless \%h, $class; my %ehns; my $key; my $s = tied(%$self); foreach (@{$s->{ea}}) { tied(%$_)->{parent} = $self; weaken(tied(%$_)->{parent});#because it is circular ref $key = $_->ns(undef).'*'.$_->ln(); $ehns{$key} = $_ unless exists $ehns{$key}; } $s->{ehns} = \%ehns; return $self; } sub TIEHASH { my ($class, $a, $nsstack) = @_; #$a is arrayref like [name, atts, type1, data1, type2, data2, ...] my @ea; my %eh;#elements my @ta; #texts my @ca; #cdatas my @pa; my %ph;#process instructions my @na; #notes my $firstkey; my $lastkey; my %next; my %nh; #hash of namespaces in scope foreach (@$nsstack) { while (my ($name, $value) = each %$_) { $nh{$name} = $value; } } for (my $i = 0; $i < @$a; $i += 2) { #too much code here } return bless {a=>$a, ea=>\@ea, eh=>\%eh, ta=>\@ta, ca=>\@ca, pa=>\@pa, ph=>\%ph, na=>\@na, nh=>\%nh, parent=>undef, firstkey=>$firstkey, next=>\%next }, $class; } sub FETCH { my ($self, $key) = @_; $key =~ /^\d+$/ and return $$self{ea}[$key]; $key =~ /\*/ and return $$self{ehns}{$key}; return $$self{eh}{$key}; } sub EXISTS { my ($self, $key) = @_; $key =~ /\*/ and return exists $$self{ehns}{$key}; return exists $$self{eh}{$key}; } sub FIRSTKEY { return $$_[0]{firstkey}; } sub NEXTKEY { return $$_[0]{next}{$$_[1]}; } sub SCALAR { return $$_[0]{a}[0]; } #this is object method sub p { #parent my ($self) = @_; return tied(%$self)->{parent}; }
Re: Tying objects
by LanX (Bishop) on Feb 08, 2009 at 13:55 UTC
    As others said, I'd rather preferre a simple object to a tie.

    In your case it (yet) seems sufficient to bless a scalar ref instead of a hash ref. So you can fetch and store your link with $$ dereferencing.

    Of course this doesn't scale well when your object needs more data...

    Then lvalue mutators maybe a handy alternative... but to validate the stored links you need again a tie on the data, see Re: A tale about accessors, lvalues and ties

    #!/usr/bin/perl use strict; use warnings; $\="\n"; { package LinkClass; sub new { my $scalar="link"; my $self=\$scalar; bless $self; return $self; } sub print {print ${$_[0]}} sub url :lvalue { ${$_[0]} } } my $obj=LinkClass->new(); $obj->print(); $$obj="link2"; $obj->print(); $obj->url="link3"; $obj->print(); __END__ link link2 link3

    a completely other approach maybe using a wrapper write(), which calls tied($var)->print_method; like Arunbear suggested.

    write() could be automatically imported with your Linkpackage...

    Cheers Rolf

Re: Tying objects
by dragonchild (Archbishop) on Feb 09, 2009 at 21:24 UTC
    Also, look at DBM::Deep for an example of how to provide tie/object behavior on the same thing.

    My criteria for good software:
    1. Does it work?
    2. Can someone else come in, make a change, and be reasonably certain no bugs were introduced?

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://742166]
Front-paged by Arunbear
[Corion]: A good weekstart to everybody!

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (7)
As of 2018-06-18 08:18 GMT
Find Nodes?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?

    Results (109 votes). Check out past polls.