How to use instance of class in same class Perl - perl

I'm new to OOPerl, and wanted to know how I can reference an instance of a class within that class (i.e. $this in PHP) so that I'm able to call its "private" methods
To make it more clear:
in PHP for instance:
class Foo {
public function __construct(){
}
public function doThis(){
$that = $this->doThat(); //How to reference a "private" function in perl that is defined in the same class as the calling function?
return $that;
}
private function doThat(){
return "Hi";
}
}

Perl methods are ordinary subroutines that expect the first element of their parameter array #_ to be the object on which the method is called.
An object defined as
my $object = Class->new
can then be used to call a method, like this
$object->method('p1', 'p2')
The customary name is $self, and within the method you assign it as an ordinary variable, like this
sub method {
my $self = shift;
my ($p1, $p2) = #_;
# Do stuff with $self according to $p1 and $p2
}
Because the shift removes the object from #_, all that is left are the explicit parameters to the method call, which are copied to the local parameter variables.
There are ways to make inaccessible private methods in Perl, but the vast majority of code simply trusts the calling code to do the right thing.

Related

Access object created in another function

My program creates an object, which, in turn, creates another object
MainScript.pm
use module::FirstModule qw ($hFirstModule);
$hFirstModule->new(parametres);
$hFirstModule->function();
FirstModule.pm
use Exporter ();
#EXPORT = qw($hFirstModule);
use module::SecondModule qw ($hSecondModule);
sub new {
my $className = shift;
my $self = { key => 'val' };
bless $self, $classname;
return $self;
}
sub function{
$hSecondModule->new(parametres);
#some other code here
}
I want to acces $hSecondModule from MainScript.pm.
It depends.
We would have to see the actual code. What you've shown is a bit ambiguous. However, there are two scenarios.
You can't
If your code is not exactly like what you have shown as pseudo-code, then there is no chance to do that. Consider this code in &module1::function.
sub function {
my $obj = Module2->new;
# ... more stuff
return;
}
In this case, you are not returning anything, and the $obj is lexically scoped. A lexical scope means that it only exists inside of the closest {} block (and all blocks inside that). That's the block of the function sub. Once the program returns out of that sub, the variable goes out of scope and the object is destroyed. There is no way to get to it afterwards. It's gone.
Even if it was not destroyed, you cannot reach into a different scope.
You can
If you however return the object from the function, then you'd have to assign it in your script, and then you can access it later. If the code is exactly what you've shown above, this works.
sub function {
my $obj = Module2->new;
# nothing here
}
In Perl, subs always return the last true statement. If you don't have a return and the last statement is the Module2->new call, then the result of that statement, which is the object, is returned. Of course it also works if you actually return explicitly.
sub function {
return Module2->new;
}
So if you assign that to a variable in your script, you can access it in the script.
my $obj = module1->function();
This is similar to the factory pattern.
This is vague, but without more information it's impossible to answer the question more precicely.
Here is a very hacky approach that takes your updated code into consideration. It uses Sub::Override to grab the return value of the constructor call to your SecondModule thingy. This is something that you'd usually maybe do in a unit test, but not in production code. However, it should work. Here's an example.
Foo.pm
package Foo;
use Bar;
sub new {
return bless {}, $_[0];
}
sub frobnicate {
Bar->new;
return;
}
Bar.pm
package Bar;
sub new {
return bless {}, $_[0];
}
sub drink {
return 42; # because.
}
script.pl
package main;
use Foo; # this will load Bar at compile time
use Sub::Override;
my $foo = Foo->new;
my $bar; # this is lexical to the main script, so we can use it inside
my $orig = \&Bar::new; # grab the original function
my $sub = Sub::Override->new(
"Bar::new" => sub {
my $self = shift;
# call the constructor of $hSecondModule, grab the RV and assign
# it to our var from the main script
$bar = $self->$orig(#_);
return $bar;
}
);
$foo->frobnicate;
# restore the original sub
$sub->restore;
# $bar is now assigend
print $bar->drink;
Again, I would not do this in production code.
Let's take a look at the main function. It first creates a new Foo object. Then it grabs a reference to the Bar::new function. We need that as the original, so we can call it to create the object. Then we use Sub::Override to temporarily replace the Bar::new with our sub that calls the original, but takes the return value (which is the object) and assigns it to our variable that's lexical to the main script. Then we return it.
This function will now be called when $foo->frobnicate calls Bar->new. After that call, $bar is populated in our main script. Then we restore Bar::new so we don't accidentally overwrite our $bar in case that gets called again from somewhere else.
Afterwards, we can use $bar.
Note that this is advanced. I'll say again that I would not use this kind of hack in production code. There is probably a better way to do what you want. There might be an x/y problem here and you need to better explain why you need to do this so we can find a less crazy solution.

Add new method to existing object in perl

I have this perl object. After the object is instantiated, I'm trying to add a new method to the object within a loader method, that can then be called later.
I've tried a whole bunch of stuff that hasn't worked. Examples include:
sub loader {
my ($self) = #_;
sub add_me {
my ($self, $rec) = #_
warn "yayyyyyy";
return $rec;
}
#here are the things I've tried that dont work:
# &{$self->{add_me}} = \&add_me;
# \&{$self->{add_me}} = \&add_me;
# assuming the class definition is in Holder::Class try to add it to symblol table
# *{Holder::Class::add_me} = \&add_me;
}
EDIT:
The reason that I need to do this is I'm adding a hook in my code where the user of my software will have the ability to inject their own sub to edit a data structure as they will.
To do this, they will be able to edit a secondary file that will only contain one sub and get the data structure in question passed in, so something like:
sub inject_a_sub {
my ($self, $rec) = #_;
#do stuff to $rec
return $rec;
}
then inside my original object upon its instantiation, I check to see if the above mentioned file exists, and if so read its contents and eval them. Lastly, I want to make the eval'd code which is just a sub, a method of my object. To be precise, my object is already inheriting a method called do_something and i want to make the sub read in by the eval override the do_something method being inherited so that when called the sub from the external file runs.
its a weird problem :/
and it hurts me :(
Obi wan kenobi you're my only hope!
Cheers!
If you just want to attach functionality to a specific object, and don't need inheritance, you can store a code ref in the object and call it.
# Store the code in the object, putting it in its own
# nested hash to reduce the chance of collisions.
$obj->{__actions}{something} = sub { ... };
# Run the code
my #stuff = $obj->{__actions}{something}->(#args);
Problem is, you need to check that $obj->{__actions}{something} contains a code reference. What I would suggest is to wrap a method around this procedure.
sub add_action {
my($self, $action, $code) = #_;
$self->{__actions}{$action} = $code;
return;
}
sub take_action {
my($self, $action, $args) = #_;
my $code = $self->{__actions}{$action};
return if !$code or ref $code ne 'CODE';
return $code->(#$args);
}
$obj->add_action( "something", sub { ... } );
$obj->take_action( "something", \#args );
If you already know the class name you want to inject a method into, write the subroutine as normal but use the fully qualified name.
sub Some::Class::new_method {
my $self = shift;
...
}
Note that any globals inside that subroutine will be in the surrounding package, not in Some::Class. If you want persistent variables use state inside the subroutine or my outside the subroutine.
If you don't know the name at compile time, you'll have to inject the subroutine into the symbol table, so you were close with that last one.
sub inject_method {
my($object, $method_name, $code_ref) = #_;
# Get the class of the object
my $class = ref $object;
{
# We need to use symbolic references.
no strict 'refs';
# Shove the code reference into the class' symbol table.
*{$class.'::'.$method_name} = $code_ref;
}
return;
}
inject_method($obj, "new_method", sub { ... });
Methods in Perl are associated with a class, not an object. In order to assign a method to a single object, you have to put that object into its own class. Similar to the above, but you have to create a subclass for every instance.
my $instance_class = "_SPECIAL_INSTANCE_CLASS_";
my $instance_class_increment = "AAAAAAAAAAAAAAAAAA";
sub inject_method_into_instance {
my($object, $method_name, $code_ref) = #_;
# Get the class of the object
my $old_class = ref $object;
# Get the special instance class and increment it.
# Yes, incrementing works on strings.
my $new_class = $instance_class . '::' . $instance_class_increment++;
{
# We need to use symbolic references.
no strict 'refs';
# Create its own subclass
#{$new_class.'::ISA'} = ($old_class);
# Shove the code reference into the class' symbol table.
*{$new_class.'::'.$method_name} = $code_ref;
# Rebless the object to its own subclass
bless $object, $new_class;
}
return;
}
I left out the code to check whether or not the instance has already had this treatment by checking if its class matches /^${instance_class}::/. I leave that as an exercise for you. Creating a new class for every object is not cheap and will cost memory.
There are valid reasons to do this, but they are exceptional. You should really, really question whether you should be doing this sort of monkey patching. In general, action at a distance should be avoided.
Can you accomplish the same thing using a subclass, delegation or role?
There already exist Perl OO systems which will do this for you and much much more. You should be using one. Moose, Moo (via Role::Tiny) and Mouse can all add roles to an instance.

Is there a way to know the methods of an instance of an unknown class in Perl

I have a program in Perl that uses a package that I got from another source. One of the functions of the method returns an object of an unknown class, Is there a way for me to get all the possible methods of an object without looking at its class implementation?
Not really.
TL;DR:
You can find the names of subroutines explicitly declared or placed into the object's class's namespace.
You can NOT distinguish which of these subroutines are object methods on your object, and which are class or non-object subs (this is the most serious problem/limintation among those listed).
You can NOT find the methods inherited by an object in the subclass from the superclass using this method, unless they were already called on your object.
This can be coded around, by either inspecting #ISA of the class to build up inheritance trees, or using on of proper CPAN modules.
You can NOT find the methods that are dynamically added to the class (AUTOLOAD, manual method injection in the code somewhere).
In detail
You can find all of the subroutines in that class (by combining the fact that the class namespace is a hash so all identifiers in it are keys in that hash; and the UNIVERSAL::can call to separate subroutines).
Therefore, if you are GUARANTEED (by non-technical contract) that 100% of subroutines in the class are object methods, AND that your class is NOT a subclass, you can find their list.
package MyClass;
use vars qw($z5);
my $x = 11; our $y = 12; $z5 = 14; %z2 = (1=>2); # my, our, globals, hash
sub new { return bless({}, $_[0]) }; # Constructor
sub x1 { my $self = shift; print $_[0]; };
sub y2 { my $self = shift; print $_[0]; };
##############################################################################
package MySubClass;
use vars qw(#ISA);
#ISA = ("MyClass");
sub z3 { return "" };
##############################################################################
package main;
use strict; use warnings;
my $obj = MyClass->new();
list_object_methods($obj);
my $obj2 = MySubClass->new();
list_object_methods($obj2);
$obj2->x1();
list_object_methods($obj2); # Add "x1" to the list!
sub list_object_methods {
my $obj = shift;
my $class_name = ref($obj);
no strict;
my #identifiers = keys %{"${class_name}::"};
use strict;
my #subroutines = grep { UNIVERSAL::can($obj, $_) } #identifiers;
print "Class: ${class_name}\n";
print "Subroutines: \n=========\n"
. join("\n", sort #subroutines) . "\n=========\n";
}
... prints:
Class: MyClass
Subroutines:
=========
new
x1
y2
=========
Class: MySubClass
Subroutines:
=========
new
z3
=========
Class: MySubClass
Subroutines:
=========
new
x1
z3
=========
Please note that the first-time list (for MySubClass) printed new and z3 but NOT x1 or y2 - because new was executed and z3 was declared in the class; but x1 and y2 was neither - they were merely theoretically inherited. BUT, once we executed an inherited x1 method, then the second-time list included it, while still missing inherited y2.
But you can NOT, unfortunately, distinguish a subroutine that is an object method (e.g. treats the first argument it gets as an object), a class method (e.g. treats the first argument it gets as a class name) or a non-OO sub (treats first argument as regular argument).
To distinguish between the 3, the ONLY way is to actually semantically analyze the code. Otherwise, you can't tell the difference between:
sub s_print_obj {
my ($self, $arg1) = #_;
$s->{arg1} = $arg1;
print "$arg1\n";
}
# $obj->s_print_obj("XYZ") prints "XYZ" and stores the data in the object
sub s_print_class {
my ($class, $arg1) = #_;
print "Class: $class\n";
print "$arg1\n";
}
# $obj->s_print_class("XYZ") prints "Class: MyClass\nXYZ\n"
sub s_print_static {
my ($self, $arg1) = #_;
print "$arg1\n";
}
# $obj->s_print_static("XYZ") prints stringified representation of $obj
NOTE: As a matter of fact, some people actually write their class's methods - those that CAN work this way - to explicitly work in ALL 3 (or first 2) cases, no matter how the method is called.
DVK's answer is accurate, but a bit lengthy. The short answer is yes you can, but you won't know what was intended as a public object method and what wasn't. Private methods and functions imported from other modules may show up.
Simplest way to get the list of callable, concrete (ie. non-AUTOLOAD) methods is to use the perl5i meta object's methods() method.
use perl5i::2;
my $object = Something::Something->new;
my #methods = $object->mo->methods;
That at least eliminates a lot of code.

Method not found error when inheriting abstract method in Perl OOP

I have a subclass that calls a method from a superclass. The method in the superclass uses a method that is defined in the superclass as abstract (not really abstract) but implemented in the subclass.
For example:
package BaseClass;
sub new
{
}
sub method1 {
return someAbstractMethod();
}
sub someAbtsractMethod
{
die "oops, this is an abstract method that should " .
"be implemented in a subclass" ;
}
1;
package SubClass;
sub new
{
}
sub someAbtsractMethod
{
print "now we implement the asbtract method";
}
1;
Now when I do:
$sub = new SubClass();
$sub->method1();
...it calls the abstract message and I get the specified error message. If I took off the abstract method from the super class and just leave the implementation in the subclass, It does not recognize the method and I get subroutine abstract method not found error.
You haven't set up an IS_A relationship between the parent and child classes.
You can do this with the base pragma as Ivan suggests, or you can manipulate the #ISA array. Or you can use the parent pragma.
#ISA:
package SubClass;
our #ISA = qw( BaseClass );
parent:
package SubClass;
use parent qw( BaseClass );
By the way, don't use the indirect object syntax ever. To call your constructor do:
my $foo = SubClass->new();
Also, it looks like you aren't using the strict and warnings pragmas. Do so. Always.
Finally, if you have multiple packages in one file, it is helpful to enclose each package in a block.
Check out perlboot and perltoot, they are handy OOP tutorials in the perldoc.
Update:
I just noticed that your method calls are broken. You need to find the invoking class or instance in each method.
package BaseClass;
sub new { bless {}, shift; } # horrible constructor - do not reuse.
sub abstract { die "The present situation is abstract"; }
sub method { my $self = shift; $self->abstract; }
package SubClass;
our #ISA = qw( BaseClass );
sub abstract { print "It's alive\n" );
In the script:
my $obj = SubClass->new;
$obj->method;
my $base = BaseClass->new;
$base->method;
Definitely read the tutorials I linked to. They will help you.
There are some problems with your code, you need to tell the subclass what its parent class is. You also probably need to setup your constructors to pass through to the parent class. There were also a few misspellings in there.
package BaseClass;
sub new {
bless {} => shift;
}
sub method1 {
my $self = shift;
return $self->someAbstractMethod();
}
sub someAbstractMethod
{
die "oops, this is an abstract method that should " .
"be implemented in a subclass";
}
package SubClass;
use base 'BaseClass';
sub new {
shift->SUPER::new
}
sub someAbstractMethod
{
print "now we implement the asbtract method\n";
}
package main;
my $obj = BaseClass->new;
eval {$obj->method1(); 1} or warn $#;
my $subobj = SubClass->new;
$subobj->method1();
Your fundamental problem is that you're not using method calls at all. Had you done
sub method1 {
my $self = shift;
$self->someAbstractMethod();
}
in the base class (and assuming inheritance was set up properly) then things would work. But when you write someAbstractMethod() that's not a method call, it's a function call, so it's resolved immediately at compile-time, without any regard for polymorphism (what the type of the object is).
If you are just starting out with Perl OO dont forget to check out Moose. See also Moose::Manual::Unsweetened for a comparison of Moose with regular Perl 5 OOP style.

Is this the equivalent function call to a Perl constructor call?

I can have a constructor like this :
sub create {
my $class = shift;
my $self = {};
return bless $self,$class;
}
and when I create an object, I can write this:
my $object = create Object;
Is this:
my $object = Object::create("Object");
the only equivalent to that constructor call?
No, the equivalent call is
my $object = Object->create();
If you use the fully qualified name of the create function without the arrow syntax, you aren't going through Perl's OO method dispatch, and therefore any inherited methods will not work.
The arrow syntax is preferred over the "indirect" create Object syntax. For the reasons why, see this question.