Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

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

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

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

#! 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.

In reply to (my?) problem with re-blessed references(?) by BrowserUk

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others imbibing at the Monastery: (5)
    As of 2021-01-28 08:38 GMT
    Find Nodes?
      Voting Booth?