More Than one Way to Load a Moose

So from my last post I had to figure out a way to enforce these four rules

  1. All LSD files will be in the DA::LSD name-space or folder if you like
  2. Each DSL has to express which type of driver it expects
  3. Only DSL 'pm' files will be loaded
  4. The loaded DSLs should be cached as loading or at least requiring them may take some time.
The first question is where to do this in the code. Fortunately Moose has a BUILD sub which is the prefect place for this. So we will start with this;

sub BUILD {
    my $self = shift;
    map { $self->_loadLSDClassesFromDir($_) }
      grep { -d $_ } map { File::Spec->catdir($_, 'DA_SC','LSD' ) } @INC;
}
Now here I am interating over the 'INC' array looking for my DA_SC/LSD path. You will note that I am using 'File::Spec' here to assemble my dir name and that is to make my code more cross platform compatible so this should work on Windblows, Muk etc. As part of the grep I also check to see if the dir exists and if it does I process that folder with my '_loadLSDClassesFromDir ' sub. So that is #1 covered off.

Now what I could of also do here is give the users of DA some way to opp out of using just the INC array by using a config of some form or perhaps an ENV variable. I didn't bother yet as this is just a proof of concept for now.

Now lets have a look at my _loadLSDClassesFromDir sub. So to start we have


sub _loadLSDClassesFromDir {
my $self = shift;
my ($path) = @_;
opendir(DIR, $path) or die "Unable to open $path: $!";
my @files = grep { !/^\.{1,2}$/ } readdir(DIR);
closedir(DIR);
@files = map { $path . '/' . $_ } @files;
my $lsd;

So straight forward here, open the passed in path, read in the contents ignoring all nasty non file and dir nonsense with my nifty little regex, then close the dir, keeping dirs open can really suck up resources so best to close early close often, next I suck out file and dir names with a map and finally I initialize a var for later use.
Now I have a little iteration to do over my array of files like this

for (@files) {
if (-d $_) {
}
elsif (/.pm$/) { #we only care about pm files
my ($volume, $dir, $file) = File::Spec->splitpath($_);
$file =~ s{\.pm$}{}; # remove .pm extension
my $classname = "";
$classname = join '::', 'DA_SC', 'LSD', $file;
eval "require $classname";
...

So in the above I check to see if my file is a Dir, though right now I just ignore it but I may add in some recursion here later on. Next I only process .pm files as those are the only ones I care about, so that is #3 is covered off. Note I use File::Spec again to strip out my file names from the path this saves me the headache of doing it myself. Next strip of the '.pm' from the file and then assemble the $classname using a Join. Finally I so a simple require on the $classname to check if it can be loaded. Moose is neat that I can check like that without the ability instancate this class

So in my final snippet


...
if ($@) {
my $err = $@;
my $advice
= "DA LSD $file ($classname) may not be an DA LSD!\n\n";
warn(
"\n\n Load of DA LSD $file failed: \n Error=$err \n $advice\n");
next;
}
else {
next
unless (does_role($classname,'DA::Roles::LSD'));
$lsd->{$classname->connection_class} =$classname;
}
}
}
$self->_lsds($lsd)
if (keys($lsd))

I trap the error and complain, if it passes that I then check that my $classname does the 'DA::Roles::LSD'. Now this is new one that look liks this

package DA::Roles::LSD;
BEGIN {
$DA::Roles::LSD::VERSION = "0.01";
}
use Moose::Role;
requires 'connection_class';
1;

This new role requires my LSD classes to implement a 'connection_class' sub. Next I use that connection_class sub in my LSD to return the Connection Class the DSL is looking for and then I add it as the key in a hash where the value is the $classname and when I am all done I save that has to a private attribute closing off #4 of my points.

One of the neat things here is that even though my DSLs are just roles I still call subs that they express.
So I also had to adjust my DSLs a little and in the SQL one I did this


use Moose::Role;
with (qw( DA::Roles::LSD));

and the connection_class sub

sub connection_class {
my $self = shift;
return 'DBI::db';
}

and in the DA I chaged the execute a little like this

my ($conn,$container,$opt) = @_;
my $drivers = $self->_lsds();
my $driver = $drivers->{ref($conn)};
die “No DSL loaded for ”.ref($conn). “ Maybe you have to load a DSL for it?”
unless($driver);
my $lsd = DA_SC::LSD::build_instance(
package => "LSD::".ref($conn),
superclasses =>['DA_SC::LSD'],
roles =>[$driver,'DA::Roles::API'],
view=>$self->view,
elements=>$self->elements );
return $lsd->_execute("retrieve",$conn,$container,$opt);

Now to get this to work I had to do a little test majick in my 02_base_sc.t file. I added in a dummy package for DBI in my test, like this

{
package DBI::db;
sub new {
my $class = shift;
my $self = {};
bless( $self, ( ref($class) || $class ) );
return( $self );
}

and then I do this

my $fake_dbh = DBI::db->new();
ok(
$address->retrieve( $fake_dbh, $result ) eq
'SELECT street, city, country FROM person AS me',
'SQL correct'
);

rerun my test and I get

ok 7 - City is an Element
No DSL loaded for Maybe you have to load a DSL for it? at D:\GitHub\DA-blog\lib/DA_SC.pm line 117.
ok 8 - Address is a DA_SC
ok 9 - SQL correct

Which is what I want to see as I have yet to update my Mongo LSD to retrun the correct handle.

So not Bad.

Below is the wrong way to load a moose!
loadamoose.jpg

Leave a comment

About byterock

user-pic Long time Perl guy, a few CPAN mods allot of work on DBD::Oracle and a few YAPC presentations