Perl : Get the objects of a particular class

问题

Is there a way to fetch the objects of a particular class in perl ?

Example :

use <class1>;
use <class2>

sub Main {

    my $call1 = <class1>->new(<ARGS>)->(<Routine call>);
    my $call2 = <class1>->new(<ARGS>)->(<Routine call>);
    my $call3 = <class1>->new(<ARGS>)->(<Routine call>);

    .
    .
    .
    my $call4 = <class2>->new(<ARGS>)->(<Routine call>);
}

Would one be able to fetch the objects of <class1> ?

$call1
$call2
and
$call3

回答1:

There are a few pointers here: How can I list all variables that are in a given scope?

With this tool: http://search.cpan.org/dist/PadWalker/PadWalker.pm you can access all of the package and lexcial variables in a given scope.

Or you can access the symbol table also directly for a given scope: keys %{'main::'}

And you can get the type/class of a variable with ref(). http://perldoc.perl.org/functions/ref.html

I don't think there are direct solutions for your problem.

Perhaps you could extend the class and collect the instances to a hash table in an overridden constructor.

回答2:

The normal technique would be to write Class1 in such a way that its constructor keeps a (presumably weak) reference to each object that is constructed in an array or hash somewhere. If you're using Moose, there's an extension called MooseX::InstanceTracking that makes that very easy to do:

package Class1 {
    use Moose;
    use MooseX::InstanceTracking;

    # ... methods, etc here.
}

package Class2 {
    use Moose;
    extends 'Class1';
}

my $foo = Class1->new;
my $bar = Class1->new;
my $baz = Class2->new;

my @all = Class1->meta->get_all_instances;

If you're not using Moose; then it's still pretty easy:

package Class1 {
    use Scalar::Util qw( weaken refaddr );

    my %all;
    sub new {
        my $class = shift;

        my $self  = bless {}, $class;
        # ... initialization stuff here

        weaken( $all{refaddr $self} = $self );
        return $self;
    }

    sub get_all_instances {
        values %all;
    }

    sub DESTROY {
        my $self = shift;
        delete( $all{refaddr $self} );
    }

    # ... methods, etc here.
}

package Class2 {
    our @ISA = 'Class1';
}

my $foo = Class1->new;
my $bar = Class1->new;
my $baz = Class2->new;

my @all = Class1->get_all_instances;

来源：https://stackoverflow.com/questions/20783341/perl-get-the-objects-of-a-particular-class

标签

perl

object