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

Class confusion when testing using ref()

by atcroft (Monsignor)
on Jan 04, 2014 at 23:45 UTC ( #1069326=perlquestion: print w/ replies, xml ) Need Help??
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>

Comment on Class confusion when testing using ref()
Select or Download Code
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.


    Improve your skills with Modern Perl: the free book.

      To clarify, our %param above sub new should be my %param inside sub new.

      use Moops; class Cow :rw { has name => (default => 'Ermintrude') }; say Cow->new->name
Re: Class confusion when testing using ref()
by AnomalousMonk (Abbot) 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.

      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."

        ... before I learn how to do it right with decent tools and documentation"

        Is that a recommendation to move directly to (one of) Moo(u)se?

        If so, which one?


        With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.
Re: Class confusion when testing using ref()
by atcroft (Monsignor) 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!

      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.

        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
Re: Class confusion when testing using ref()
by Arunbear (Parson) 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.

      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.]

      - tye        

      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

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (4)
As of 2014-09-20 02:01 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (151 votes), past polls