Beefy Boxes and Bandwidth Generously Provided by pair Networks Joe
Just another Perl shrine
 
PerlMonks  

(my?) problem with re-blessed references(?)

by BrowserUk (Pope)
on Dec 13, 2002 at 05:13 UTC ( #219502=perlquestion: print w/ replies, xml ) Need Help??
BrowserUk has asked for the wisdom of the Perl Monks concerning the following question:

Recently Abigail-II posted his adaption of the Quote class that jreades used as the basis of his Tutorial: Introduction to Object-Oriented Programming. In an attempt to understand Abigail-II's methodology and fruiture's concerns with it, I put together the following version, of the base class and a simple subclass of it. I also incorporated some ideas of my own.

Unfortunately I've come unstuck with inheritance aspect. The class and subclass work for a single instance, but I'm having problems once I try to create multiple instance. This is that second and subsequent instanciations are overwriting the data ove the first instance, so that after creating 10 instances, despite them all having different object handles, they all return the data of the last instance created?

I think the problem is to do with the re-blessing of the superclass instance handle in the subclass, but I am not wise enough in the ways of Perl OO mechanisms to understand what I am doing wrong?

Sorry for the size/seperate parts but I've kept it as simple as I can and show the problem. Any pointers much appreciated.

The base class Quote.pm

package Quote; use strict; use warnings; use Data::Dumper; use Carp qw/clue cluck/; my (%phrase, %author, %approved); sub new { my ($class, $args) = @_; my $self; $self = bless \$self, ref $class || $class; if (ref $args eq "HASH") { $self->phrase() = $args->{phrase} if exists $args->{p +hrase}; $self->author() = $args->{author} if exists $args->{a +uthor}; $self->is_approved() = $args->{approved} if exists $args->{a +pproved}; } clue "$self"; $self; } sub phrase : lvalue { $phrase{shift}; } sub author : lvalue { $author{shift}; } sub is_approved : lvalue { $approved{shift}; } sub DESTROY { my $self = shift; delete $phrase{$self}; delete $author{$self}; delete $approved{$self}; } 1;

The subclass QuotePlus.pm

package QuotePlus; use Quote; @ISA = qw/Quote/; use strict; use warnings; use Data::Dumper; use Carp qw/clue/; my(%date); sub new { my ($class, $args) = @_; my $self = new Quote( $args ); $self = bless \$self, ref $class || $class; clue "$self"; if (ref $args eq "HASH") { $self->date() = $args->{date} if exists $args->{date}; clue $self->date(); } return $self; } sub date : lvalue { $date{shift}; } sub DESTROY { clue "@_"; my $self = shift; delete $date{$self}; #$self->SUPER::DESTROY(); } 1;

A test program quote.pl

#! perl -slw use strict; use Data::Dumper; use Carp qw/clue/; use QuotePlus; $::debug = 0; my $quote = new QuotePlus ({ phrase=>"It's a good day to die!", author=>"Kahless", approved=>1, date=>"25530", }); printf "%8s said: '%s'; circa. %.f\n", $quote->author(), $quote->phrase(), $quote->date(); $quote->date() = 2500; $quote->author() = "Kahless is reputed to have"; printf "%8s said: '%s'; circa. %.f\n", $quote->author(), $quote->phrase(), $quote->date(); my @quotes; while (<DATA>) { chomp; my ($when, $who, $what) = split/\t/; clue "$when, $who, $what"; push @quotes, new QuotePlus ({ phrase=>$what, author=>$who, approved=>1, date=>$when, }); clue $quotes[-1]; } close DATA; my $i=0; for my $quote (@quotes) { clue $quote; next unless $quote->is_approved; printf "Quote %2d - %8s said: '%s'; circa. %.f\n", $i++, $quote->author(), $quote->phrase(), $quote->date(); } printf "%8s said: '%s'; circa. %.f\n", $quote->author(), $quote->phrase(), $quote->date(); __DATA__ 26584.2 Kahless It's a good day to die! 26593.7 Kahless May your blood scream. 26601.1 Kahless May your enemies run with fear. 26603.2 Kahless Celebrate!? Tomorrow we may die! 26611.4 Kahless May you die before you are captured. 26653.9 Kahless May you always find a Bloodworm in your glass. 26658.3 Kahless May your co-ordinants be free of Tribbles. 26671.2 Kahless May you die in battle. 26671.3 Kahless May you die well. 26777.7 Kahless May you endure the pain. 26821.2 Kahless Klingons forever! 26822.1 Kahless We are KLINGONS! 26888.2 Kahless Qapla`!

The output

C:\test>quote Kahless said: 'It's a good day to die!'; circa. 25530 Kahless is reputed to have said: 'It's a good day to die!'; circa. 250 +0 Quote 0 - Kahless said: 'Qapla`!'; circa. 26888 Quote 1 - Kahless said: 'Qapla`!'; circa. 26888 Quote 2 - Kahless said: 'Qapla`!'; circa. 26888 Quote 3 - Kahless said: 'Qapla`!'; circa. 26888 Quote 4 - Kahless said: 'Qapla`!'; circa. 26888 Quote 5 - Kahless said: 'Qapla`!'; circa. 26888 Quote 6 - Kahless said: 'Qapla`!'; circa. 26888 Quote 7 - Kahless said: 'Qapla`!'; circa. 26888 Quote 8 - Kahless said: 'Qapla`!'; circa. 26888 Quote 9 - Kahless said: 'Qapla`!'; circa. 26888 Quote 10 - Kahless said: 'Qapla`!'; circa. 26888 Quote 11 - Kahless said: 'Qapla`!'; circa. 26888 Quote 12 - Kahless said: 'Qapla`!'; circa. 26888 Kahless said: 'Qapla`!'; circa. 26888 C:\test>

Thanks. BrowserUk.


Examine what is said, not who speaks.

Comment on (my?) problem with re-blessed references(?)
Select or Download Code
Re: (my?) problem with re-blessed references(?)
by runrig (Abbot) on Dec 13, 2002 at 05:46 UTC
    I wonder if you'd be better off initializing attributes in the constructor like this instead:
    if (ref $args eq "HASH") { while(my ($method, $value) = each %$args) { if (my $func = $self->can($method)) { $func->($self, $value); # Update: I think in this case (after # consulting in CB and in the docs # regarding lvalue subs) it should be: # $func->($self) = $value } } }
    It seems much more maintainable and inheritable this way. I also wonder about the need for a "new" method (i.e. constructor) in the QuotePlus class. It seems like it should just be inherited from the Quote class.

      Nice. I looked for a way to do that but I've never used can so didn't think of that. I had to change it slightly to

      $func->($self) = $value; to accomodate the lvalue accessor/mutators but it seems to work fine.

      It does however make something change in as much as in now only get three lines of output, which suggests that the loop pushing instances is now empty, which is strange as I haven't edited that file at all, but I'll try and work out what else changed tomorrow, for now its time to sleep.

      Your probably right that the is no real purpose to QuotePlus except to explore the inheritance mechanism. If I just moved the data attribute into the Quote class, the problem goes away, but that defeats the purpose of my exploration :^).

      Thanks a lot for your help. BrowserUk.


      Examine what is said, not who speaks.

      It would be better written $self->$func($value), where $func in this case is one of those ambiguous methods that is both accessor and mutator, like:

      sub confoosing { my ($self, $arg) = @_; return $arg ? $self->{confoosing} = $arg : $self->confoosing; }

      Your suggested rewrite of the constructor is generic enough to be entirely inheritable, obviating the need for QuotePlus::new, although this method kinda chaps my hide since I like to have a predetermined list of acceptable parameters for each constructor, even those in an inheritance chain. Doing it this way is convenient, except when it comes time for argument checking. I'm also still addicted to Java-style constructor chaining, although generally now I accomplish that by separating instantiation from initialization.

      Cf. inheritance: constructors

      Once any behavior is added, the simple use of can to test for attributes is no longer robust. For instance these classes beg for a display method.
        Once any behavior is added, the simple use of can to test for attributes is no longer robust.

        You're right and I thought about this a bit. If every package and ISA package has a %HAS (or HASA) hash containing valid attributes as keys, and defines a 'has' method, then its fairly simple to validate attributes in any package (and the attribute accessor/mutator methods could even be AUTOLOAD'ed if desired). The 'has' method would go something like this (untested):

        sub has { my ($self, $attr) = @_; return 1 if exists $HAS{$attr}; return 1 if ${_}::has($self, $attr) for @ISA; return; } # Then in initialization or in AUTOLOAD... ... if ($self->has($attr)) { ...#set attr }
        I'm not yet saying that this is a good idea, just throwing it out there for comments/opinions/better options.
Re: (my?) problem with re-blessed references(?)
by djantzen (Priest) on Dec 13, 2002 at 06:10 UTC

    The problem doesn't have anything to do with bless, but rather with the fact that you are storing your instance variables in the package scoped lexicals %phrase, %author, %approved and %date. This is equivalent to private static variables in C++/Java, and means that only one instance of each exists per package, all shared between instances of the class. Thus, the last created object overwrites those values. Variables declared using use vars or our are basically equivalent to public static in that you can refer to them from outside the package, i.e., %Quote::phrase, but are likewise shared among all instances.

    If you want unique data per instance, you'll need to store that data inside the object itself, which in this case means using a hash or array, not a scalar, as the blessed reference.

      He's using the Flyweight pattern. Check the hash keys carefully.

        I think that BrowserUK's version isn't using the memory address as the hash key (which is what Abigail-II does). So rather than each object looking up parameters in the superclass like so:

        $phrase{'Quote=HASH(0x804b514)'}

        It's just calling the same key each time.

        This is why Abigail's objects need to clean up after themselves much more actively.

        If he's using Flyweight intentionally, then the overwriting of instance data is to be expected. This is not what he wants however. The point of the Flyweight is to enable the quick flow of data through a standard framework. But he appears simply to want standard inheritance, for which package lexicals will not do for more than one instance.

        Update: D'oh! so sub phrase : lvalue { $phrase{shift}; } means that the shifted value is the memory address of the thingy and since it's an lvalue that is assigned the unique instance data. Ergo, my $opinion = ('cool!' && 'eewww!').

Re: (my?) problem with re-blessed references(?)
by adrianh (Chancellor) on Dec 13, 2002 at 09:32 UTC
    Two problem I can see:
    • $foo{shift} is the same as $foo{'shift'} - you want $foo{(shift)}. This is what's causing your overwriting problem - everything is indexed under $whatever{'shift'}.
    • bless \$self, ref $class || $class makes $self reference itself - hence it will never be garbage collected. Say hello to nasty memory leaks :-)

    Fixing the above gives us...

    package Quote; use strict; use warnings; my (%phrase, %author, %approved); sub new { my ($class, $args) = @_; my $self; $self = bless [], ref $class || $class; if (ref $args eq "HASH") { $self->phrase() = $args->{phrase} if exists $args->{ph +rase}; $self->author() = $args->{author} if exists $args->{au +thor}; $self->is_approved() = $args->{approved} if exists $args->{ap +proved}; } $self; } sub phrase : lvalue { $phrase{(shift)}; } sub author : lvalue { $author{(shift)}; } sub is_approved : lvalue { $approved{(shift)}; } sub DESTROY { my $self = shift; delete $phrase{$self}; delete $author{$self}; delete $approved{$self}; } package QuotePlus; use base qw(Quote); use strict; use warnings; my(%date); sub new { my ($class, $args) = @_; my $self = $class->SUPER::new($args); if (ref $args eq "HASH") { $self->date() = $args->{date} if exists $args->{date}; } return $self; } sub date : lvalue { $date{(shift)}; } sub DESTROY { my $self = shift; $self->SUPER::DESTROY(); delete $date{$self}; }

    Which I think does what you want.

      Thanks adrianh++.

      I should've spotted the shift thing myself. It was 4:00 am though. (Excuses, excuses &^) ... that's a crossed-eyed smiley).

      The $self = bless \$self, $class; bit was just an idea that I never got around to looking at the effects of as the other stuff was going wrong. The strange thing is that using that rather than [], meant that somethings appeared to be working, ie. the hashes in the base class were being populated, though 2 of the 3 hashes were getting two entries. 1 under the subclass reference and one under the base class reference? The 3rd hash (%approved) was only getting a single entry.

      I know that all sounds implausible given they are all initialised in the same way, but that is what I was seeing.

      I've made a backup of that version and will get back to investingating what was going on once I've finished experimenting with this.


      Examine what is said, not who speaks.

      $foo{shift} is the same as $foo{'shift'} - you want $foo{(shift)}. This is what's causing your overwriting problem - everything is indexed under $whatever{'shift'}.

      Just wanted to say that the standard way of doing this is not to parethesize the shift, but to put a + in front of it. This is perls way of ensuring that whatever follows the plus is construed as code and not something else. Note that this is NOT the same as 0+shift, which coerces numeric context.

      This is IME particularly useful with print and with hash keys.

      print +($.>10) ? "Skipped." : "Ok"; $foo{+shift}=10;

      --- demerphq
      my friends call me, usually because I'm late....

        Just wanted to say that the standard way of doing this...

        Perl has standards?

        :-) :-)

        It's also nice for constructing hashes with map: my %foo = map +( $_ => bar($_) ), @baz;
        which otherwise won't parse correctly.

        Makeshifts last the longest.

Re: (my?) problem with re-blessed references(?)
by Abigail-II (Bishop) on Dec 17, 2002 at 16:23 UTC
    I'd certainly wouldn't use constructors to set attributes. If you do that, it becomes harder to do inheritance. How would you do multiple inheritance if your contructors set attributes? Suppose you inherit two classes, and the constructors of both classes set attributes. At least one of the constructors will work will not have the right reference to work with.

    I also shy away from using lvalued accessors. They are great for examples, as they don't take much space (screen space is a commodity when presenting), but they are awkward in practise. You can't easily intercept the passed in value, so masking such a method is hard.

    You don't have to have set_x, get_x accessors - a common way is to have a single accessors that sets an attribute if it gets an argument, and gets it if there isn't one.

    But I'm not a big users of accessors. For me, objects are more than a bunch of values with a ribbon around them. If I want just a bunch of attributes, I'd use something struct-like - for instance, a hash. For me, an object is a thing that keeps state. Attributes are used to record the state; methods are used to transit from one state to another.

    Abigail

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://219502]
Approved by krujos
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (8)
As of 2014-04-19 22:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (485 votes), past polls