E. Choroba

My last assignment in the CPAN Pull Request Challenge 2015 was Net::Stripe. I’d never heard of the module, so I skimmed its documentation to learn it provides an API to Stripe.com. From the method list, it seemed to be some kind of a payment service. It had no tester failures, though, and the issues on GitHub were either too complex or not specific enough to give me an idea on what to start working. I asked in the Challenge’s IRC channel and got the following advice from Joel Berger and Ether:

jberger	choroba: I haven’t looked at that module, but almost
	all service wrapper modules have woeful tests because
	they require the service
...	contributing some mock service tests might be nice
	and something you could do without an account (at least
	in concept)
ether	Test::LWP::UserAgent!!

And that was exactly what I tried. There were more than hundred tests ready if the API key was present, but only one test was running without it. Therefore, I decided to mock the service a bit and run the same tests against the mocked one.

Test::LWP::UserAgent

I reached for Test::LWP::UserAgent as suggested. Its interface is very easy:

my $ua = 'Test::LWP::UserAgent'->new;
my $resp_ok  = 'HTTP::Response'->new('200', 'OK',
                                     [ 'Content-Type' => 'text/plain' ]);
my $resp_err = 'HTTP::Response'->new('500', 'ERROR',
                                     [ 'Content-Type' => 'text/plain' ]);
$ua->map_response(qr/index/, $resp_ok);
$ua->map_response(qr/admin/, $resp_err);

Fortunately, Net::Stripe behaves well and accepts a ua argument in its constructor. I also took advantage of the fact that you can specify a code reference as the first argument to map_response to be informed about yet unimplemented requests:

# This is the last map_response command in the UA.
$ua->map_response(sub { warn Dumper \@_},
                  'HTTP::Response'->new(500));

The service usually returns a JSON object. For the first tests, it was enough to copy the examples from the service’s documentation. To keep my code DRY, I created a helper subroutine:

sub r200 { 'HTTP::Response'->new(200, 'OK',
                                 [ 'Content-Type' => 'text/json' ],
                                 @_) }

Stateless Isn’t Enough

As I progressed, though, I discovered a situation where exactly the same request returned a different response depending on an internal state of the service (after a plan was deleted, it couldn’t be fetched anymore). My first solution to this problem was inelegant, but it made me pass further tests:

my $ua = mock_ua(0);  # Plans not deleted.
my $stripe = 'Net::Stripe'->new( ua => $ua,
                                 # ...
                               );
sub mock_ua {
    my $delete = shift;
    my $myua;

    # ...

    $myua->map_response(sub { my $r = shift;
                              if ($r->url =~ m{v1/plans}
                                  && 'DELETE' eq $r->method
                              ) {
                                  $stripe->{ua} = mock_ua(1);
                                  return 1
                              }
                              return 0
                          }, r200(to_json({ deleted => 1 })));

    if ($delete) {
        $myua->map_response(qr{v1/plans},
                            'HTTP::Response'->new(500, 'Deleted', []));
    } else {
        $myua->map_response(qr{v1/plans}, r200($plan));
    }

    return $myua
}

In other words, when the request to delete the plans came, the User Agent object was changed to a newly generated one with a different response mapped to the request to fetch the plans. Ugly, right?

The correct solution to the problem, though, was to make the object stateful. It had to keep its state somewhere, but I didn’t want to just store it in $self->{STATE} of a Test::LWP::UserAgent’s heir. Adding a hash key might have changed the behaviour of the object in a distance: What if the keys were iterated over in a method, or the same key was used internally for something else?

Wrapper and Delegation

I created an object that wraps the user agent in a hash under the UA key:

package My::UA;
sub new { bless { UA => 'Test::LWP::UserAgent'->new }, shift }

The “state” could then be just another field in the hash:

sub state {
    my ($self, $key, $value) = @_;
    if (3 == @_) {
        $self->{STATE}{$key} = $value;
    }
    return ($self->{STATE}{$key})
}

How to delegate all the other methods to the UA? I didn’t know what methods of LWP::UserAgent were needed, so I just used AUTOLOAD.

sub AUTOLOAD {
    my $self = shift;
    ( my $method = our $AUTOLOAD ) =~ s/.*:://;  # Remove the namespace.
    return $self->{UA}->$method(@_)
}

An Inside-Out Object

Autoloading is a weird technique. As an alternative, I implemented the same behaviour using Inside-Out Objects. The class keeps a private hash of the extra attributes, keyed by a unique identifier of each instance—its reference address:

{   package My::UA;
    use parent 'Test::LWP::UserAgent';
    use Scalar::Util qw{ refaddr };

    my %state;

    sub state {
        my ($self, $key, $value) = @_;
        if (3 == @_) {
            $state{refaddr $self}{$key} = $value;
        }
        return ($state{refaddr $self}{$key})
    }
}

Reimplementing the Service

When I made the test number 112 pass, I realised I was slowly reimplementing the whole Stripe.com, creating coupons and customer plans, verifying them, setting their discounts and subscriptions. I needed to manipulate large JSON objects and keep a high number of internal states. “I’m just testing the API, not the service itself. There must be a limit how far one should go,” I thought to myself. If the service changed, the module’s author would need not only to change the tests, but to implement the new behaviour in the mocking class, too. In the end, I removed most of the code, letting only the tests 1–38 pass, which was exactly the point where things were getting hairy.

Another Pull Request

One of the tests in the original test suite tried to send the string zzz as a currency code. If an exception was thrown, it was thoroughly tested (the code uses exception objects). Nothing happened if there was no exception, though. Therefore, I added another pull request to test the exception was thrown at all.

Thank you, Neil Bowers, for the Challenge! I’ve learnt a lot, and I hope my reports were worth to someone else, as well.