byterock

Well some-days it would be nice to get a little advice, without asking for it, before one heads down a very long and in the end futile path.

Today that happened to me when I was starting down a path that I dreaded. Namely creating the 'response' test suite for all those S3 requests I have fixed up over the past few weeks. This type of programming ranges from so mind numbingly dull as to cause your ears to bleed to so incredibility repetitive that you consider that career change to line supervisor at the box factory.

Looking at the prospect of coveting some 70+ working S3 units tests by hand was obviously getting me down a little. It took me a good three or four days of rather mindless hacking and re-running just to to the 'request' tests.

So I figured I would try and create a little script that would take my real unit test and convert it into test case I can use with the t/10_response.t.. After all the tests are just made up of two simple YAML files how hard could it be to just run my real world test and then convert that into a canned test.

Well the first thing I did was get the parts I needed to create the test out of PAWs. Right now it is easy do just Dump the response and request objects but I actually need direct access to them to use them to build a test..

So I hacked up ' Paws::Net::Caller' like this

+has _hack_request =>( is => 'rw', isa=>'Paws::Net::S3APIRequest');
+has _hack_response =>( is => 'rw', isa=>'Paws::Net::APIResponse');
   sub send_request {



    delete $headers->{Host};

     my $response = $self->ua->request(

@@ -30,11 +31,15 @@ package Paws::Net::Caller;

         (defined $requestObj->content)?(content => $requestObj->content):(),

       }

     );

-    return Paws::Net::APIResponse->new(

+    $self->_hack_request($requestObj);

+    my $return = Paws::Net::APIResponse->new(

         status  => $response->{status},

         content => $response->{content},

         headers => $response->{headers}

       );

+    $self->_hack_response($return );

+    return $return;

so now the raw response is available (I will never check this in).

Next I created a sub like this;

sub make_response_test {
  my ($service,$call,$caller,) = @_;
  my $response_hash = $caller->_hack_response();
  YAML::DumpFile("s3-get-bucket-location.response",{%$response_hash} );
}

and called it after one of my unit tests like this;

my $s3 = Paws->service('S3', region => 'us-east-1', debug=>1);
my $Output = $s3->GetBucketLocation
(
  Bucket         => 'dev.cargotel.test',
);

make_response_test("S3","GetBucketLocation",$s3->caller);

and when I run it I get this YAML file

---
content: |-
  <?xml version="1.0" encoding="UTF-8"?>
  <LocationConstraint xmlns="http://s3.amazonaws.com/doc/2006-03-01/">eu-west-2</LocationConstraint>
headers:
  content-type: application/xml
  date: 'Fri, 29 Nov 2019 19:22:29 GMT'
  server: AmazonS3
  transfer-encoding: chunked
  x-amz-id-2: KXv8A8R768eZKp9f71587kNNBfnU9LdaqOu/Z8JM57IQn4gPw0DtERRaBoMTsP+cNAfcdQImWu8=
  x-amz-request-id: 199C9C27757BA0E0
status: 200

Perfect! Now I just need to generate the tests. I figured out after a few runs all I need to do is pass along the successful response so I could drop that '_hack_response' so my sub now looked something like this;

sub make_response_test {
  my ($service,$call,$response,$caller,) = @_;
  my $response_hash = $caller->_hack_response();
  YAML::DumpFile("s3-get-bucket-location.response",{%$response_hash} );

  my $test_hash = {call=>$call,

                  service=>$service};

  my @tests = ();

  foreach my $attribute ( sort { $a->name cmp $b->name }

        $value->meta->get_all_attributes ){

     my $name = $attribute->name();

     push(@tests,{expected=>$response->$name,

                    op=>'eq',

                    path=>$name });

  }

  $test_hash->{tests}=\@tests;

  

YAML::DumpFile("s3-get-bucket-location.response.test.yml",$test_hash);

}

and that gave me the correct test file;

---
call: GetBucketLocation
service: S3
tests:
  - expected: eu-west-2
    op: eq
    path: LocationConstraint
  - expected: 199C9C27757BA0E0
    op: eq
    path: _request_id

Great off to the races. But!

How about those complex returns that have Classes with Classes and Arrays of Classes. I will have to account for those.

Well to make a very long story short after piddling about trying to create a function that would create those nice paths to my calls I got very fed up and did a quick search on CPAN and found ' Hash::Flatten' so I took out my attribute iterator and added this

 my $o = new Hash::Flatten({

        HashDelimiter => '.',

        ArrayDelimiter => '.',

    });

 my $flat =  $o->flatten($response);

 foreach my $path ( sort(keys(%{$flat}))){

        push(@tests,{expected=>$flat->{$path},

                    op=>'eq',

                    path=>$path});

 }

and with the above I go perfect results on the complex nested class I was playing with.

So here is the rub.

I was just about ready to fix all my code up and start truing out tests when I tried to run my scrip in a different window and got;

Can't locate Hash/Flatten.pm in ….

Odd Hash::Flatten is not on my installed Perl. I went back to my AWS dir and git a grep for 'Hash::Flatten' and found in only in another '.pm'

local/lib/perl5/DataStruct/Flat.pm

So I did a grep for that and then I found this;

package TestMakerCaller;
  use Moose;
  extends 'Paws::Net::MockCaller';
  use YAML qw/DumpFile/;
  use DataStruct::Flat;
  use v5.10;

  has '+result_hook' => (default => sub {

    return sub {

      my ($self, $result) = @_;

      my $test = { tests => [] };

      my $h = Paws->to_hash($result);

      $h = DataStruct::Flat->new->flatten($h);

      $test->{ tests } = [ map { { expected => $h->{ $_ }, op => 'eq', path => $_ } } keys %$h ];

      my $file_name = $self->_test_file . '.test.yml';

      DumpFile($file_name, $test);

      say "Written test case to ${file_name}";

    }

  });

1;

and then I found this

script/paws_make_testcase

Oh bother!

I guess great minds think alike.

I wish someone would of pointed that out to me on the posting I have been doing. Would be nice to see a blurb on it in the splash page on Github.

Anyway onwards and upward.