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.