byterock

Its clean up day here in the Moose-pen

There are still a few little things to clean up before I move away from record-sets. The first issue I think would be when I have asked for a 'Class' with 'da_result_set' but I have not supplied a 'da_result_class'.

In my Driver::DIB code I did add in this;

if ($self->is_Class() and $self->da_result_class()){

where it checks to ensure the class is present but I think in the way I am designing the API I should die well before this as I do in a number of other similar situations.

So to accomplish the above I will first write up a test in good old '20_dad_load.t'

$da_new->da_result_set("Class");

like(

    exception {$da_new->retrieve(Data::Test->new()) },

    qr /You must supply a da_result_class when da_result_set is Class/,

    "da_result_class required when set is Class"

);

$da_new->da_result_class("Test");

ok($da_new->retrieve(Data::Test->new()),"Works when da_result_class is set");

In this one I just set the result set to 'Class' ans I should get a fail on the next test and then set the result class and do a retrieve which should work.

Now where to add this in. I think the old adage

is apt here so I am going to add it into the 'retrieve' sub. I think this should do it;

    sub retrieve {

        my $self = shift;

        my ( $conn, $opt ) = @_;


        die( $self->meta->get_attribute('no_retrieve')->description->{message} )

          if ( $self->no_retrieve() );

          

++      die( "You must supply a da_result_class when da_result_set is Class!" )

++        if ( $self->da_result_set() eq 'Class' and !$self->da_result_class() );

and when I run the test;

…

ok 88 - Elements cannot be empty array ref

ok 89 - da_result_class required when set is Class

ok 90 - Works when da_result_class is set

and to clean that up drop that little code out of Driver::DBI;

  

--             if ($self->is_Class() and $self->da_result_class()){

++             if ($self->is_Class() ){

                        my $class=$self->da_result_class();

Now this has gotten me to thinking what happens if that Class is 'bogus' as it is not in the perl path someplace. I should make a little effort here to check that before it goes to the DAD as well;

First yet another test;

$da_new->da_result_class("xxxx");


like(

    exception {$da_new->retrieve(Data::Test->new()) },

    qr /Can't locate the da_result_class file/,

    "da_result_class has to be a valid Class in the pat"

);

and then this quick patch;

        die( "You must supply a da_result_class when da_result_set is Class!" )

          if ( $self->da_result_set() eq 'Class' and !$self->da_result_class() );

          

++      if ($self->da_result_class()){

++          eval "require ".$self->da_result_class();

++          if ($@) {

++              $@ =~ s /locate/locate the da_result_class file /;

++              die( $@ );

++          }

++      }

and the test comes out;

…

ok 89 - da_result_class required when set is Class

ok 90 - Works when da_result_class is set

ok 91 - da_result_class has to be a valid Class in the pat

So far so good that looks nicely locked down.

Something new for tomorrow maybe??