File Coverage

blib/lib/WWW/GitHub/PostReceiveHook.pm

Criterion	Covered	Total	%
statement	26	26	100.0
branch	3	4	75.0
condition	1	3	33.3
subroutine	6	6	100.0
pod	0	1	0.0
total	36	40	90.0

#
# This file is part of WWW-GitHub-PostReceiveHook
#
# This software is copyright (c) 2011 by Matt Phillips.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
use Web::Simple 'WWW::GitHub::PostReceiveHook';
package WWW::GitHub::PostReceiveHook;
# ABSTRACT: A simple means of receiving GitHub's web hooks
$WWW::GitHub::PostReceiveHook::VERSION = '0.004';
use Try::Tiny;
use JSON;
use Encode;

has routes => (
    is        => 'rw',
    predicate => 'has_routes',
    required  => 1,
    isa       => sub {
        # must be hash
        die 'Routes must be a HASH ref.' unless ref $_[0] eq 'HASH';

        # validate each route
        while (my ($key, $value) = each %{ $_[0] }) {
            # must match simple path
            die 'Routes must be of the form qr{^/\w+/?}' if $key !~ m{^/\w+/?$};
            # must map to a coderef
            die 'route must map to CODE ref.' unless ref $value eq 'CODE';
        }
    },
);

sub dispatch_request {

    sub (POST + /*) {
        my ( $self, $path ) = @_;

        # only pass along the request if it matches a given path
        return if ! $self->has_routes || ! $self->routes->{ "/$path" };

        # catch the payload
        sub (%payload=) {
            my ( $self, $payload ) = @_;
            my $response;

            try {
                # encode multibyte
                $payload = encode_utf8 $payload;

                # deserialize
                my $json = decode_json $payload;

                # callback
                $self->routes->{ "/$path" }->( $json );
            }
            catch {
                # malformed JSON string, neither array, object, number, string or atom, at character offset 0 ?
                # you are trying to POST non JSON data. don't do that.
                warn "Caught exception: /$path: attempted to trigger callback but failed:\n$_";

                # override the default 200 OK
                $response = [ 400, [ 'Content-type' => 'text/plain' ], ['Bad Request'] ];
            };

            # return catch response if set
            return $response if $response;

            $response = [ 200, [ 'Content-type' => 'text/plain' ], ['OK'] ];
        }
    },
}

1;

__END__