Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Too much spare time

  • Loading branch information...
commit 05f0b0503fd3bb8c111936714b740c845859bf2b 0 parents
@vti vti authored
3  .gitignore
@@ -0,0 +1,3 @@
+*~
+*.bak
+*.swp
35 .perltidyrc
@@ -0,0 +1,35 @@
+# Perl Best Practices (plus errata) .perltidyrc file
+
+-l=98 # Max line width is 98 cols
+-i=4 # Indent level is 4 cols
+-ci=4 # Continuation indent is 4 cols
+#-st # Output to STDOUT
+-se # Errors to STDERR
+-vt=2 # Maximal vertical tightness
+-cti=0 # No extra indentation for closing brackets
+-pt=1 # Medium parenthesis tightness
+-bt=1 # Medium brace tightness
+-sbt=1 # Medium square bracket tightness
+-bbt=1 # Medium block brace tightness
+-nsfs # No space before semicolons
+-nolq # Don't outdent long quoted strings
+-wbb="% + - * / x != == >= <= =~ < > | & **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x="
+ # Break before all operators
+
+# extras/overrides/deviations from PBP
+
+--maximum-line-length=78 # be less generous
+--warning-output # Show warnings
+--maximum-consecutive-blank-lines=2 # default is 1
+--nohanging-side-comments # troublesome for commented out code
+
+-isbc # block comments may only be indented if they have some space characters before the #
+-ci=2 # Continuation indent is 2 cols
+
+# we use version control, so just rewrite the file
+-b
+
+# for the up-tight folk :)
+-pt=2 # High parenthesis tightness
+-bt=2 # High brace tightness
+-sbt=2 # High square bracket tightness
5 MANIFEST.SKIP
@@ -0,0 +1,5 @@
+^blib
+^pm_to_blib
+.*\.old$
+^Makefile$
+^\.git
46 Makefile.PL
@@ -0,0 +1,46 @@
+#!/usr/bin/env perl
+
+use 5.008001;
+
+use strict;
+use warnings;
+
+use ExtUtils::MakeMaker;
+
+my $mm = $ExtUtils::MakeMaker::VERSION;
+
+WriteMakefile(
+ NAME => 'Bootylicious::Plugin::Xmlrpc',
+ VERSION_FROM => 'lib/Bootylicious/Plugin/Xmlrpc.pm',
+ ABSTRACT => 'Xmlrpc plugin for bootylicious',
+ AUTHOR => 'Viacheslav Tykhanovskyi <vti@cpan.org>',
+
+ ($mm < 6.3002 ? () : ('LICENSE' => 'artistic_2')),
+
+ ( $mm < 6.46
+ ? ()
+ : ( META_MERGE => {
+ requires => {perl => '5.008001'},
+ resources => {
+ homepage => 'http://getbootylicious.org',
+ license => 'http://dev.perl.org/licenses/',
+ repository =>
+ 'http://github.com/vti/bootylicious-plugin-xmlrpc/tree/master'
+ },
+ no_index => {directory => [qw/t/]}
+ },
+ META_ADD => {
+ build_requires => {},
+ configure_requires => {}
+ },
+ )
+ ),
+
+ PREREQ_PM => {
+ 'Protocol::XMLRPC' => 0,
+ 'Mojo' => 0.999909
+ },
+ test => {TESTS => 't/*.t t/*/*.t t/*/*/*.t t/*/*/*/*.t'}
+);
+
+1;
247 lib/Bootylicious/Plugin/Xmlrpc.pm
@@ -0,0 +1,247 @@
+package Bootylicious::Plugin::Xmlrpc;
+
+use strict;
+use warnings;
+
+use base 'Mojo::Base';
+
+use Protocol::XMLRPC::Dispatcher;
+use Protocol::XMLRPC::MethodResponse;
+
+our $VERSION = '0.990101';
+
+__PACKAGE__->attr('ctx');
+
+sub new {
+ my $class = shift;
+
+ my $self = $class->SUPER::new(@_);
+
+
+ return $self;
+}
+
+sub register {
+ my $self = shift;
+ my ($app, $args) = @_;
+
+ if (!defined $args->{username} || !defined $args->{password}) {
+ die 'Username and password are required';
+ }
+
+ my $dispatcher = $self->_dispatcher($app);
+
+ my $r = $app->routes;
+
+ $r->route('/xmlrpc')->via('POST')->to(
+ callback => sub {
+ my $c = shift;
+
+ $self->ctx($c);
+
+ $dispatcher->dispatch(
+ $c->req->body => sub {
+ my $method_response = shift;
+
+ $c->stash(rendered => 1);
+ $c->res->code(200);
+ $c->res->headers->content_type('text/xml');
+
+ $c->res->body($method_response->to_string);
+ }
+ );
+ }
+ );
+}
+
+sub _dispatcher {
+ my $self = shift;
+ my ($app) = @_;
+
+ return Protocol::XMLRPC::Dispatcher->new(
+ methods => {
+ 'blogger.getUsersBlogs' => {
+ ret => 'array',
+ args => [qw/string string string/],
+ handler => sub {
+ my ($api_key, $username, $password) = @_;
+
+ $self->_check_access($username, $password);
+
+ my $config = main::config();
+
+ return [
+ { url => $self->ctx->req->url->host,
+ blogid => 'bootylicious',
+ blogName => $config->{title} || ''
+ }
+ ];
+ }
+ },
+ 'metaWeblog.getCategories' => {
+ ret => 'struct',
+ args => [qw/string string string/],
+ handler => sub {
+ my @params = @_;
+ my ($blogid, $username, $password) = @_;
+
+ $self->_check_access($username, $password);
+
+ my $tags = main::get_tags();
+
+ $tags = {
+ map {
+ $_ => {
+ description => $_,
+ htmlUrl => $self->ctx->url_for(
+ 'tag',
+ tag => $_,
+ format => 'html'
+ )->to_abs,
+ rssUrl => $self->ctx->url_for(
+ 'tag',
+ tag => $_,
+ format => 'rss'
+ )->to_abs,
+ }
+ } keys %$tags
+ };
+
+ return $tags;
+ }
+ },
+ 'metaWeblog.getRecentPosts' => {
+ ret => 'array',
+ args => [qw/string string string int/],
+ handler => sub {
+ my @params = @_;
+ my ($blogid, $username, $password, $limit) = @_;
+
+ $self->_check_access($username, $password);
+
+ my ($articles) = main::get_articles(limit => $limit->value);
+
+ return [
+ map {
+ { title => $_->{title},
+ description => $_->{content},
+ content => $_->{content},
+ categories => $_->{tags}
+ }
+ } @$articles
+ ];
+ }
+ },
+ 'metaWeblog.newPost' => {
+ ret => 'string',
+ args => [qw/string string string struct boolean/],
+ handler => sub {
+ my ($blogid, $username, $password, $struct, $publish) = @_;
+
+ $self->_check_access($username, $password);
+
+ my ($year, $month);
+
+ my @time = localtime(time);
+ my $timestamp =
+ ($year = $time[5] + 1900)
+ . ($month = sprintf("%02d", $time[4] + 1))
+ . (sprintf("%02d", $time[3])) . 'T'
+ . sprintf("%02d", $time[2]) . ':'
+ . sprintf("%02d", $time[1]) . ':'
+ . sprintf("%02d", $time[0]);
+
+ my $alias = $struct->value->{title};
+ $alias = lc $alias;
+ $alias =~ s/ /-/g;
+
+ my $format = $struct->value->{format} || 'pod';
+
+ my $config = main::config();
+
+ my $articlesdir = $config->{articlesdir};
+ my $path = "$articlesdir/$timestamp-$alias.$format";
+
+ $self->_write_article($path, $struct);
+
+ return $year . '/' . $month . '/' . $alias;
+ }
+ },
+ 'metaWeblog.getPost' => {
+ ret => 'struct',
+ args => [qw/string string string/],
+ handler => sub {
+ my ($articleid, $username, $password) = @_;
+
+ $self->_check_access($username, $password);
+
+ my $article = main::get_article($articleid->value);
+ die 'Article not found' unless $article;
+
+ return {
+ title => $article->{title},
+ description => $article->{content},
+ categories => $article->{tags}
+ }
+ }
+ },
+ 'metaWeblog.editPost' => {
+ ret => 'boolean',
+ args => [qw/string string string struct boolean/],
+ handler => sub {
+ my ($articleid, $username, $password, $struct, $publish) = @_;
+
+ $self->_check_access($username, $password);
+
+ my $article = main::get_article($articleid->value);
+ die 'Article not found' unless $article;
+
+ my $path = $article->{path};
+
+ return $self->_write_article($path, $struct)
+ ? 'true'
+ : 'false';
+ }
+ }
+ }
+ );
+}
+
+sub _check_access {
+ my $self = shift;
+ my ($username, $password) = @_;
+
+ die 'Access denied'
+ unless $username
+ && $password
+ && $self->username eq $username->value
+ && $self->password eq $password->value;
+}
+
+sub _write_article {
+ my $self = shift;
+ my ($path, $struct) = @_;
+
+ my $metadata = '';
+ if (my $title = $struct->value->{title}) {
+ $metadata .= 'Title: ' . $title . "\n";
+ }
+
+ if (my @categories = @{$struct->value->{categories} || []}) {
+ $metadata .= 'Tags: ';
+ $metadata .= "$_, " for @categories;
+ $metadata =~ s/, $//;
+ $metadata .= "\n";
+ }
+ $metadata .= "\n" if $metadata;
+
+ open FILE, "> $path" or return 0;
+ print FILE $metadata;
+ print FILE $struct->value->{description}
+ || $struct->value->{content};
+ close FILE;
+
+ return 1;
+}
+
+1;
Please sign in to comment.
Something went wrong with that request. Please try again.