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
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.
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;
Related
In Python you can do:
class Binance(Exchange):
name = "Binance"
code = "binance"
and in the parent class have
class Exchange:
#classmethod
def get_name(cls):
return cls.name
Now Perl!
This is lovely. I want the same for my Perl objects.
package DWDESReader;
use base qw(DWConfigFileReader);
our $type = "DES";
and in the base class:
package DWConfigFileReader;
our $type = "";
sub new {
my ($class, %args) = #_;
$args{type} = $type;
return bless {%args}, $class;
}
sub getType {
my ($self) = #_;
return $self->{type};
}
But this doesn't work, i.e. only returns the empty string assigned in the base class. I didn't expect it to work but am unsure how it should be done.
I don't see why one should need it, but it's possible, if you turn off strict refs:
#!/usr/bin/perl
use warnings;
use strict;
{ package My::Base;
sub new { bless {}, shift }
our $name = 'Base';
sub get_name {
my ($self) = #_;
my $class = ref $self || $self;
do { no strict 'refs';
${ $class . '::name' }
}
}
}
{ package My::Child;
use parent -norequire => 'My::Base';
our $name = 'Child';
}
my $ch = 'My::Child'->new;
print $ch->get_name, ' ', 'My::Child'->get_name;
But usually, you would just define a class method holding the name:
{ package My::Base;
sub new { bless {}, shift }
sub name { 'Base' }
sub get_name { shift->name }
}
{ package My::Child;
use parent -norequire => 'My::Base';
sub name { 'Child' }
}
Classes don't have attributes (variables) in Perl, only methods (subs).
I recommend creating an abstract virtual class method.
package DWConfigFileReader;
use Carp qw( croak );
sub new {
my ($class, %args) = #_;
my $self = bless(\%args, $class);
return $self;
}
sub type { croak("Subclass must override \"type\"."); }
1;
package DWDESReader;
use parent 'DWConfigFileReader';
sub type { "DES" }
1;
You don't even need $self->{type} = $class->type;; just use $self->type instead of $self->{type}.
As has been suggested, Perl inherits methods (subs), not variables, but constants are actually subs, so you can do something similar like this.
package DWDESReader;
use base qw(DWConfigFileReader);
use constant TYPE => "DES";
Then, if you call $self->TYPE somewhere in the base class, you'll get "DES" if the object is actually a DWDESReader object.
I have two classes, one is the base class(Employee) and the other its subclass which inherits it (Extend) the codes of which are shown below :
package Employee;
require Exporter;
our #EXPORT = ("getattr");
our $private = "This is a class level variable";
sub getattr {
print "Inside the getattr function of Employee.pm module \n";
$self = shift;
$attr = shift;
return ($self->{$attr});
}
1;
================
package Extend;
use base qw(Employee);
sub new {
print "Inside new method of Employee.pm \n";
my $class = shift;
my %data = (
name => shift,
age => shift,
);
bless \%data , $class;
}
sub test {
print "Inside test method of Extend class \n";
}
1;
==================
Now I have another piece of code which is using the Extend class :
use Extend;
my $obj = Extend->new("Subhayan",30);
my $value = $obj->getattr("age");
print ("The value of variable age is : $value \n");
$obj->test();
print "Do i get this : $obj.$private \n";
My question is regarding the variable $private defined in the parent class. As per my concept of inheritance attributes and methods of the parent class should be available through the subclass object . For example the function getattr runs fine . But why am I not being able to access $private variable using the base class Extend object .
What am I missing here ? Can someone please help ?
Variables don't get inherited the same way subs do. To access it, you need to specify the entire package name (and yes, when you declare $private, you need our, not my):
print "$Employee::private\n";
It's much more robust to define accessor methods:
# Employee package
sub private {
return $private;
}
...then in your script:
my $var = private();
To inherit object attributes from Employee, you can do:
# Employee
sub new {
my $self = bless {
dept => 'HR',
hours => '9-5',
}, shift;
return $self;
}
# Extend
sub new {
my $class = shift;
my $self = $class->SUPER::new; # attrs inherited from Employee
$self->{extended} = 1;
return $self;
}
# script
my $extend = Extend->new;
Now $extend looks like:
{
dept => 'HR',
hours => '9-5',
extended => 1,
}
You most likely wouldn't set dept or hours in the base class as it will apply to all employees, but I digress.
I followed what friedo said here.
Now, when I try to call the method testScript I get the error global symbol $obj requires explicit package name and it fails to call testScriptTwo.
use strict;
use warnings;
package Test;
use Method::Signatures;
method new {
my $obj = bless {}, $self;
return $obj;
}
method testScript {
$obj->testScriptTwo(); # Error happens here
}
method testScriptTwo { ... }
Test script:
use Test;
my $class = Test->new();
$class->testScript();
How do I make use of $obj to call methods within the package itself?
Use this instead:
method testScript {
$self->testScriptTwo();
}
The first argument is in the variable $self, not $obj
Your questions seem to indicate you do not understand the basics of scope, and how plain Perl objects work.
In Perl, when you use the ->method syntax on a package name or blessed reference, the subroutine method in that package is invoked. The first argument to the subroutine is the thing on which you invoked method.
So, if you do
My::Friend->new('Alfred');
the new subroutine in the package My::Friend receives two arguments. My::Friend and Alfred.
In a new method, it is customary to refer to the first argument as $class, but that is completely up to you. You could use $basket_case if you were so inclined:
sub new {
my $basket_case = shift;
my $basket = shift;
my $obj = bless { name => $basket } => $basket_case;
return $obj;
}
If you then invoke a method on the returned reference, that method will receive said reference as its first argument, allowing you to access data stored in that reference:
sub blurb {
my $schmorp = shift;
print $schmorp->{name}, "\n";
return;
}
Putting it all together:
#!/usr/bin/env perl
package My::Package;
use strict;
use warnings;
sub new {
my $basket_case = shift;
my $basket = shift;
my $obj = bless { name => $basket } => $basket_case;
return $obj;
}
sub blurb {
my $schmorp = shift;
print $schmorp->{name}, "\n";
return;
}
sub derp {
my $herp = shift;
printf "%s derp derp\n", $herp->{name};
return;
}
package main;
my $x = My::Package->new('Alfred');
$x->blurb;
$x->derp;
Output:
Alfred
Alfred derp derp
You need to understand these basics. Trying to put another layer of abstraction on top of the basics before understanding what is underneath will not make things any easier.
Now, if you are using Method::Signatures, it, by convention, puts that implicit first argument in a lexically scoped variable which, by default, it calls $self.
You can override that name in specific methods, and doing so in new might be a good idea to convey the fact that it doesn't expect an object instance; instead it returns a new instance.
Whatever you called that lexically scoped instance variable in one sub does not affect what it is called in another sub. For example:
#!/usr/bin/env perl
use strict;
use warnings;
sub a_number {
my $number = int(rand(10));
return $number;
}
sub square_that_number {
my $x = shift;
return $x * $x;
}
my $bzzzt = a_number();
my $trrrp = square_that_number($bzzzt);
print $trrrp, "\n";
Output:
$ ./zt.pl
36
OK, you need to backtrack a bit - you're new method is broken in the first place, which indicates that you don't really understand what's going on with OO perl.
A very simple object looks like this:
package Foo;
sub new {
#when Foo -> new is called, then 'Foo' is passed in as the class name
my ( $class ) = #_;
#create an empty hash reference - can be anything, but $self is the convention
my $self = {};
#tell perl that $self is a 'Foo' object
bless ( $self, $class );
#return the reference to your `Foo` object
return $self;
}
sub set_name {
my ( $self, $new_name ) = #_;
$self -> {name} = $new_name;
}
sub get_name {
my ( $self ) = #_;
return $self -> {name};
}
When you call this in your code:
use Foo;
my $new_instance = Foo -> new();
The class is passed into the new method, which you then use bless to create an instantiated object.
Then you can 'do stuff' with it - when you 'call' a method using -> then the first argument into the subroutine is the object reference.
So
$new_instance -> set_name ( "myname" );
print $new_instance -> get_name();
Is equivalent to:
Foo::set_name($new_instance, "myname" );
print Foo::get_name($new_instance);
You act on $new_instance which is a sort of magic hash that allows you to include code.
Method::Signatures is largely irrelevant until you understand the basics of OO. But what that does is 'simply' expand the functions within a module, such that you don't have to extract self/class etc.
By default, a method defined as method provides $self automatically. no $obj like you're using. That's a variable that's local to you new method, and simply doesn't exist outside that.
How would I create my class such that some methods will exist in the instance only if certain values were passed to the constructor?
Perhaps a more generic way of asking is: How can I add a method to an existing class instance?
You can attach an anonymous sub to an object based on flags:
use strict;
use warnings;
package Object;
sub new {
my $class = shift;
my $self = bless {}, $class;
my %args = #_;
if ($args{method}) {
$self->{method} = sub { print "hello\n" }
}
return $self;
}
sub method {
my $self = shift;
if (not defined $self->{method}) {
warn "Not bound\n";
return;
}
$self->{method}->();
}
1;
to use:
use Object;
my $obj1 = Object->new(method=>1);
$obj1->method();
my $obj2 = Object->new();
$obj2->method();
You can extend this to a number of methods through the same interface.
You can use Moose to apply a role at runtime.
package My::Class;
use Moose;
has foo => ( isa => 'Str', is => 'ro', required => 1 );
sub BUILD {
my $self = shift;
if ($self->foo eq 'bar') {
My::Class::Role->meta->apply($self);
}
}
no Moose;
package My::Class::Role;
use Moose::Role;
sub frobnicate {
my $self = shift;
print "Frobnicated!\n";
}
no Moose;
my $something = My::Class->new( foo => 'bar' );
print $something, "\n";
$something->frobnicate;
my $something_else = My::Class->new( foo => 'baz' );
print $something_else, "\n";
$something_else->frobnicate;
Gives:
Moose::Meta::Class::__ANON__::SERIAL::1=HASH(0x2fd5a10)
Frobnicated!
My::Class=HASH(0x2fd2c08)
Can't locate object method "frobnicate" via package "My::Class" at testmoose.pl line 32.
use AUTOLOAD to define the function. As a example method foo is called if $self->{foo} exists
sub AUTOLOAD {
my $methodname = $AUTOLOAD;
if ($methodname eq "foo" && exists($_[0]->{foo})){
goto &fooimplementationsub;
}
return;
}
An alternative technique is to use globs to define a new method at runtime
*PACKAGE::method = sub {
#code here
};
This has the disadvantage that the method is now visible to all instances of the class so is not quite what you want.
A third and possibly more risky/inefficient method is to use string eval
eval <<EOF
sub foo {
#code here
};
EOF
Again this has the disadvantage that the method is now visible to all instances of the class so is not quite what you want.
Methods are just subroutines in a package, and a package is just a hash holding typeglobs. And hashes can be modified at runtime.
So you could, in theory, add or remove methods given values in a constructor.
package WeirdClass;
sub new {
my ($class, $name, $code) = #_;
if ($name) {
no strict;
*{__PACKAGE__ . "::$name"} = $code;
}
bless {} => $class;
}
And then use it like:
my $object = WeirdClass->new(foo => sub {say "foo"});
$object->foo(); # prints "foo\n";
However, this method is available for all objects of that class:
my $another_object = WeirdClass->new();
$another_object->foo; # works too.
Using autoload, one can mock arbitrary methods:
package BetterClass;
sub new {
my ($class, %args) = #_;
bless \%args => $class;
}
# destructor will be called at cleanup, catch with empty implementation
sub DESTROY {};
sub AUTOLOAD {
my $self = shift;
(my $method = our $AUTOLOAD) =~ s/.*://; # $AUTOLOAD is like "BetterClass::foo"
# check if method is allowed
die "forbidden method $method" unless $self->{can}{$method};
# mock implementations
given ($method) {
say "foo" when "foo";
say "bar" when "bar";
when ("add") {
my ($x, $y) = #_;
return $x + $y;
}
default { die "unknown method $method" }
}
}
Then:
my $o = BetterClass->new(can => { foo => 1, bar => 0});
$o->foo;
my $p = BetterClass->new(can => {bar => 1, add => 1});
$p->bar;
say $p->add(5, 6);
Of course, these techniques can be combined freely.
Edit: can()
To make the AUTOLOAD work with can, the protected methods should be moved into a data structure:
my %methods;
BEGIN {
%methods = (
foo => sub {say "foo"},
bar => sub {say "bar"},
add => sub {
my ($self, $x, $y) = #_;
$x + $y;
},
);
}
Then override the can method:
# save a reference to the origional `can` before we override
my $orig_can;
BEGIN{ $orig_can = __PACKAGE__->can("can") }
sub can {
my ($self, $meth) = #_;
# check if we have a special method
my $code = $methods{$meth} if ref $self and $self->{can}{$meth};
return $code if $code;
# check if we have a normal method
return $self->$orig_can($meth);
}
And AUTOLOAD would change to
my ($self) = #_; # do not `shift`
(my $method = our $AUTOLOAD) =~ s/.*://;
my $code = $self->can($method) or die "unknown method $method";
goto &$code; # special goto. This is a AUTOLOAD idiom, and avoids extra call stack frames
Don't do too much magic. I've gotten away from AUTOLOAD because it causes maintenance issues where mysterious methods suddenly appear and disappear.
One way to handle what you want is to define all the methods you need, and if a particular object is of the wrong type, simply cause that method to croak:
sub Foo {
my $self = shift;
my $parameter = shift;
if ( $self->Class_type ne "Foo" ) {
croak qq(Invalid method 'Foo' on object #{[ref $self]});
}
print "here be dragons\";
return "Method 'Foo' successfully called";
}
The above will not allow method Foo to be called unless the class type is Foo.
If your objects won't change (or you don't want them to change) once an object is created, you can define that object as a sub-class.
Before you bless a newly created object, check that special value and decide whether or not you need to create a specific sub-class instead.
package My_class;
sub new {
my $class = shift;
my $class_type = shift;
my $self = shift;
if ( $class_type eq "Foo" ) {
bless $self, "My_class::Foo";
}
else {
bless $self, $class;
}
package My_class::Foo;
use base qw(My_class);
sub Foo {
my $self = shift;
return "Foo Method successfully called!";
}
Notice that my class My_class::Foo is a sub-class of My_class via the use base pragma. That means all methods for My_class are valid with objects of My_class::Foo. However, only objects of My_class::Foo can call the Foo method.
When I create my object (via the new subroutine), I look at the $class_type parameter. If it's a type Foo, I bless the class as My_class::Foo.
Here's an example where I use sub-classes to do what you want.
Every object is a class type of Question. You can see my constructor on line 1129. I pass in a question type as one of the parameters to my constructor.
In line 1174 to 1176, I create my object, but then append the question type to the class, and then bless the question as that sub-class type. All of my subclasses are a type Question (see my use base qw(Question); below each package declaration. However, only questions of sub-class Question::Date and Question::Regex have a method Format. And, only objects of type Question::Words have a method Force.
Hope this helps.
None of the answers so far given actually handle the question actually asked.
Adding methods to an instance in Perl is not directly supported. Object instances are always instances of some class, and that class is the thing that actually has methods. You cannot add a method to a single instance of a class, without making that method also available on every other instance of the same class.
For your problem you have two basic solutions:
Provide the methods always, but test a flag to see whether the method should apply to the given instance or not. This is by far the simplest.
Bless each object into subclasses depending on the flags. Subclass the main class to provide those methods as appropriate.
If you truely want to add methods on individual instances, then what you'll have to do is arrange that every instance is a single instance of a newly-derived class for every object. This gets harder to arrange for, doubly-so if you want to avoid leaking memory and cleaning up the classes once the objects are DESTROYed. This would however allow truely per-instance methods.
Since it is highly unlikely you'll truely need this third option it is far better to go with one of the first.
I have a module foo that has extended sub-modules bar and baz. I want bar and baz to modify the same set of hashes that are in foo.
Right now I have something like:
my $foo = new foo;
my $bar = new foo::bar( $foo );
$bar->doStuff();
$bar->printSelf();
my $baz = new foo::bar( $foo );
$baz->doOtherStuff();
$baz->printSelf();
Inside one of the sub-modules the constructor looks like:
sub new {
my $class = shift;
my $self = shift;
--stuff--
bless $self, $class;
return $self;
}
Please don't laugh too hard. Is there a way I can do this without passing in $foo?
Thanks for reading. :)
I prefer to share things through methods. That way, no one has to know anything about the data structures or variables names (although you do need to know the method name):
{
package SomeParent;
my %hash1 = ();
my %hash2 = ();
sub get_hash1 { \%hash1 }
sub get_hash2 { \%hash2 }
sub set_hash1_value { ... }
sub set_hash1_value { ... }
}
Since SomeParent provides the interface to get at the private data structures, that's what you use in SomeChild:
{
package SomeChild;
use parent 'SomeParent';
sub some_method {
my $self = shift;
my $hash = $self->get_hash1;
...;
}
sub some_other_method {
my $self = shift;
$self->set_hash2_value( 'foo', 'bar' );
}
}
Your question is not very clear nor there is any code with hashes. But if you need module variables modified, you can use fully qualified name:
package Foo; # don't use lowercase named, they are reserved for pragmas
our %hash1 = ();
our %hash2 = ();
package Foo::Bar;
use Data::Dump qw(dd);
sub do_stuff {
$Foo::hash1{new_item} = 'thing';
}
sub do_other_stuff {
dd \%Foo::hash1;
}
package main;
Foo::Bar->do_stuff();
Foo::Bar->do_other_stuff();
But if you need to modify instance variables, you need to have reference to this instance. I see some strategies that would work:
inherit from Foo, so the hashes will be in instance of Foo::Bar
pass reference to Foo in constructor and store it as property in Foo::Bar
pass Foo reference as parameter to method
Proper solution depends on what you are trying to do and how you going to use it.