Hacking Thy Fearful Symmetry

Hacker, hacker coding bright
Powered by a Gamboling Beluga

Flattr your CPAN Stack

created: April 7, 2013

Today I caught brian d foy's Crowdtilt campaign for Pinto on Twitter, and it triggered an old thought that I had. Wouldn't it be nice to be able to gather information about the CPAN stack you're using and throw a few pennies in the tipjars of all the authors involved? So I decided to have a (oh so very) quick go at it.

First Step: Gather The Stack

For simplicity, I assume here that the module management is done via Pinto. If not, one can always do similar shenanigans via CPAN autobundling (cpan -a). But, in all cases, with Pinto the gathering can be done via:


#!/usr/bin/env perl

use 5.10.0;

use strict;
use warnings;

use Pinto::Schema;
use YAML qw/ LoadFile DumpFile/;

my $schema = Pinto::Schema->connect(
    'dbi:SQLite:/path/to/your/pinto.db' );

my $author = -f 'STACK.yml' ? LoadFile( 'STACK.yml' ) : {};

# clear previous data
$_->{dists} = [] for values %$author;

my $rs = $schema->resultset('Distribution');

while( my $p = $rs->next ) {
    push @{ $author->{$p->author_canonical}{dists} }, $p->archive;
}

DumpFile('STACK.yml', $author);

Second Step: Link authors to micropayment accounts

I picked Flattr as the micropayment platform here mostly because MetaCPAN accounts already have the hook for it. And that makes things veeeery easy on me:


#!/usr/bin/env perl 

use 5.10.0;

use strict;
use warnings;

use MetaCPAN::API;
use YAML qw/ LoadFile DumpFile/;

my $authors = -f 'STACK.yml' ? LoadFile( 'STACK.yml' ) : {};

my $mcpan = MetaCPAN::API->new;

for my $id ( keys %$authors ) {
    my $author = $mcpan->author($id) or next;
    my @profiles = @{$author->{donation} or next};
    next unless @profiles;
    my( $flattr ) = grep { $_->{name} eq 'flattr' } @profiles;
    next unless $flattr;
    next unless $flattr->{id};
    $authors->{$id}{flattr} = $flattr->{id};
}

DumpFile('STACK.yml', $authors);

Fair warning: this script will do a request for each author to the metaCPAN API. So if you ever use it, be kind and pace yourself. And don't run it every 5 minutes.

By now, we have all the information we need in the STACK.yml file, which will look something like:

---
XSAWYERX:
dists:
    - Dancer-1.3110.tar.gz
    - Dancer-Plugin-Authorize-1.110720.tar.gz
    - Dancer-Plugin-Auth-RBAC-1.110720.tar.gz
YANICK:
dists:
    - Dancer-Plugin-Cache-CHI-1.4.0.tar.gz
    - Dancer-Plugin-MobileDevice-0.04.tar.gz
flattr: yenzie

Third Step: Flattr ALL THE THINGS!

Sounds easy, but that's the part that is the most finicky. Flattr, you see, use OAuth2, which is a little hard on the brain (and doesn't seem to play nice with desktop applications). Plus, I didn't find (yet) a way to flattr an email address directly. So, in the name of Proof of Conceptitude, I decided to play quick and dirty and create a pseudo-web app for the occasion:


package FlattrCPANStack;
use Dancer ':syntax';

use 5.10.0;

use strict;
use warnings;

use Net::OAuth2::Profile::WebServer;
use JSON qw/ encode_json/;
use YAML qw/ LoadFile /;

my $auth = Net::OAuth2::Profile::WebServer->new
( name           => 'Flattr'
, client_id      => 'get one at https://flattr.com/apps/new'
, client_secret  => 'see --^'
, site           => 'https://flattr.com'
, authorize_path    => '/oauth/authorize'
, access_token_path => '/oauth/token'
, scope => 'flattr'
);

# NOTE: set the callback on the flattr app config 
# to be http://localhost:3000/oauth/callback

get '/' => sub {
    redirect $auth->authorize;
};

get '/oauth/callback' => sub {

    my $access_token  = $auth->get_access_token(param('code'));

    my $authors = LoadFile( 'STACK.yml' );

    my $page;

    for my $auth ( keys %$authors ) {
        next unless $authors->{$auth}{flattr};
        $page .= sprintf "<div>%s - %s</div>\n",
            $auth, flattr( $access_token, $auth, $authors->{$auth}{flattr} );
    }


    return $page;
};

sub flattr {
    my( $access_token, $auth, $flattr ) = @_;

    my $resp = $access_token->post(
        "http://flattr.com/submit/auto?url=https%3A%2F%2Fmetacpan.org%2Fauthor%2F$auth&user_id=$flattr"
    );

    my( $thing ) = (split '/', $resp->header('location'))[-1];

    $resp = $access_token->post(
        "https://api.flattr.com/rest/v2/things/$thing/flattr"
    );

    my %codes = (
        403 => 'flattr_once or owner',
        401 => 'flat broke',
        404 => 'Wut?',
        400 => 'you broke it',
    );

    return $codes{ $resp->code } || $resp->code;
}

dance;

That's as ugly as they come, but it'll do the deed. Run the web app, visit 'http://localhost:3000', authenticate your app and watch as the flattrs start to fly.

What's Next?

As mentioned, I picked Flattr because it was the easiest service to tap into for this proof of concept. Any suggestions for another, more advantageous micropayment system?

Working for a company that uses Perl for their bread and butter? How about convincing them to set a small montly flattring amount for the authors in their stack? Whatever module management you are using at your $workplace, the scripts showed in this entry should be easy enough to convert. As usual, the code is available on GitHub -- fork it and go wild.

And if there is an interest, I could always turn Step 3 into a bona fida web application where peeps could upload their stacks.

comments powered by Disqus

About the author

Yanick Champoux
Perl necrohacker, ACP writer, orchid lover. Slightly bonker all around. Works at Infinity Interactive