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
- All LSD files will be in the DA::LSD name-space or folder if you like
- Each DSL has to express which type of driver it expects
- Only DSL 'pm' files will be loaded
- The loaded DSLs should be cached as loading or at least requiring them may take some time.
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.
Leave a comment