Loop though class attributes

[ZX81Meister]

Hi there, I've just discovered the means of OOP in Perl and got a newbie question... I've defined a class with attributes like this:

sub new { my $class = shift; my $s = {}; bless $s, $class;
  
 $s->{Laboratory}  = new MotionSensorB('Laboratory',  'senMotion_H2_S1
+');
 $s->{Fruitcellar} = new MotionSensorA('Fruitcellar', 'senMotion_H1_S1
+');

 return $s;
}

In the same package I want to loop through the attributes, that is, access the elements Laboratory and Fruitcellar:

sub event { my $c = shift;

 foreach my ??? (???) {
  print ??? . "\n";
  
}

I'm not so firm with arrays, hashes, references etc. and trying all sorts of combinations, but can't get it right. How can I achieve it?

[Corion]

Since your object is still mostly just a hash, you can iterate over its keys:

sub event { my $c = shift;

 foreach my $key (keys %$c) {
  print $key . "\n";
 }
  
}

[ZX81Meister]

That's a little more efficient than the solution I came up with, give thx!

foreach my $o (%{$c})
 {
  if(ref(\$o) eq 'REF' && exists($o->{Device}) && $o->{Device} eq $dev
+ice)
  {
   $o->motion;
   last;
  }
 }

[stevieb]

If you are just going to literally iterate over the structure of your object, you really should be doing some checking to ensure each value is an object you can act upon. Personally, if I were to do something like this, I'd make a sensors top-level key, and stuff the sensors in there. That way, all sensor objects are within a single location. This allows greater flexibility going forward.

Either way, UNIVERSAL::can is a decent, clean way to see if a) the value of each key is indeed an object, and b) checks whether it can perform a specific task:

use warnings;
use strict;

package Device; {
    sub new {
        my $self = bless {}, shift;

        $self->{s1} = Sensor->new;
        $self->{s2} = Sensor->new;
        $self->{s3} = "string";

        return $self;
    }
    sub event {
        my ($self) = @_;

        for (keys %{ $self }){
            if (UNIVERSAL::can($self->{$_}, 'motion')){
                print "yep, '$_' is a sensor object\n";
            }
            else {
                print "'$_' isn't a damned sensor!\n";
            }
        }
    }
}

package Sensor; {
    sub new {
        return bless {}, shift;
    }
    sub motion {
        ...
    }
}

package main;

my $device = Device->new;

$device->event;

Output:

yep, 's1' is a sensor object
's3' isn't a damned sensor!
yep, 's2' is a sensor object

[choroba]

Higher level frameworks like Moose provide means to access attributes through meta-programming:

#!/usr/bin/perl
use warnings;
use strict;


sub MotionSensorA::new { bless { type => $_[1] }, $_[0] }
sub MotionSensorB::new { bless { type => $_[1] }, $_[0] }

{   package Device;
    use Moose;

    has laboratory  => (is      => 'ro',
                        isa     => 'MotionSensorB',
                        default => sub {
                            'MotionSensorB'->new('senMotion_H2_S1');
                        });
    has fruitcellar => (is      => 'ro',
                        isa     => 'MotionSensorA',
                        default => sub {
                            'MotionSensorA'->new('senMotion_H1_S1');
                        });

    sub event {
        my ($self) = @_;

        foreach my $device ($self->meta->get_attribute_list) {
            print "$device: ", $self->$device->{type}, "\n";
        }
    }
    __PACKAGE__->meta->make_immutable;
}

my $d = 'Device'->new;
$d->event;