view release on metacpan or  search on metacpan

lib/Bootylicious/Plugin/Pingback.pm  view on Meta::CPAN

package Bootylicious::Plugin::Pingback;

use strict;
use warnings;

use base 'Mojolicious::Plugin';

use Mojo::DOM;

sub register {
    my ($self, $app, $conf) = @_;

    $conf ||= {};

    $app->routes->route('/pingback')->to(cb => \&_pingback)->name('pingback');
    unshift @{$app->renderer->classes}, __PACKAGE__;

    $app->plugins->on(
        after_dispatch => sub {
            my ($c) = @_;

            return unless $c->req->method =~ m/GET|HEAD/;

            return unless $c->res->code && $c->res->code == 200;

            return unless $c->match->endpoint->name eq 'article';

            $c->res->headers->header(
                'X-Pingback' => $c->url_for('pingback', format => undef)->to_abs);
        }
    );
}

sub _pingback {
    my $self = shift;

    my ($source_uri, $target_uri) = _parse_xmlrpc($self);
    return _render_bad_request($self) unless $source_uri && $target_uri;

    return _render_target_invalid($self)
      unless $target_uri =~ m{^/articles/(\d+)/(\d+)/(.*)};

    my ($year, $month, $name) = ($1, $2, $3);
    $name =~ s/\..*$//;

    my $article = $self->get_article($year, $month, $name);
    return _render_target_not_found($self) unless $article;

    $self->app->log->debug("Fetching $source_uri...");

    $self->ua->get(
        $source_uri => sub {
            my $tx = pop;

            $self->app->log->debug("Fetched $source_uri");

            return _render_source_not_found($self)
              unless $tx->res->code && $tx->res->code == 200;

            return _render_source_invalid($self)
              unless $tx->res->body =~ m{\Q$target_uri\E};

            return _render_pingback_already_registered($self)
              if $article->has_pingback($source_uri);

            $article->pingback($source_uri);

            return _render_success($self);
        }
    );
}

sub _parse_xmlrpc {
    my $self = shift;

    return unless $self->req->method eq 'POST' && $self->req->body;

    my $dom = Mojo::DOM->new;
    $dom = $dom->parse($self->req->body);

    my $method = $dom->at('methodCall');
    return unless $method;

    my $method_name = $method->at('methodName');
    return unless $method_name->text eq 'pingback.ping';