As per the title, I'm working on an awkward bit of code that makes use of multiple inheritance and requires that the two SUPER functions both be called. Is there a way of indicating to Perl which of the two parent classes I want to run the function from? Using $self->SUPER::foo($bar); only runs the first matching function in #ISA as per the documentation.
The following gives an idea of how the classes are inherited:
[Base Class]
|
----------------------------
| |
[A] [B]
| |
----------------------------
|
[C]
Just specify it:
$self->A::foo($bar)
or
$self->B::foo($bar)
You may also want to look at mro.
There are a number of options.
If there are always just two candidate superclasses, you can force #ISA to be searched in both directions, so
$self->SUPER::method;
{
local #ISA = reverse #ISA;
$self->SUPER::method;
}
or if you want to do something cleverer, you can build the names of all the superclasses' methods at runtime:
my ($caller) = (caller(0))[3] =~ /([^:]+)\z/;
for my $super (#ISA) {
my $method = join '::', $super, $caller;
$self->$method if exists &$method;
}
The first line fetches the name of the currently-executing method and strips off the package name information to leave just the bare name. Then it is appended to each package name in #ISA and the method is called if it exists.
Related
Sorry to bother the community for this but I have unfortunately to code in Perl :'(. It is about an OO perl code I want to understand but I am failing to put all the pieces together.
The following is a template of code that represents somehow what I am currently looking at. The following is the class MyClass:
package Namespace::MyClass;
sub new($)
{
my ($class) = #_;
$self = { };
bless ($self, $class);
}
sub init($$)
{
my ($self, $param1) = #_;
$self->{whatever} = ($param1, $param1, $param1);
}
and then the following is a script.pl that supposedly uses the class:
#!/path/to/your/perl
require Namespace::MyClass;
my myClass = new Namespace::MyClass()
myClass->init("data_for_param1");
There may be error but I am interested more in having the following questions answered than having my possibly wrong code corrected:
Questions group 1 : "$" in a sub definition means I need to supply one parameter, right? If so, why does new ask for one and I do not supply it? Has this to do with the call in the script using () or something similar to how Python works (self is implied)?
Question group 2 : is for the same previous reason that the init subroutine (here a method) declares to expect two parameters? If so, is the blessing in some way implying a self is ever passed for all the function in the module?
I ask this because I saw that in non blessed modules one $ = one parameter.
Thank you for your time.
QG1:
Prototypes (like "$") mean exactly nothing in Method calls.
Method calls are not influenced by prototypes either, because the function to be called is indeterminate at compile time, since the exact code called depends on inheritance.
Most experienced Perl folk avoid prototypes entirely unless they are trying to imitate a built-in function. Some PHBs inexperienced in Perl mandate their use under the mistaken idea that they work like prototypes in other languages.
The 1st parameter of a Method call is the Object (Blessed Ref) or Class Name (String) that called the Method. In the case of your new Method that would be 'Namespace::MyClass'.
Word to the wise: Also avoid indirect Method calls. Rewrite your line using the direct Method call as follows: my $myClass = Namespace::MyClass->new;
QG2:
Your init method is getting $myClass as it's 1st parameter because it is what 'called' the method. The 2nd parameter is from the parameter list. Blessing binds the name of the Class to the Reference, so that when a method call is seen, It knows which class in which to start the search for the correct sub. If the correct sub is not immediately found, the search continues in the classes named in the class's #ISA array.
Don't use prototypes! They don't do what you think they do.
Prototypes in Perl are mainly used to allow functions to be defined without the use of parentheses or to allow for functions that take array references to use the array name like pop or push do. Otherwise, prototypes can cause more trouble and heartbreak than experienced by most soap opera characters.
is what you actually want to do validate parameters? if so then that is not the purpose of prototypes. you could try using signatures, but for some reason they are new and still experimental. some consider lack of a stable signatures feature to be a flaw of perl. the alternatives are CPAN and writing code in your subs/methods that explicitly validate the params.
I have several (~100 and counting) MySQL tables with more than 50M entries each. The thing is that all this tables have exactly the same structure and I would like to create a single result class for them in DBIx::class.
For example consider a bunch of tables of the following structure:
CREATE TABLE users_table_1 (
name TINYTEXT,
username TINYTEXT
);
CREATE TABLE users_table_2 (
name TINYTEXT,
username TINYTEXT
);
...
I would like to be able to do the following without having to create a result class for each one of the tables.
my $users_1_rs = $schema->resultset('User_table_1');
my $users_2_rs = $schema->resultset('User_table_2');
...
I am new to DBIx::Class and the only two possible solutions that I could come up with are:
For each of the tables use something like DBIx::Class::DynamicSubclass to subclass from a base result class with all common functionality. The disadvantage is that this way I still need to write a class (although a small one) for every single one of my tables.
Use DBIx::Class::Loader and create the classes automatically from the database itself. However, I don't find this solution very elegant and robust for my needs.
Could someone point me to a more elegant solution for this problem?
There is probably a metaprogramming API within DBIx::Class for dynamically creating table classes.
In lieu of delving into the (rather large DBIx::Class) docs here is an alternative example creating the classes in plain Perl metaprogramming:
package MySchema;
use strict;
use warnings;
use parent 'DBIx::Class::Schema';
our #tables = map { 'users_table_' . $_ } 1..2;
require DBIx::Class::Core;
# build table classes for users_tables_*
for my $table (#MySchema::tables) {
my $t = "MySchema::$table";
{
no strict 'refs';
#{$t . '::ISA'} = qw/DBIx::Class::Core/;
}
$t->table($table);
$t->add_columns(qw/name username/);
}
__PACKAGE__->load_classes(#MySchema::tables);
1;
In my simple tests the above worked for me :)
I would sugest using "from" parameter in search function:
...resultset('TableA')->search({}, { from=>'TableB'});
I am unable to figure out an explanation on how polymorphism works in Perl. I understand what polymorphism means but I am trying to figure out how it internally works within perl. Can someone point me to some documentation that explains it. All the google searches I have done gives me examples of what polymorphism is in perl but not how perl makes it work.
When a method is invoked on an object or class, Perl looks to see if that method is provided directly by the class itself.
Because classes are simply Perl packages, it is simply a matter of looking for the existence of a subroutine &Class::method.
If no such subroutine is found, Perl examines the #ISA array in the same package (i.e. #Class::ISA) which contains a list of base classes for the class, and does the same check for every package/class that appears in there.
Each of those classes in turn may also have an #ISA array, so the search is recursive.
Finally, if the method is found nowhere by this method, Perl looks in a special package UNIVERSAL for a subroutine &UNIVERSAL::method.
A failure at this point goes on to invoke the AUTOLOAD system, but that is really beyond the principle of polymorphism.
A failure to find a suitable matching method anywhere raises an exception.
Chapter 7 from Object Oriented Perl, Damian Conway, Manning (2000) is called Polymorphism. Ten pages.
Be advised, however, in case you're coming from C++ or Java or C# or similar, that there's not so much to know about "polymorphism" in Perl. I'd even say the concept of polymorphism makes things more complicated than they are in Perl.
I think the mechanism a Perl programmer should be striving to understand is how method lookup works. The answer is: depth-first recursive scanning through the #ISA arrays of packages.
An example, let's do $o->bla. Our $o is blessed into the A package, which doesn't have an implementation of bla. But it inherits from first B and then C (#ISA = ('B', 'C')). So let's do a lookup in B first. It doesn't define the method either. If it had parent classes, we'd continue our lookup there. But it doesn't. So we now look into C, and fortunately it does have the method, else that would be a runtime error, because the package of last resort, UNIVERSAL, doesn't define bla either.
An object method call is basically an optimised* version of the following:
my $class = ref($_[0]);
my #isa = mro::get_linear_isa($class);
for my $pkg (#isa) {
if (exists(&{$pkg.'::'.$method_name})) {
return &{$pkg.'::'.$method_name};
}
}
ref gets the name of the class associated with the object. The class is stored in the object's variable.
$ perl -MDevel::Peek -e'my $o = {}; Dump($o); bless($o, "SomeClass"); Dump($o);'
SV = IV(0x9e4ae0c) at 0x9e4ae10
REFCNT = 1
FLAGS = (PADMY,ROK)
RV = 0x9e317d0
SV = PVHV(0x9e36808) at 0x9e317d0
REFCNT = 1
FLAGS = (SHAREKEYS)
ARRAY = 0x0
KEYS = 0
FILL = 0
MAX = 7
RITER = -1
EITER = 0x0
SV = IV(0x9e4ae0c) at 0x9e4ae10
REFCNT = 1
FLAGS = (PADMY,ROK)
RV = 0x9e317d0
SV = PVHV(0x9e36808) at 0x9e317d0
REFCNT = 1
FLAGS = (OBJECT,SHAREKEYS) <----
STASH = 0x9e323d0 "SomeClass" <----
ARRAY = 0x0
KEYS = 0
FILL = 0
MAX = 7
RITER = -1
EITER = 0x0
get_linear_isa is based on #ISA in package $class, and the #ISA of the packages named therein.
Since the class name is in the object and since Perl can check its symbol table at run-time, a virtual method table isn't needed to provide polymorphism.
* — It caches which package provides method $method_name for class $class. Also, it surely doesn't calculate the whole linear ISA upfront, but as needed.
This well suits inheritance-based polymorphism and gives some idea of what Perl does specifically. I have always used chapter 12.5. Class Inheritance in Programming Perl as a reference for these things.
Polymorphism is simply the idea that objects of different types respond to method calls of the same name. Weakly typed languages, such as Perl, are "implicitly polymorphic".
For example, a CGI object, an Apache2::Request object, and a Plack::Request object all have a param method that will return the parameters of an HTTP request. I could write a function that accepts an object as a parameter, and call the param method on that object, and get an HTTP request parameter, without knowing what type of object it is.
Strongly typed languages don't work this way because their functions specify the data types of their parameters. I can't call a function in Java with an object of type Dog if it was expecting one of Cat. So the strongly typed languages have to create special mechanisms to allow for polymorphism.
Can you intercept a method call in Perl, do something with the arguments, and then execute it?
Yes, you can intercept Perl subroutine calls. I have an entire chapter about that sort of thing in Mastering Perl. Check out the Hook::LexWrap module, which lets you do it without going through all of the details. Perl's methods are just subroutines.
You can also create a subclass and override the method you want to catch. That's a slightly better way to do it because that's the way object-oriented programming wants you do to it. However, sometimes people write code that doesn't allow you to do this properly. There's more about that in Mastering Perl too.
To describe briefly, Perl has the aptitude to modify symbol table. You call a subroutine (method) via symbol table of the package, to which the method belongs. If you modify the symbol table (and this is not considered very dirty), you can substitute most method calls with calling the other methods you specify. This demonstrates the approach:
# The subroutine we'll interrupt calls to
sub call_me
{
print shift,"\n";
}
# Intercepting factory
sub aspectate
{
my $callee = shift;
my $value = shift;
return sub { $callee->($value + shift); };
}
my $aspectated_call_me = aspectate \&call_me, 100;
# Rewrite symbol table of main package (lasts to the end of the block).
# Replace "main" with the name of the package (class) you're intercepting
local *main::call_me = $aspectated_call_me;
# Voila! Prints 105!
call_me(5);
This also shows that, once someone takes reference of the subroutine and calls it via the reference, you can no longer influence such calls.
I am pretty sure there are frameworks to do aspectation in perl, but this, I hope, demonstrates the approach.
This looks like a job for Moose! Moose is an object system for Perl that can do that and lots more. The docs will do a much better job at explaining than I can, but what you'll likely want is a Method Modifier, specifically before.
You can, and Pavel describes a good way to do it, but you should probably elaborate as to why you are wanting to do this in the first place.
If you're looking for advanced ways of intercepting calls to arbitrary subroutines, then fiddling with symbol tables will work for you, but if you want to be adding functionality to functions perhaps exported to the namespace you are currently working in, then you might need to know of ways to call functions that exist in other namespaces.
Data::Dumper, for example, normally exports the function 'Dumper' to the calling namespace, but you can override or disable that and provide your own Dumper function which then calls the original by way of the fully qualified name.
e.g.
use Data::Dumper;
sub Dumper {
warn 'Dumping variables';
print Data::Dumper::Dumper(#_);
}
my $foo = {
bar => 'barval',
};
Dumper($foo);
Again, this is an alternate solution that may be more appropriate depending on the original problem. A lot of fun can be had when playing with the symbol table, but it may be overkill and could lead to hard to maintain code if you don't need it.
Yes.
You need three things:
The arguments to a call are in #_ which is just another dynamically scoped variable.
Then, goto supports a reference-sub argument which preserves the current #_ but makes another (tail) function call.
Finally local can be used to create lexically scoped global variables, and the symbol tables are buried in %::.
So you've got:
sub foo {
my($x,$y)=(#_);
print "$x / $y = " . ((0.0+$x)/$y)."\n";
}
sub doit {
foo(3,4);
}
doit();
which of course prints out:
3 / 4 = 0.75
We can replace foo using local and go:
my $oldfoo = \&foo;
local *foo = sub { (#_)=($_[1], $_[0]); goto $oldfoo; };
doit();
And now we get:
4 / 3 = 1.33333333333333
If you wanted to modify *foo without using its name, and you didn't want to use eval, then you could modify it by manipulating %::, for example:
$::{"foo"} = sub { (#_)=($_[0], 1); goto $oldfoo; };
doit();
And now we get:
3 / 1 = 3
I am writing a Perl module Galaxy::SGE::MakeJobSH with OO.
I want to use MakeJobSH->new() instead of Galaxy::SGE::MakeJobSH->new(),
or some other shortnames. How can I do that?
You can suggest that your users use the aliased module to load yours:
use aliased 'Galaxy::SGE::MakeJobSH';
my $job = MakeJobSH->new();
Or you could export your class name in a variable named $MakeJobSH;
use Galaxy::SGE::MakeJobSH; # Assume this exports $MakeJobSH = 'Galaxy::SGE::MakeJobSH';
my $job = $MakeJobSH->new();
Or you could export a MakeJobSH function that returns your class name:
use Galaxy::SGE::MakeJobSH; # Assume this exports the MakeJobSH function
my $job = MakeJobSH->new();
I'm not sure this is all that great an idea, though. People don't usually have to type the class name all that often.
Here's what you'd do in your class for the last two options:
package Galaxy::SGE::MakeJobSH;
use Exporter 'import';
our #EXPORT = qw(MakeJobSH $MakeJobSH);
our $MakeJobSH = __PACKAGE__;
sub MakeJobSH () { __PACKAGE__ };
Of course, you'd probably want to pick just one of those methods. I've just combined them to avoid duplicating examples.
I don't bother with aliasing. I think it's the wrong way to go. If you're just looking for less to type, it might be the answer (but is a new dependency more benefit than risk?). I don't like the idea of tricking a maintenance programmer by hiding the real name from him since the aliasing happens a long way away from its use and there's no indication that what looks like a class name isn't a real class.
I'm mostly looking for easy subclassing, so I let the class decide for itself which module will implement a part.
For instance, I might start with a class that wants to use Foo to handle part of the job. I know that I might want to subclass Foo later, so I don't hard-code it:
package Foo::Bar;
sub foo_class { 'Foo' }
sub new {
....
eval "require $self->foo_class";
$self->foo_class->do_something;
}
In the application, I choose to use 'Foo::Bar':
#!perl
use Foo::Bar;
my $obj = Foo::Bar->new();
Later, I need to specialise Foo, so I create a subclass overrides the parts I need:
package Foo::Bar::Baz;
use parent 'Foo::Bar';
sub foo_class { 'Local::Foo::SomeFeature' }
1;
Another application uses almost all of the same stuff, but with the small tweak:
#!perl
use Foo::Bar::Baz;
my $obj = Foo::Bar::Baz->new();
You can also do a similar thing at the application level if you want to write one program and let users choose the class through configuration.
Thanks cjm.
I just choose to inline aliased.
require Exporter;
our #ISA = qw(Exporter);
our #EXPORT = qw(MakeJobSH);
sub MakeJobSH() {return 'Galaxy::SGE::MakeJobSH';}
aliased works well when you want to only affect calls from packages that explicitly request the aliasing. If you want global aliasing of one namespace to another, use Package::Alias instead.
It is almost exactly same approach as aliased but using standard Perl module:
use constant MakeJobSH => 'Galaxy::SGE::MakeJobSH';
my $job = MakeJobSH->new();