|
atcroft has asked for the wisdom of the Perl Monks concerning the following question:
I am trying to learn to write OOP. My plan was to start out with writing them myself, then once I am comfortable with that to begin trying some of the newer systems that are available.
I have created a base class ('Particle') and two child classes ('MoveableParticle' and 'StationaryParticle') using use parent and setting @ISA. (Testable code for all will appear at or near the bottom of this post.) So far, so good.
I thought I would try to create class variables to keep track of the objects I had created. Since the child classes only make small changes (so far), I thought this would be best done in the parent class. So, in my new() method, I add them to into a hash. Here is where I run into a problem.
When I call a class method I created (in the parent class) to return a count of the objects, it reports that a ref() call on any of them returns that they are all of only one of the two child classes. I have tested this by dumping the raw hash using Data::Dumper, testing them with
Test::More's isa_ok(), and printing out the values returned by ref().
I cannot see where I am making an error, but I know somewhere I must. Any insight or clue you may be able to provide is greatly appreciated.
Particle.pm (base class)
package Particle;
use strict;
use warnings;
use Data::Dumper;
$Data::Dumper::Deepcopy = 1;
$Data::Dumper::Sortkeys = 1;
our %param;
our %REGISTRY;
sub new {
my $class = shift;
$param{is_movable} = 0;
@{ $param{history} } = ();
$param{position} = { x => 0, y => 0, z => 0, };
$param{movement} = { dx => 0, dy => 0, dz => 0, };
$param{is_active} = 0;
my $self = bless \%param, $class;
if ( scalar @_ ) {
$self->init(@_);
}
$REGISTRY{$self} = $self;
# my $format_str = qq{Class: %s\n\tKey: %s\n\tref(): %s\n};
# my $t = ref( $REGISTRY{$self} );
# print sprintf $format_str, $class, $self, $t;
return $self;
}
sub init {
my $self = shift;
my ($data) = @_;
foreach my $k ( keys %{$data} ) {
$self->set( $k, \$data->{$k} );
}
}
sub get {
my $self = shift;
my $k = shift;
if ( $k =~ m/^p_?(.)/i ) {
return $self->{position}{$1};
}
elsif ( $k =~ m/^m_?d?(.)/i or $k =~ m/^d(.)/i ) {
return $self->{movement}{ q{d} . $1 };
}
elsif ( $k =~ m/^is_a/i ) {
return $self->{is_active};
}
elsif ( $k =~ m/^is_m/i ) {
return $self->{is_movable};
}
elsif ( $k =~ m/^h_?(\d+)/i ) {
return $self->{history}[$1];
}
elsif ( $k =~ m/^hc/i ) {
return scalar @{ $self->{history} };
}
}
sub set {
my $self = shift;
my $k = shift;
if ( $k =~ m/^h_?self/i ) {
push @{ $self->{history} },
{
time => time,
position => \$self->{position},
movement => \$self->{movement},
};
return;
}
my $v = shift;
if ( ref $v eq q{REF} ) {
if ( $k =~ m/^position/i ) {
$self->{position} = $$v;
}
elsif ( ref $v eq q{REF} and $k =~ m/^movement/i ) {
$self->{movement} = $$v;
}
}
else {
if ( $k =~ m/^p_?(.)/i ) {
$self->{position}{$1} = $v;
}
elsif ( $k =~ m/^m_?d?(.)/i or $k =~ m/^d(.)/i ) {
$self->{movement}{ q{d} . $1 } = $v;
}
elsif ( $k =~ m/^is_a/i ) {
$self->{is_active} = $v;
}
elsif ( $k =~ m/^is_m/i ) {
$self->{is_movable} = $v;
}
elsif ( $k =~ m/^h_?(\d+)/i ) {
$self->{history}[$1] = $v;
}
elsif ( $k =~ m/^h/i ) {
push @{ $self->{history} }, $v;
}
}
}
sub total_count {
my $class = shift;
print __FILE__, q{:}, __LINE__, q{ }, $class, qq{\n};
# print Data::Dumper->Dump(
# [ \%REGISTRY, ],
# [ qw( *REGISTRY ) ]
# ), qq{\n};
my $format_str = qq{Class: %s\n\tKey: %s\n\tref(): %s\n};
foreach my $k ( keys %REGISTRY ) {
my $t = ref( $REGISTRY{$k} );
print sprintf $format_str, $class, $k, $t;
}
return
scalar
grep { ref( $REGISTRY{$_} ) eq $class }
keys %REGISTRY;
}
1;
MoveableParticle.pm (child class 1)
package MoveableParticle;
use parent 'Particle';
use Data::Dumper;
$Data::Dumper::Deepcopy = 1;
$Data::Dumper::Sortkeys = 1;
our @ISA = ( 'Particle', );
our %REGISTRY;
sub new {
my $class = shift;
my $self = $class->SUPER::new( @_ );
$self->set( 'is_moveable', 1 );
return $self;
}
1;
StationaryParticle.pm (child class 2)
package StationaryParticle;
use parent 'Particle';
use Data::Dumper;
$Data::Dumper::Deepcopy = 1;
$Data::Dumper::Sortkeys = 1;
our @ISA = ( 'Particle', );
our %REGISTRY;
sub new {
my $class = shift;
my $self = $class->SUPER::new( @_ );
$self->set( 'is_moveable', 0 );
return $self;
}
1;
Test program
#!/usr/bin/perl
use strict;
use warnings;
use Carp::Always;
use Data::Dumper;
use Test::More;
use StationaryParticle;
use MoveableParticle;
$| = 1;
srand();
$Data::Dumper::Deepcopy = 1;
$Data::Dumper::Sortkeys = 1;
my @particles;
push @particles, MoveableParticle->new(
{
position => { x => 10, y => 10, z => 10, },
movement => { dx => 5, dy => -5, dz => 0, },
}
);
# print Data::Dumper->Dump( [ \@particles, ], [ qw( *particles ) ] ),
# qq{\n};
$particles[0]->set( 'is_active', 0, );
isa_ok( $particles[0], 'MoveableParticle' );
isa_ok( $particles[0], 'Particle' );
isa_ok( $particles[0], 'StationaryParticle' );
print qq{Object 0: }, ref( $particles[0] ), qq{\n};
print qq{\n};
push @particles, StationaryParticle->new(
{ position => { x => 20, y => 20, z => 0, }, },
);
isa_ok( $particles[1], 'MoveableParticle' );
isa_ok( $particles[1], 'Particle' );
isa_ok( $particles[1], 'StationaryParticle' );
print qq{Object 1: }, ref( $particles[1] ), qq{\n};
print qq{\n};
# print Data::Dumper->Dump( [ \@particles, ], [ qw( *particles ) ] ),
# qq{\n};
print qq{Particle count: },
Particle->total_count, qq{\n};
print qq{\n};
print qq{Stationary particle count: },
StationaryParticle->total_count, qq{\n};
print qq{\n};
print qq{Moveable particle count: },
MoveableParticle->total_count, qq{\n};
print qq{\n};
Test::More::done_testing();
Output from test program run
Class: MoveableParticle
Key: MoveableParticle=HASH(0x264e050)
ref(): MoveableParticle
ok 1 - The object isa MoveableParticle
ok 2 - The object isa Particle
not ok 3 - The object isa StationaryParticle
# Failed test 'The object isa StationaryParticle'
# at module_test.20140103.pl line 28.
# The object isn't a 'StationaryParticle' it's a 'MoveableParticle
+'
Object 0: MoveableParticle
Class: StationaryParticle
Key: StationaryParticle=HASH(0x264e050)
ref(): StationaryParticle
not ok 4 - The object isa MoveableParticle
# Failed test 'The object isa MoveableParticle'
# at module_test.20140103.pl line 35.
# The object isn't a 'MoveableParticle' it's a 'StationaryParticle
+'
ok 5 - The object isa Particle
ok 6 - The object isa StationaryParticle
Object 1: StationaryParticle
Particle.pm:307 Particle
Class: Particle
Key: StationaryParticle=HASH(0x264e050)
ref(): StationaryParticle
Class: Particle
Key: MoveableParticle=HASH(0x264e050)
ref(): StationaryParticle
Particle count: 0
Particle.pm:307 StationaryParticle
Class: StationaryParticle
Key: StationaryParticle=HASH(0x264e050)
ref(): StationaryParticle
Class: StationaryParticle
Key: MoveableParticle=HASH(0x264e050)
ref(): StationaryParticle
Stationary particle count: 2
Particle.pm:307 MoveableParticle
Class: MoveableParticle
Key: StationaryParticle=HASH(0x264e050)
ref(): StationaryParticle
Class: MoveableParticle
Key: MoveableParticle=HASH(0x264e050)
ref(): StationaryParticle
Moveable particle count: 0
1..6
# Looks like you failed 2 tests of 6.
</readmore>
|
Re: Class confusion when testing using ref()
by chromatic (Archbishop) on Jan 04, 2014 at 23:47 UTC
|
You're blessing a reference to the same hash. The blessing gets attached to the hash, not the reference. Bless the same hash again and you'll replace the previous blessing.
| [reply] |
|
|
| [reply]
[d/l]
[select] |
Re: Class confusion when testing using ref()
by AnomalousMonk (Archbishop) on Jan 05, 2014 at 00:42 UTC
|
use parent 'Particle';
...
our @ISA = ( 'Particle', );
I don't understand the point of explicitly assigning to @ISA in the child classes. Isn't parent designed to do this (among other things)? See also base.
| [reply]
[d/l]
[select] |
|
|
Yes, but that's yet another one of the flaws of the documentation which tries to teach Perl's bare-bones OO through years of cruft. I'm trying not to rant about the silliness of "I want to learn how to do OO in Perl manually before I learn how to do it right with decent tools and documentation", but I'm not sure I can do it politely. Suffice it to say "This confusion is exactly what everyone should expect from trying to unify various tutorials written to various fads at various points in the past 20 years."
| [reply] |
|
|
| [reply] |
|
|
Re: Class confusion when testing using ref()
by Arunbear (Prior) on Jan 05, 2014 at 19:38 UTC
|
Those subclasses seem pointless, as they aren't introducing any new behaviour. The StationaryParticle in particular seems behaviourally identical to its parent class, and the MoveableParticle class doesn't have any behaviour related to movement :(
(In the absence of such behaviour) Perhaps what you wanted instead are so called factory methods e.g.
package Particle;
...
sub newMoveableParticle {
my $class = shift;
my $p = $class->new( @_ );
$p->set( 'is_moveable', 1 );
return $p;
}
sub newStationaryParticle {
my $class = shift;
my $p = $class->new( @_ );
$p->set( 'is_moveable', 0 );
return $p;
}
UpdateThe following is incorrect as kindly pointed out by tobyink
$REGISTRY{$self} = $self;
In a long running program, this could cause a memory leak unless you are cleaning up the registry in some way. This could be automated by letting objects 'de-register' themselves when they go out of scope e.g.
DESTROY {
my $self = shift;
delete $REGISTRY{$self};
}
End of update
What do these objects do anyway? The API seems not very intuitive to me. | [reply]
[d/l]
[select] |
|
|
People teaching OO feel the need to teach inheritance and they tend to make a big deal of it. This leaves most students of OO with the very unfortunate habit of starting any design project with one of the foremost questions in their mind being "which classes should inherit from which other classes?". So it isn't surprising that I often see uses of inheritance that seem very stretched.
OO design is done much, much better when inheritance is a last resort (or just avoided entirely). [In languages with interfaces, inheritance is sometimes used to apply interfaces, but it is an implementation detail that inheritance is used for that and it is not really a use of real inheritance and not something that one needs to avoid when using such languages.]
| [reply] |
|
|
| [reply] |
|
|
This could be automated by letting objects 'de-register' themselves when they go out of scope e.g.
DESTROY {
my $self = shift;
delete $REGISTRY{$self};
}
The above will not actually work. DESTROY will never be called because $REGISTRY{$self} will have bumped the reference count. (Or rather it will get called, but only when the entire process ends - not when the object goes out of scope.)
Instead, you should use Scalar::Util to weaken $REGISTRY{$self} as part of the object construction. No DESTROY sub is necessary for this to work.
use Moops; class Cow :rw { has name => (default => 'Ermintrude') }; say Cow->new->name
| [reply]
[d/l]
[select] |
Re: Class confusion when testing using ref()
by atcroft (Abbot) on Jan 05, 2014 at 06:15 UTC
|
My thanks for all of the responses, especially to chromatic and tobyink-making that change appears to have solved my issue. AnomalousMonk, I removed the @ISA assignment, and the code works, so that appears to have been my misunderstanding. With regards to the comments of chromatic and BrowserUK on the next module to use, I've heard mention of such modules as Moose, Mouse, and Mo-what is the current, generally-recommended state of the art?
Again, my thanks and appreciation for the assistance and insight. Thank you all!
| [reply] |
|
|
All the modules mentioned are “state of the art” since they are all actively maintained and really quite nice. Also missed Moo, and for bleeding edge fun you might look at Moops. Moose does more than the others; see Class::MOP for why/how. It’s also the slowest (really start up is the major issue, it’s not “slow” exactly once compiled and running) and the others through their minimalism achieve, maybe… subjective, cleaner interfaces and extensions. Mouse with XS is the fastest by a lot. I’ve been reaching for Moo most of the time. I didn’t know Mo had grown so much since it was sort of what I saw as a joke response to it all. I would probably use Moops for personal projects if I had the tuits for personal projects right now.
On that note I’d like to say that tobyink is really quite an excellent—and prodicious!—software designer. See also, Type::Tiny.
| [reply] |
|
|
How could I possibly not ++ the above? Your_Mother, your cheque is in the post. ;-)
Anyway, my personal opinion is for OO to default to Moo, and only consider other options if you have special requirements.
Use Moose if you have requirements for introspection of your classes.
But also consider whether introspection is really necessary. For example, if you want to interrogate a class to find which attributes accept, say, an integer, rather than using Moose's meta object protocol to generate the list, you could just add a method to the class called which returns a hard-coded list of such attributes, a la sub integer_attributes { return qw(cell_height cell_width) } Use Moose if you want to take advantage of the many MooseX modules on CPAN. (There's an increasing number of MooX modules though.) Use Moose if your project has dependencies on other projects that already use Moose. Not that using Moo would be a technical problem - Moo and Moose integrate very well. However, it saves people from installing both Moo and Moose, and you may save a little memory by using just one OO system. However, some prominent projects such as Throwable have moved from Moose to Moo. Consider Mouse if speed of generated methods (constructors, accessors) is an important concern, because Mouse implements them in C. Of course, for many projects, it's the methods you write yourself in pure Perl that do the bulk of the work.
Moo (and also Moose if you install MooseX::XSAccessor) can sometimes, optionally generate XS accessors for you (but not constructors). Use Class::Tiny or Role::Tiny if your requirements are very basic, and you want to keep dependencies at a minimum. Consider Moops if you can tolerate its very large dependency list. (But it has fewer dependencies than MooseX::Declare.)
Something I use Moops for is rapid prototyping before backporting to plain Moo.
use Moops; class Cow :rw { has name => (default => 'Ermintrude') }; say Cow->new->name
| [reply]
[d/l] |
|
|
