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.

view plainprint?

1. #!/usr/bin/env perl  
2. # the application code  
3.   
4. use feature qw{ say } ;  
5. use strict ;  
6. use warnings ;  
7. use lib ;  
8.   
9. my $api = API->new( @ARGV ) ;  
10. $api->run() ;  
11.   
12. package API ;  
13. use base 'API_Base' ;  
14. use lib ;  
15. use API_PED ;  

#!/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.

view plainprint?

1. package API_Base ;  
2. use feature qw{ say } ;  
3. use strict ;  
4. use warnings ;  
5. use CGI ;  
6. use Getopt::Long ;  
7. use Data::Dumper ;  
8. use JSON ;  
9.   
10. # Yes, I still use CGI. I kick it old-school.  
11.   
12. sub new {  
13.     my ( $class, @argv ) = @_ ;  
14.     my $self ;  
15.     my $cgi = CGI->new() ;  
16.     %{ $self->{param} } = map { $_ => $cgi->param($_) } $cgi->param() ;  
17.     ( undef, @{ $self->{pathinfo} } ) = split m{/}, $cgi->path_info() ;  
18.     return bless $self, $class ;  
19.     }  
20.   
21. sub run {  
22.     my ($self) = @_ ;  
23.     $self->run_command( $self->{pathinfo}, $self->{param} ) ;  
24.     }  
25.   
26. sub run_command {  
27.     my ( $self, $pathinfo, $param ) = @_ ;  
28.     my $command = $pathinfo->[0] || 'test' ;  
29.     my $s = $self->can("api_$command") ;  
30.     unless ($s) {  
31.         $command =~ y/-/_/ ;  
32.         $s = $self->can("api_$command") ;  
33.         }  
34.     unless ($s) {  
35.         $self->fail( $pathinfo, $param ) ;  
36.         exit ;  
37.         }  
38.     unless ( 'CODE' eq ref $s ) { $self->fail( $pathinfo, $param ) }  
39.     $self->$s( $pathinfo, $param ) ;  
40.     }  
41.   
42. sub fail {  
43.     my ( $self, $pathinfo, $param ) = @_ ;  
44.     say 'content-type: application/json' ;  
45.     say '' ;  
46.     say encode_json {  
47.         status   => 'fail',  
48.         param    => $param,  
49.         pathinfo => $pathinfo  
50.         } ;  
51.     print STDERR 'INAPPROPRIATE USAGE: '  
52.         . 'desired path = '  
53.         . ( join '/', '',@$pathinfo ) ;  
54.     }  
55.   
56. sub api_test {  
57.     my ( $self, $pathinfo, $param ) = @_ ;  
58.     say 'content-type: application/json' ;  
59.     say '' ;  
60.     say encode_json { status => 1, param => $param, pathinfo => $pathinfo } ;  
61.     }  
62. 1 ;  

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.

view plainprint?

1. package API_PED ;  
2. use feature qw{ say } ;  
3. use warnings ;  
4.   
5. use Exporter qw{import} ;  
6. use JSON ;  
7.   
8. # PED is our campus LDAP server  
9. use lib '/depot/gcore/apps/lib/' ;  
10. use PED qw{ purdue_ldap_lookup } ;  
11.   
12. our @EXPORT ;  
13. for my $entry ( keys %API_PED:: ) {  
14.     next if $entry !~ /^api_/ ;  
15.     push @EXPORT, $entry ;  
16.     }  
17.   
18. # The goal here is to do as much as we can without repetition  
19. # we export api_PED so that API accept this as a command without  
20. # having to write it into API.pm  
21.   
22. # api_PED checks for any subroutine starting with 'ped_' and  
23. # runs it  
24.   
25. # so in essence, exporting a sub starting with api_ adds it to the  
26. # API dispatch table, and writing a sub starting with ped_ adds it  
27. # to this module's dispatch tableee   
28.   
29. sub api_PED {  
30.     my ( $self, $pathinfo, $param ) = @_ ;  
31.     my %commands ;  
32.     shift @$pathinfo ;  
33.     foreach my $entry ( keys %API_PED:: ) {  
34.         next if $entry !~ /^ped_/ ;  
35.         $commands{$entry} = 1 ;  
36.         }  
37.     my $sub_name = shift @$pathinfo ;  
38.     my $command  = 'ped_' . $sub_name ;  
39.     if ( $commands{$command} ) {  
40.         my $full = join '::', 'API_PED', $command ;  
41.         &{$full}( $pathinfo, $param ) ;  
42.         exit ;  
43.         }  
44.     else {  
45.         say 'content-type: application/json' ;  
46.         say '' ;  
47.         say encode_json { c => \%commands, p => $pathinfo, e => $command } ;  
48.         }  
49.     }  
50.   
51. sub ped_test {  
52.     my ( $pathinfo, $param ) = @_ ;  
53.     say 'content-type: application/json' ;  
54.     say '' ;  
55.     say encode_json { result => 1 } ;  
56.     exit ;  
57.     }  
58.   
59. sub ped_mail {  
60.     my ( $pathinfo, $param ) = @_ ;  
61.     my $name   = $pathinfo->[0] ;  
62.     my $lookup = purdue_ldap_lookup($name) ;  
63.     say 'content-type: application/json' ;  
64.     say '' ;  
65.     say encode_json {  
66.         status => ( scalar keys %$lookup ? 1 : 0 ),  
67.         mail => $lookup->{mail},  
68.         } ;  
69.     exit ;  
70.     }  
71.   
72. sub ped_lookup {  
73.     my ( $pathinfo, $param ) = @_ ;  
74.     my $name   = $pathinfo->[0] ;  
75.     my $lookup = purdue_ldap_lookup($name) ;  
76.     say 'content-type: application/json' ;  
77.     say '' ;  
78.     say encode_json {  
79.         status => ( scalar keys %$lookup ? 1 : 0 ),  
80.         lookup => $lookup,  
81.         } ;  
82.     exit ;  
83.     }  
84. 1 ;  

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.