Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change

Tying objects

by Alien (Monk)
on Feb 07, 2009 at 20:52 UTC ( [id://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 (Saint) 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
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://742166]
Front-paged by Arunbear
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (3)
As of 2024-06-20 20:14 GMT
Find Nodes?
    Voting Booth?

    No recent polls found

    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.