Catalyst Model #4: Random numbers and really-o, truly-o random numbers

Published · Thursday, 16 July 2009 (Updated · 7 March 2010)

One of the benefits of abstracting out into a model is that if you do it right, meaning it stays abstract, then the implementation—the backend of the service—can change with little or no disruption to the application which uses the model.

The way to succeed here is to have your model’s API be as neutral and open as possible without being so verbose it will a PITA to use. We want random numbers from this model and we want room to change the backend even though we know, of course, that we are flawless thinkers we will never need a version 2.0 because our initial implementation will be perfect.

So we’ll design our API to accommodate a range of…

  • MyApp::Model::RandomNumber->generate
    • lower_bound
    • upper_bound
    • integer

And know that that’s what we’ll stick with no matter what the backend looks like. A naïve knock-off in Perl might look like–

sub generate {
    my ( $lower, $upper, $integer ) = @_;
    my $range = $upper - $lower;
    if ( $integer ) {
        return int( rand($range) + 0.5 + $lower );
    } else {
        return rand($range) + $lower;
    }
}

There are many problems with that. Named arguments are really a necessity for APIs which aren’t a serious drag. We’re doing no argument checking at all. While one of the joys of Perl is that you don’t have to do those things, to make a robust model/service, we must.

So, here is the model with a more robust approach–

./script/myapp_create.pl model RandomNumber
 exists "/Users/jinx/depot/sites/MyApp/script/../lib/MyApp/Model"
 exists "/Users/jinx/depot/sites/MyApp/script/../t"
created "/Users/jinx/depot/sites/MyApp/script/../lib/MyApp/Model/RandomNumber.pm"
created "/Users/jinx/depot/sites/MyApp/script/../t/model_RandomNumber.t"
emacs lib/MyApp/Model/RandomNumber.pm
package MyApp::Model::RandomNumber;
use strict;
use warnings;
use parent 'Catalyst::Model';
use Carp;

sub generate {
    my ( $self, $args ) = @_;
    $args ||= {};
    ref($args) eq 'HASH' or croak "Arguments must be a hash reference";
    my $upper = delete $args->{upper_bound};
    my $lower = delete $args->{lower_bound}
        if $upper; # Both or neither.
    my $integer = delete $args->{integer}
        if $upper; # Only works if bounds are set.

    croak "Unsupported args or combination of args", join(", ", %{$args})
        if keys %{$args};

    # Reasonable defaults if not set by client.
    $upper ||= 1;
    $lower ||= 0;

    $upper > $lower
        or croak "upper_bound is not greater than lower_bound";

    my $range = $upper - $lower;
    if ( $integer )
    {
        return int( rand($range) + $lower + 0.5 * ( $range <=> 0 ) );
    }
    else
    {
        return rand($range) + $lower;
    }    
}

1;

Now we need a controller to use the model

./script/myapp_create.pl controller RandomNumber
 exists "/Users/jinx/depot/sites/MyApp/script/../lib/MyApp/Controller"
 exists "/Users/jinx/depot/sites/MyApp/script/../t"
created "/Users/jinx/depot/sites/MyApp/script/../lib/MyApp/Controller/RandomNumber.pm"
created "/Users/jinx/depot/sites/MyApp/script/../t/controller_RandomNumber.t"
emacs lib/MyApp/Controller/RandomNumber.pm
package MyApp::Controller::RandomNumber;
use strict;
use warnings;
use parent 'Catalyst::Controller';

sub index :Path Args(0) {
    my ( $self, $c ) = @_;
    my $number = $c->model("RandomNumber")->generate;
    $c->response->body($number);
}

sub d6 :Local Args(0) {
    my ( $self, $c ) = @_;
    my $number = $c->model("RandomNumber")
        ->generate({ lower_bound => 1,
                     upper_bound => 6,
                     integer => 1 });
    $c->response->body($number);
}

1;

Start it up and try it

./script/myapp_server.pl -d -r -p 3000

Yay! We win. All done… Oh, what‘s that you say? rand() isn’t really random? Well, so what? Well, this is what–

Say you are not using this model for D&D and your contractor timesheets. Say you’re running virtual slots or Keno or a state lottery. Say your program helped to give away $100,000,000. Say a PhD in Math who passed the Florida bar held a losing ticket and knows your model isn’t truly random.

Sued!

But wait. We made our API sanely so let’s just do an unimpeachable version of the back-end. Our controller won’t have to change at all.

Other persons know that int(rand(10)) might not stand-up to a lawsuit from someone who held a losing ticket or hand. The good people at random.org have solved this and made the solution public.

Random.org returns integers so we’ll put in a hook that makes our model use their service when asked for an integer. The only real change is in integer requests so we just break that out into a new helper sub, _generate_integer.

sub generate {
    my ( $self, $args ) = @_;
    $args ||= {};
    ref($args) eq 'HASH' or croak "Arguments must be a hash reference";
    my $upper = delete $args->{upper_bound};
    my $lower = delete $args->{lower_bound}
        if $upper; # Both or neither.
    my $integer = delete $args->{integer}
        if $upper; # Only works if bounds are set.

    croak "Unsupported args or combination of args", join(", ", %{$args})
        if keys %{$args};

    # Reasonable defaults if not set by client.
    $upper ||= 1;
    $lower ||= 0;

    $upper > $lower
        or croak "upper_bound is not greater than lower_bound";

    if ( $integer )
    {
        # New code!
        return _generate_integer( $lower, $upper );
    }
    else
    {
        return rand( $upper - $lower ) + $lower;
    }    
}

# New code!
sub _generate_integer {
    my ( $min, $max ) = @_;
    my $uri = URI->new("http://www.random.org/integers/");
    $uri->query_form(
                     num => 1,
                     min => $min,
                     max => $max,
                     base => 10,
                     col => 1,
                     "format" => "plain",
                     rnd => "new",
                     );

    my $ua = LWP::UserAgent->new;
    my $r = $ua->get($uri);
    $r->is_success or croak join("\n",
                                 $uri,
                                 $r->status_line,
                                 $r->as_string);
    chomp( my $number = $r->content );
    return $number;
}

Now, with no change at all to the controller, our d6 is truly random.1 If we had been using a third-party code source for the model we might not have had to change any of our code at all; just upgrade the external module to get the improvement.

New dependency added: LWP::UserAgent

You may need to install this, and a new version of LWP is a very good idea too.

cpan LWP::UserAgent

Tomorrow is Friday. We’re doing #5: Stock quotes and then breaking for the weekend to frantically clean-up the next five in the hope of beating Monday to the punch for once.

1 Well… no one can prove what is truly random. We’ll just call this version a bit more legally defensible.



digg stumbleupon del.icio.us reddit Fark Technorati Faves

« Catalyst Model #3: Cover images via Amazon.com’s APA · Catalyst Model #5: Stock quotes »
« 10 Catalyst models in 10 days1 »