But Wait! There's More! Extendable DRY API Code

The previous post wasn't built in a vacuum.

I was chasing down ideas for a purpose. I've been building JSON APIs for the lab for quite some time, each with as much knowledge about them as I had at that time, which means I have a number of bad APIs out there, and I'm in a position now where I'd like to unify them into either task-specific or access-level-specific groups.

That last piece of code was me finally able to take the lesson I learned from perlbrew about the symbol table being usable as a dispatch table. But it had a problem.

That problem was that, to use it, I would have to use or require whatever module I want to access into that one module. This is a problem because then I'd need a different API.pm for each version of the API I wanted to make. This is not good.

I remembered code that I used to use to download Dilbert comics. I subclassed HTML::Parser, adding functions that were specific to the task of grabbing images. Which is exactly what I do here.

#!/usr/bin/env perl
# the application code

use feature qw{ say } ;
use strict ;
use warnings ;
use lib ;

my $api = API->new( @ARGV ) ;
$api->run() ;

package API ;
use base 'API_Base' ;
use lib ;
use API_PED ;

Above, I make a version of API that includes API_PED.

API_Base is conceptually very perlbrew-influenced, but I totally dropped the "I think you mean" because this is a JSON API, not a command-line program.

package API_Base ;
use feature qw{ say } ;
use strict ;
use warnings ;
use CGI ;
use Getopt::Long ;
use Data::Dumper ;
use JSON ;

# Yes, I still use CGI. I kick it old-school.

sub new {
    my ( $class, @argv ) = @_ ;
    my $self ;
    my $cgi = CGI->new() ;
    %{ $self->{param} } = map { $_ => $cgi->param($_) } $cgi->param() ;
    ( undef, @{ $self->{pathinfo} } ) = split m{/}, $cgi->path_info() ;
    return bless $self, $class ;
    }

sub run {
    my ($self) = @_ ;
    $self->run_command( $self->{pathinfo}, $self->{param} ) ;
    }

sub run_command {
    my ( $self, $pathinfo, $param ) = @_ ;
    my $command = $pathinfo->[0] || 'test' ;
    my $s = $self->can("api_$command") ;
    unless ($s) {
        $command =~ y/-/_/ ;
        $s = $self->can("api_$command") ;
        }
    unless ($s) {
        $self->fail( $pathinfo, $param ) ;
        exit ;
        }
    unless ( 'CODE' eq ref $s ) { $self->fail( $pathinfo, $param ) }
    $self->$s( $pathinfo, $param ) ;
    }

sub fail {
    my ( $self, $pathinfo, $param ) = @_ ;
    say 'content-type: application/json' ;
    say '' ;
    say encode_json {
        status   => 'fail',
        param    => $param,
        pathinfo => $pathinfo
        } ;
    print STDERR 'INAPPROPRIATE USAGE: '
        . 'desired path = '
        . ( join '/', '',@$pathinfo ) ;
    }

sub api_test {
    my ( $self, $pathinfo, $param ) = @_ ;
    say 'content-type: application/json' ;
    say '' ;
    say encode_json { status => 1, param => $param, pathinfo => $pathinfo } ;
    }
1 ;

We go into the symbol table twice. one to export api_PED, which would become api.cgi/PED, and one to make subroutines named ped_* into a dispatch table, allowing api.cgi/PED/test, api/PED/mail and api.cgi/PED/lookup.

package API_PED ;
use feature qw{ say } ;
use warnings ;

use Exporter qw{import} ;
use JSON ;

# PED is our campus LDAP server
use lib '/depot/gcore/apps/lib/' ;
use PED qw{ purdue_ldap_lookup } ;

our @EXPORT ;
for my $entry ( keys %API_PED:: ) {
    next if $entry !~ /^api_/ ;
    push @EXPORT, $entry ;
    }

# The goal here is to do as much as we can without repetition
# we export api_PED so that API accept this as a command without
# having to write it into API.pm

# api_PED checks for any subroutine starting with 'ped_' and
# runs it

# so in essence, exporting a sub starting with api_ adds it to the
# API dispatch table, and writing a sub starting with ped_ adds it
# to this module's dispatch tableee 

sub api_PED {
    my ( $self, $pathinfo, $param ) = @_ ;
    my %commands ;
    shift @$pathinfo ;
    foreach my $entry ( keys %API_PED:: ) {
        next if $entry !~ /^ped_/ ;
        $commands{$entry} = 1 ;
        }
    my $sub_name = shift @$pathinfo ;
    my $command  = 'ped_' . $sub_name ;
    if ( $commands{$command} ) {
        my $full = join '::', 'API_PED', $command ;
        &{$full}( $pathinfo, $param ) ;
        exit ;
        }
    else {
        say 'content-type: application/json' ;
        say '' ;
        say encode_json { c => \%commands, p => $pathinfo, e => $command } ;
        }
    }

sub ped_test {
    my ( $pathinfo, $param ) = @_ ;
    say 'content-type: application/json' ;
    say '' ;
    say encode_json { result => 1 } ;
    exit ;
    }

sub ped_mail {
    my ( $pathinfo, $param ) = @_ ;
    my $name   = $pathinfo->[0] ;
    my $lookup = purdue_ldap_lookup($name) ;
    say 'content-type: application/json' ;
    say '' ;
    say encode_json {
        status => ( scalar keys %$lookup ? 1 : 0 ),
        mail => $lookup->{mail},
        } ;
    exit ;
    }

sub ped_lookup {
    my ( $pathinfo, $param ) = @_ ;
    my $name   = $pathinfo->[0] ;
    my $lookup = purdue_ldap_lookup($name) ;
    say 'content-type: application/json' ;
    say '' ;
    say encode_json {
        status => ( scalar keys %$lookup ? 1 : 0 ),
        lookup => $lookup,
        } ;
    exit ;
    }
1 ;

I'm not the happiest. Each sub handles encoding the output itself. I normally use JSON, but I could imagine exporting JSONP, XML, CSV or something else, and I could imagine passing back the data and an indication as to how it should be handled. I think I might have that somewhere, like I had the base code in a web comic reader from the late 1990s.

To sum up, I'm in the middle panel of this:

Three Panel Soul. I think the artist turned this into a t-shirt.

Filling a Dispatch Table For Ease of Development and DRY

I hate magic.

Don't get me wrong. If the night's entertainment is going to see Penn & Teller, I'll enjoy myself like anyone else, but when I have to work with it, I hate magic.

I hate magic because there's an implicit promise of "this will always work", and when it doesn't work, because eventually it won't, I won't know how to fix it because I was never told how it works in the first place.

On the other hand, I hate repeating myself.

Consider this code:

package Me ;
use Exporter qw{import} ;
our @EXPORT =  qw{add} ;

# adds two variables
sub add {
    my ($i,$j)=@_;
    return $i + $j ;
    }
1;

It was recently suggested to me that documentation like the above is essentially code duplication, and if I made substantial changes, assuming a more complex concept than addition, then the comments are out of date. And because writing in code and writing in English are different, switching between the two can be taxing, so developers often say "I'll get to it later" and forget.

But there's another point of code duplication.

Not only are we saying add() is a subroutine with sub add(), we're saying it with our @EXPORT = qw{add}. I don't want that code repetition. So, what can we do to make it better?

Look at the symbol table!

package Me ;
use Exporter qw{import} ;
our @EXPORT ;
for my $entry ( keys %Me:: ) {
    next if $entry !~ /^my_/ ;
    push @EXPORT, $entry ; 
    }

# we do our own addition because I don't trust the built-in
sub my_add {
    my ($i,$j)=@_;
    return $i + $j ;
    }
1;

I've changed the documentation to why I've done such a silly thing as re-implemented add(), given add() a name much more likely to avoid namespace collisions, and made @EXPORT auto-filling. If I wanted to created my own subtraction, I'd just write my_sub() and away we'd go. Additionally, if I wanted a non-exported subroutine log_usage() to add to these subroutines and see how often my code is used, I could just write and use that and it won't be exported.

But, because I see how @EXPORT is filled, it will be apparent when I return to maintain this code how that works, so something else will be the biggest "WTF?" in the code base. No magic. No Three of Clubs. No Jack of Spades spitting cider into my ear. More than likely, it'd be "Why did I roll my own buggy addition? What was I even thinking?"

Which is good. Because, while I love clever, I hate magic.