Use DBIx::Class with a single result class definition to handle several tables with the same structure - perl

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'});

Related

When using multiple inheritance in Perl is there a way to indicate which SUPER function to use?

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.

How do I make DBIx::Class::Schema::Loader ignore non result classes?

I'm switching from using DBIx::Class::Schema::Loader in dynamic mode to static.
But there's a problem, my result classes are mixed up with non result classes. Here's the specifics.
lib/BackPAN/Index.pm # main API
lib/BackPAN/Index/Dist.pm # result class
lib/BackPAN/Index/File.pm # result class
lib/BackPAN/Index/Release.pm # result class
lib/BackPAN/Index/Schema.pm # subclass of DBIC::Schema::Loader
lib/BackPAN/Index/Role/... # various roles
When I switch to static schema generation it gets tripped up by the role.
DBIx::Class::Schema::load_namespaces(): Attempt to load_namespaces()
class BackPAN::Index::Role::HasCache failed - are you sure this is a
real Result Class?
I'm stuck with this class layout. BackPAN::Index::Dist, File and Release are all publicly documented. Many methods are expected to return them as the result of queries.
I need a way to use DBIx::Class::Schema::Loader in static mode while BackPAN::Index::Dist, File and Release are used as result classes.
I've been trying to make DBIx::Class::Schema::Loader spell out the generated result classes rather than relying on load_namespaces to search the subdirectory.
Ideally, I'd like the generated result classes to be in their own subdirectory with Dist, File and Release as subclasses for easier customization. However, queries against the schema must return the customized subclasses.
Normally you have a Result and a ResultSet namespace in which the corresponding classes reside:
BackPAN::Index::Schema::Result::Dist
BackPAN::Index::Schema::ResultSet::Dist
The DBIx::Class::Schema#load_namespaces docs show an example of setting them to non-default values.
You can also use DBIx::Class::Schema#load_classes and specify each class:
BackPAN::Index::Schema->load_classes({
BackPAN::Index => [qw( Dist File Release )],
});
Normally it's not a problem to move Result and ResultSet classes into different namespaces because they are always accessed through an instance of the Schema which loads them.
I suggest trying to move them and see if it really breaks something before going with load_classes.
I realized the important part of Schema::Loader is making the result classes. The schema is simple and I can make it by hand. Unfortunately there's no way to tell Schema::Loader not to generate the schema. I've hacked around it by telling it to make a dummy and just delete the file.
DBIx::Class::Schema::Loader::make_schema_at(
'BackPAN::Index::SchemaThrowaway',
{
result_namespace => '+BackPAN::Index',
use_namespaces => 1,
dump_directory => 'lib',
},
);
# Throw the generated schema away.
unlink "lib/BackPAN/Index/SchemaThrowaway.pm";
Then I write the schema class by hand.
package BackPAN::Index::Schema;
use strict;
use warnings;
use base 'DBIx::Class::Schema';
__PACKAGE__->load_classes({
"BackPAN::Index" => [qw(Dist File Release)],
});
Its a hack, but it works. Still looking for a better solution.

How to make a hash of objects in perl

I would like to be able to store objects in a hash structure so I can work with the name of the object as a variable.
Could someone help me make a
sub new{
...
}
routine that creates a new object as member of a hash? I am not exactly sure how to go about doing this or how to refer to and/or use the object when it is stored like this. I just want to be able to use and refer to the name of the object for other subroutines.
See my comment in How can I get name of an object in Perl? for why I want to do this.
Thank you
Objects don't really have names. Why are you trying to give them names? One of the fundamental points of references is that you don't need to know a name, or even what class it is, to work with it.
There's probably a much better way to achieve your task.
However, since objects are just references, and references are just scalars, the object can be a hash value:
my %hash = (
some_name => Class->new( ... ),
other_name => Class->new( ... ).
);
You might want to check out a book such as Intermediate Perl to learn how references and objects work.
Don't quite understand what you are trying to do. Perhaps you can provide some concrete examples?
You can store objects into hashes just like any other variable in perl.
my %hash = ( );
$hash{'foo'} = new Foo(...);
$hash{'bar'} = new Bar(...);
Assuming you know the object stored at 'foo' is a Foo object and at 'bar' is a Bar object, then you can retrieve the objects from the hash and use it.
$hash{'foo'}->foo_method();
$hash{'bar'}->bar_method();
You may want to programmatically determine this behavior at run time. That's assuming that you are sticking with this naming scheme.

Perl - Calling subclass constructor from superclass (OO)

This may turn out to be an embarrassingly stupid question, but better than potentially creating embarrassingly stupid code. :-) This is an OO design question, really.
Let's say I have an object class 'Foos' that represents a set of dynamic configuration elements, which are obtained by querying a command on disk, 'mycrazyfoos -getconfig'. Let's say that there are two categories of behavior that I want 'Foos' objects to have:
Existing ones: one is, query ones that exist in the command output I just mentioned (/usr/bin/mycrazyfoos -getconfig`. Make modifications to existing ones via shelling out commands.
Create new ones that don't exist; new 'crazyfoos', using a complex set of /usr/bin/mycrazyfoos commands and parameters. Here I'm not really just querying, but actually running a bunch of system() commands. Affecting changes.
Here's my class structure:
Foos.pm
package Foos, which has a new($hashref->{name => 'myfooname',) constructor that takes a 'crazyfoo NAME' and then queries the existence of that NAME to see if it already exists (by shelling out and running the mycrazyfoos command above). If that crazyfoo already exists, return a Foos::Existing object. Any changes to this object requires shelling out, running commands and getting confirmation that everything ran okay.
If this is the way to go, then the new() constructor needs to have a test to see which subclass constructor to use (if that even makes sense in this context). Here are the subclasses:
Foos/Existing.pm
As mentioned above, this is for when a Foos object already exists.
Foos/Pending.pm
This is an object that will be created if, in the above, the 'crazyfoo NAME' doesn't actually exist. In this case, the new() constructor above will be checked for additional parameters, and it will go ahead and, when called using ->create() shell out using system() and create a new object... possibly returning an 'Existing' one...
OR
As I type this out, I am realizing it is perhaps it's better to have a single:
(an alternative arrangement)
Foos class, that has a
->new() that takes just a name
->create() that takes additional creation parameters
->delete(), ->change() and other params that affect ones that exist; that will have to just be checked dynamically.
So here we are, two main directions to go with this. I'm curious which would be the more intelligent way to go.
In general it's a mistake (design-wise, not syntax-wise) for the new method to return anything but a new object. If you want to sometimes return an existing object, call that method something else, e.g. new_from_cache().
I also find it odd that you're splitting up this functionality (constructing a new object, and returning an existing one) not just into separate namespaces, but also different objects. So in general, you're closer with your second approach, but you can still have the main constructor (new) handle a variety of arguments:
package Foos;
use strict;
use warnings;
sub new
{
my ($class, %args) = #_;
if ($args{name})
{
# handle the name => value option
}
if ($args{some_other_option})
{
# ...
}
my $this = {
# fill in any fields you need...
};
return bless $this, $class;
}
sub new_from_cache
{
my ($class, %args) = #_;
# check if the object already exists...
# if not, create a new object
return $class->new(%args);
}
Note: I don't want to complicate things while you're still learning, but you may also want to look at Moose, which takes care of a lot of the gory details of construction for you, and the definition of attributes and their accessors.
It is generally speaking a bad idea for a superclass to know about its subclasses, a principle which extends to construction.[1] If you need to decide at runtime what kind of object to create (and you do), create a fourth class to have just that job. This is one kind of "factory".
Having said that in answer to your nominal question, your problem as described does not seem to call for subclassing. In particular, you apparently are going to be treating the different classes of Foos differently depending on which concrete class they belong to. All you're really asking for is a unified way to instantiate two separate classes of objects.
So how's this suggestion[3]: Make Foos::Exists and Foos::Pending two separate and unrelated classes and provide (in Foos) a method that returns the appropriate one. Don't call it new; you're not making a new Foos.
If you want to unify the interfaces so that clients don't have to know which kind they're talking about, then we can talk subclassing (or better yet, delegation to a lazily-created and -updated Foos::Handle).
[1]: Explaining why this is true is a subject hefty enough for a book[2], but the short answer is that it creates a dependency cycle between the subclass (which depends on its superclass by definition) and the superclass (which is being made to depend on its subclass by a poor design decision).
[2]: Lakos, John. (1996). Large-scale C++ Software Design. Addison-Wesley.
[3]: Not a recommendation, since I can't get a good enough handle on your requirements to be sure I'm not shooting fish in a dark ocean.
It is also a factory pattern (bad in Perl) if the object's constructor will return an instance blessed into more than one package.
I would create something like this. If the names exists than is_created is set to 1, otherwise it is set to 0.. I would merge the ::Pending, and ::Existing together, and if the object isn't created just put that into the default for the _object, the check happens lazily. Also, Foo->delete() and Foo->change() will defer to the instance in _object.
package Foo;
use Moose;
has 'name' => ( is => 'ro', isa => 'Str', required => 1 );
has 'is_created' => (
is => 'ro'
, isa => 'Bool'
, init_arg => undef
, default => sub {
stuff_if_exists ? 1 : 0
}
);
has '_object' => (
isa => 'Object'
, is => 'ro'
, lazy => 1
, init_arg => undef
, default => sub {
my $self = shift;
$self->is_created
? Foo->new
: Bar->new
}
, handles => [qw/delete change/]
);
Interesting answers! I am digesting it as I try out different things in code.
Well, I have another variation of the same question -- the same question, mind you, just a different problem to the same class:subclass creation issue!
This time:
This code is an interface to a command line that has a number of different complex options. I told you about /usr/bin/mycrazyfoos before, right? Well, what if I told you that that binary changes based on versions, and sometimes it completely changes its underlying options. And that this class we're writing, it has to be able to account for all of these things. The goal (or perhaps idea) is to do: (perhaps called FROM the Foos class we were discussing above):
Foos::Commandline, which has as subclasses different versions of the underlying '/usr/bin/mycrazyfoos' command.
Example:
my $fcommandobj = new Foos::Commandline;
my #raw_output_list = $fcommandobj->getlist();
my $result_dance = $fcommandobj->dance();
where 'getlist' and 'dance' are version-dependent. I thought about doing this:
package Foos::Commandline;
new (
#Figure out some clever way to decide what version user has
# (automagically)
# And call appropriate subclass? Wait, you all are telling me this is bad OO:
# if v1.0.1 (new Foos::Commandline::v1.0.1.....
# else if v1.2 (new Foos::Commandline::v1.2....
#etc
}
then
package Foos::Commandline::v1.0.1;
sub getlist ( eval... system ("/usr/bin/mycrazyfoos", "-getlistbaby"
# etc etc
and (different .pm files, in subdir of Foos/Commandline)
package Foos::Commandline::v1.2;
sub getlist ( eval... system ("/usr/bin/mycrazyfoos", "-getlistohyeahrightheh"
#etc
Make sense? I expressed in code what I'd like to do, but it just doesn't feel right, particularly in light of what was discussed in the above responses. What DOES feel right is that there should be a generic interface / superclass to Commandline... and that different versions should be able to override it. Right? Would appreciate a suggestion or two on that. Gracias.

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