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.
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. |