How can I find all the packages that inherit from a package in Perl? - perl

I have a number of different sites that I download data from and massage into other formats (using Perl) for use at work, that are all run from one Perl script kinda like so:
#! /usr/bin/perl
use strict;
use My::Package1;
use My::Package2;
my $p1 = My::Package1->new;
$p1->download;
my $p2 = My::Package2->new;
$p2->download;
and so on and so forth. At the moment each My::Package is its own package; it doesn't inherit from a base package or anything. I am planning to re-write them using Moose and I was hoping that rather than having to edit the Perl script that runs the download each time a new package is added, there might be a way of finding packages that inherit from a base package, and then in a loop instantiate each and do the downloading, kinda like so:
#! /usr/bin/perl
use strict;
for my $pname (packages_that_inherit_from("My::Package")) {
my $package = $pname->new;
$package->download;
}
Is it, or something ilke it, possible?
TIA

Using Moose's Class::MOP underpinning you can find the subclasses assigned to each class (at that point in time).
From Class::MOP::Class docs:
$metaclass->subclasses
This returns a list of all subclasses for this class, even indirect subclasses.
$metaclass->direct_subclasses
This returns a list of immediate subclasses for this class, which does not include indirect subclasses.
So for example if we build these classes:
{
package Root;
use Moose;
use namespace::clean -except => 'meta';
sub baz { say 'Some root thingy' }
sub download { say "downloading from " . __PACKAGE__ }
}
{
package NodeA;
use Moose;
extends 'Root';
use namespace::clean -except => 'meta';
sub download { say "downloading from " . __PACKAGE__ }
}
{
package NodeA1;
use Moose;
extends 'NodeA';
use namespace::clean -except => 'meta';
sub download { say "downloading from " . __PACKAGE__ }
}
Then using your example as a basis we can do this:
for my $pname ( Root->new->meta->direct_subclasses ) {
my $package = $pname->new;
$package->download;
}
# => "downloading from NodeA"
So above runs NodeA->download. Changing above to meta->subclasses would also run the NodeA1->download.
/I3az/

Although you say you are moving to Moose, a non-Moose way is to put all the derived packages in the known subdirectory based on the base package name. You then load all of the modules
For instance, if your base package is Local::Downloader, all the derived packages start with Local::Downloader::Plugin or something similar. You then look for all modules in your #INC that much .../Local/Downloader/Plugin/.... Although it's not too hard to do yourself, something like Module::PluginFinder can do it for you too.

What you are asking for wont be possible because none of the packages you are looking to use will be loaded yet. Why not place all of the packages in a common directory, and then have your script open that directory, and for each file, require it, and then instantiate your objects.

There's no way to do this based on inheritance because the parent class doesn't even know if it has descendants, never mind how many it has or what their names are.
However, if you follow the common convention of using hierarchal namespaces and naming the descendants as Parent::Foo, Parent::Bar, etc., you can approximate this by using Module::Pluggable to load up everything under the Parent namespace:
use Module::Pluggable require => 1, search_path => ['Parent'];
my #descendants = plugins();
Since this is based on the namespaces, though, it will pull in Parent::Helper::ThatIsNotAChild, while missing Child::NotUnder::Parent::Namespace, so it's not entirely perfect.

Related

How to create globally available functions in Perl?

Is it possible to create global functions available across all namespaces like perl built-in functions?
First of all, "function" is the name given to Perl's named list operators, named unary operators and named nullary operators. They are visible everywhere because they are operators, just like ,, && and +. Subs aren't operators.
Second of all, you ask how to create a global sub, but all subs are already global (visible from everywhere) in Perl! You simply need to quality the name of the sub with the package if it's not in the current package. For example, Foo::mysub() will call my_sub found in package Foo from anywhere.
But maybe you want to be able to say mysub() instead of Foo::mysub() from everywhere, and that's a very bad idea. It violates core principles of good programming. The number of types of problems it can cause are too numerous to list.
There is a middle ground. A better solution is to create a sub that can be imported into the namespaces you want. For example, say you had the module
package Foo;
use Exporter qw( import );
our #EXPORT_OK = qw( my_sub );
our %TAGS = ( ALL => \#EXPORT_OK );
sub my_sub { ... }
1;
Then, you can use
use Foo qw( my_sub );
to load the module (if it hasn't already been loaded) and create my_sub in the current package. This allows it to call the sub as my_sub() from the package into which it was imported.
There is nothing simple that would allow one to somehow "register" user's subs with the interpreter, or some such, so that you could run them as builtins in any part of the program.
One way to get the behavior you ask for is to directly write to symbol tables of loaded modules. This has to be done after the modules have been loaded, and after subs that you add to those modules have been defined. I use INIT block in the example below.
Note that this has a number of weaknesses and just in general the idea itself is suspect to me, akin to extending the interpreter. Altogether I'd much rather write a module with all such subs and use standard approaches for good program design to have that module loaded where it needs to go.
Having said that, here is a basic demo
use warnings;
use strict;
use feature 'say';
use Data::Dump qw(dd pp);
use TestMod qw(modsub);
sub t_main { say "In t_main(), from ", __PACKAGE__ }
modsub("Calling from main::");
INIT {
no strict 'refs';
foreach my $pkg (qw(TestMod)) {
*{ $pkg . '::' . 'sub_from_main' } = \&t_main;
}
dd \%TestMod::;
}
This copies the reference to t_main from the current package (main::) into the symbol table of $pkg, under the name of sub_from_main, which can then be used with that name in that package.
For simplicity the name of the module is hardcoded, but you can use %INC instead, and whatever other clues you have, to figure out what loaded modules' stashes to add to.
The benefactor (or the victim?) module TestMod.pm
package TestMod;
use warnings;
use strict;
use feature 'say';
use Exporter qw(import);
our #EXPORT_OK = qw(modsub);
sub modsub {
say "In module ", __PACKAGE__, ", args: #_";
say "Call a sub pushed into this namespace: ";
sub_from_main();
}
1;
The name of the added sub can be passed to modules as they're loaded, instead of being hardcoded, in which case you need to write their import sub instead of borrowing the Exporter's one.
There are also modules that allow one to add keywords, but that's no light alternative.
The answer seems to be no, but you can impliment most of the behaivior that you want by using the symbol table *main::main:: to define a subroutine in all the namespaces.
use strict;
use warnings;
use Data::Dump qw(dd);
my $xx = *main::main::;
package A;
sub test {
printf "A::%s\n", &the_global;
}
package B;
sub the_global
{
"This is B::the_global";
}
sub test {
printf "B::%s\n", &the_global;
}
package main;
my $global_sub = sub { "The Global thing" };
for my $NS (keys %$xx) {
if ($NS =~ /^[A-Z]::$/) {
my $x = $NS . 'the_global';
if (defined &$x) {
printf "Skipping &%s\n", $x;
} else {
printf "Adding &%s\n", $x;
no strict 'refs';
*$x = $global_sub;
}
}
}
A::test;
This will not work on packages that are not referenced at all before the for loop above is run. But this would only happen if a require, use or package was eval'd after the code started running.
This is also still a compiler issue! You either need to refer to the global function as the_global() or &the_global if you are (as you should be) using use strict.
Sorry for my late response and thank you all for yours detailed answers and explanations.
Well.. I understood the right answer is: IT'S NOT POSSIBLE!
I'm mantaining a Perl framework used by some customers, and that framework exports some specialized subs (logging, event handling, controllers for hardware devices, domain specific subs and so). That's why I tried to figure out how to prevent the developers from importing my subs in all their packages.

Can't locate object method via package subclassing DBI

this is my first foray into subclassing with perl and I am wondering why I am getting this simple error...
"Can't locate object method "prepare" via package "WebDB::st" at /home/dblibs/WebDB.pm line 19.". It seems to find the module WebDB ok, but not the prepare subroutine in ::st
First here's my package (both packages are in one file, WebDB.pm)
package WebDB;
use strict;
use DBI;
sub connect {
my $dbh = (DBI->connect ("DBI:mysql:test:127.0.0.1", "root","",
{ PrintError => 1, RaiseError => 0 }));
return bless $dbh, 'WebDB::st';
}
package WebDB::st;
our #ISA = qw(::st);
sub prepare {
my ($self, $str, #args) = #_;
$self->SUPER::prepare("/* userid:$ENV{USER} */ $str", #args);
}
1;
I also tried replacing the "our #ISA = qw(;;st)" with "use base 'WebDB'" and same problem.
I'm thinking it's probably something very simple that I'm overlooking. Many thanks! Jane
Subclassing DBI has to be done just right to work correctly. Read Subclassing the DBI carefully and properly set RootClass (or explicitly call connect on your root class with #ISA set to DBI). Make sure you have WebDB::st subclassing DBI::st and a WebDB::db class subclassing DBI::db (even if there are no methods being overridden). No need to rebless.
Avoid using base; it has some unfortunate behavior that has led to its deprecation, particularly when used with classes that are not in a file of their own.
Either explicitly set #ISA or use the newer parent pragma:
package WebDB;
use parent 'DBI';
...
package WebDB::db;
use parent -norequire => 'DBI::db';
...
package WebDB::st;
use parent -norequire => 'DBI::st';
...
Are WebDB and WebDB::st in one file or two? If they are in separate files, I don't see anything that is doing a use WebDB::st;, which would cause that file to be loaded.
You can do either of these things as a remedy -- put the two packages in the same file (that would look exactly as you have pasted it above), or add a use WebDB::st; line in WebDB.pm.
(I'd also add use strict; use warnings; in both these packages too.)
Also, the prepare function is not in ::st -- there is no such package (unless it is defined elsewhere). prepare is in the WebDB::st namespace -- via the package declaration. You are however declaring that WebDB::st has ::st as a parent.
If subclassing is as tricky as ysth seems to think, I might recommend Class::Delegator from CPAN. I use if for classes that want to act like IO. And by it, Perl is the first language (that I am aware of) that has an expression language for aggregation, delegation, encapsulation almost equal with inheritance.
package WebDB;
use strict;
use DBI;
use Class::Delegator
send => [ qw<connect ...> ]
, to => '{_dbihandle}'
...
;

Do Perl subclasses inherit imported modules and pragmas?

Lets say you have a parent Perl class in one file:
#!/usr/bin/perl
package Foo;
use strict;
use warnings;
use Data::Dumper;
sub new{
my $class = shift;
my %self = ();
return bless %self, $class;
}
1;
and a subclass in a different file:
#!/usr/bin/perl
package Bar;
use base "Foo";
1;
Will the subclass inherit the use statements from the parent? I know the method new will be inherited.
Basically I am trying to reduce the amount of boilerplate in my code and I can't find a clear answer to this question.
You asked in a comment about Test::Most and how it reduces boilerplate. Look at its import method. It's loading the modules into its namespace, adding those symbols to #EXPORT, then re-calling another import through a goto to finally get them into the calling namespace. It's some serious black magic that Curtis has going on there, although I wonder why he just didn't use something like import_to_level. Maybe there are some side effects I'm not thinking about.
I talk quite a bit about this sort of thing in Avoid accidently creating methods from module exports in The Effective Perler. It's in a different context but it's some of the same issues.
Here's a different example.
If some other module loads a module, you have access to it. It's not good to depend on that though. Here are three separate files:
Top.pm
use 5.010;
package Top;
use File::Spec;
sub announce { say "Hello from top!" }
1;
Bottom.pm
package Bottom;
use parent qw(Top);
sub catfiles { File::Spec->catfile( #_ ) }
1;
test.pl
use 5.010;
use Bottom;
say Bottom->catfiles( qw(foo bar baz) );
say File::Spec->catfile( qw( one two three ) );
I only load File::Spec in Top.pm. However, once loaded, I can use it anywhere in my Perl program. The output shows that I was able to "use" the module in other files even though I only loaded it in one:
Bottom/foo/bar/baz
one/two/three
For this to work, the part of the code that loads the module has to load before any other part of the code tries to use that module. As I said, it's a bad idea to depend on this: things break if the loading sequence changes or the loading module disappears.
If you want to import symbols, however, you have to explicitly load the module you want while you are in the package you want to import into. That's just so the exporting module defines the symbols in that package. It's not something that depends with scope.
Ah, good question!
Will the subclass inherit the use statements from the parent?
Well this depends on what you mean by inherit. I won't make any assumptions until the end, but the answer is maybe. You see, perl mixes the ideas of Classes, and Namespaces -- a package is a term that can describe either of them. Now the issue is the statement use all it does is force a package inclusion, and call the targets import() sub. This means it essentially has unlimited control over your package - and by way of that your class.
Now, compound this with all methods in perl being nothing more than subs that take $self as a first argument by convention and you're left with perl5. This has an enormous upside for those that know how to use it. While strict is a lexical pragma, what about Moose?
package BigMooseUser;
use Moose;
package BabyMooseUser;
our #ISA = 'BigMooseUser';
package Foo;
my $b = BabyMooseUser->new;
print $b->meta->name;
Now, where did BabyMooseUser get the constructor (new) from? Where did it get the meta class from? All of this is provided from a single use Moose; in the parent class (namespace). So
Will the subclass inherit the use statements from the parent?
Well, here, in our example, if the effects of the use statement are to add methods, than certainly.
This subject is kind of deep, and it depends if you're talking about pragmas, or more obscure object frameworks, or procedural modules. If you want to mitigate a parents namespace from affecting your own in the OO paradigm see namespace::autoclean.
For boilerplate reduction, I have a couple of strategies: Most of my classes are Moose classes, which takes care of OO setup and also gives me strict and warnings. If I want to have functions available in many packages, I'll create a project specific MyProject::Util module that uses Sub-Exporter to provide me with my own functions and my own interface. This makes it more consistent, and if I decide to change the Dumper (for example) later for whatever reason, I don't have to change lots of code. That'll also allow you to group exports. A class then usually looks something like this:
package Foo;
use Moose;
use MyProject::Util qw( :parsing :logging );
use namespace::autoclean;
# class implementation goes here
1;
If there's other things you regard as boilerplate and want to make simpler to include, it of course depends on what those things are.
A pragmatic answer to your problem: Either use, or look at how Modern::Perl does it to enforce strict and warnings.
You can get a definitive answer by examining the symbol tables for each package:
# examine-symbol-tables.pl
use Bar;
%parent_names = map{$_ => 1} keys %Foo::;
%child_names = map{$_ => 1} keys %Bar::;
delete $parent_names{$_} && ($common_names{$_} = delete $child_names{$_}) foreach keys %child_names;
print "Common names in symbol tables:\n";
print "#{[keys %common_names]}\n\n";
print "Unique names in Bar symbol table:\n";
print "#{[keys %child_names]}\n\n";
print "Unique names in Foo symbol table:\n";
print "#{[keys %parent_names]}\n\n";
$ perl inherit.pl
Common names in symbol tables:
BEGIN
Unique names in Bar symbol table:
ISA isa import
Unique names in Foo symbol table:
Dumper new VERSION

How can I call a Perl class with a shorter name?

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();

What is the difference between package, module and class in object oriented Perl?

What is the difference between package, module and class in object oriented Perl?
Modules are a single file, a .pm file that provides code. That could be no packages, a single package, or more than one package. A module doesn't really care what is in it, so it can be code that inserts itself into the same namespace, a more-traditional set of subroutines in a library or define Perl's idea of a class.
A package, also known as a namespace, contains its own variables and subroutines. It's a way of segregating different parts of your program. You create the package and put your code into it:
package SomePackage;
sub some_subroutine { ... } # really SomePackage::some_subroutine
You load the module to get access to the package:
use SomePackage; # read and compile the module file
SomePackage::some_subroutine( ... );
A Perl class is a package and its associated behavior. The methods in a class are just normal subroutines, although when we treat the subroutines as methods, the first parameter is the thing (a package name or object, also known as the referent) that called method:
package SomeClass;
sub class_method { my( $class, #args ) = #_; ... }
sub instance_method { my( $self, #args ) = #_; ... }
Since the class is just a package like any other package and probably lives in a module, you access it the same way with use:
use SomeClass;
my $i = SomeClass->class_method( ... );
The OO arrow syntax does some special stuff to let the some_method subroutine know that it's being called as a method. Perl puts the referent (the SomeClass in this case) as the first argument. Additionally, when using the OO syntax, Perl knows to use its inheritance features.
Methods called with '->' get the referent as the first parameter to the method, so this call:
SomeClass->new('world');
is syntactically the same as if you had called it with the class name as the first parameter:
SomeClass::new( 'SomeClass' ,'world'); # no inheritance this way
That works the same for objects too. When an object is the referent:
my $i = SomeClass->new();
$i->bar( 'world');
the object is the first parameter as the method:
SomeClass::bar($i, 'world');
Perl doesn't have classes. It has namespaces that you change with package. For the complete details of Perl OOP, see Intermediate Perl or Object Oriented Perl. You can also see the perltoot and perlboot documentation. In short, Perl fakes what people expect "real" classes to be with packages, normal subroutines, and references.
A module is a distributable piece of code contained in a file. See perlmod.
I say more about this in my post for The Effective Perler, Find a module's release managers. I don't get into the OO stuff, but I talk about the other terms around "module".