examples/pubsubapp - metacpan.org

#!/usr/bin/env perl

# This is a publisher/subscriber example application
# for Mojolicious::Plugin::PubSubHubbub
#
# Prerequisites:
#
#  - XML::Loy (v0.13)
#  - DBI
#  - DBD::SQLite
#
# You can run the app by starting the server with
#
#  $ pubsubapp daemon
#
# or by using either morbo or hypnotoad.
#
# For debugging, please set mode and logging level below
#
# -------------------------------------
# Copyright (C) 2011-2013, Nils Diewald
# http://nils-diewald.de/
# -------------------------------------
#
# Todo: Implement auto-refresh function
#

use strict;
use warnings;
use File::Basename 'dirname';
use File::Spec;
BEGIN {
  my @libdir = File::Spec->splitdir(dirname(__FILE__));
  use lib join '/', @libdir, 'lib';
  use lib join '/', @libdir, '..', 'lib';
};
use Mojolicious::Lite;
use Mojo::ByteStream 'b';
use DBI;
use DBD::SQLite;

# For Stream generation and Date handling.
use XML::Loy::Atom;

# Be aware - these are experimental
use XML::Loy::Date::RFC3339;
use XML::Loy::Date::RFC822;

my $DC_NS = 'http://purl.org/dc/elements/1.1/';
my $CONTENT_NS = 'http://purl.org/rss/1.0/modules/content/';

# Switch this for debugging
# app->mode('development');
# app->log->level('debug');

# Several namespaces for RSS
my $RSS_NS_RE =
  qr{^http://
     (?:www\.rssboard\.org/rss-specification|
       my\.netscape\.com/rdf/simple/0\.9/|
       backend\.userland\.com/rss2|
       purl\.org/(?:rss/1\.0/(?:modules/rss091)?|net/rss1\.1)
     )\#?$}x;


# Initialize the database if it does not exist
my $file = app->home . '/pubsub.sqlite';
sub _init_file;
unless (-e $file) {
  die 'Unable to init database' unless _init_db($file);
};


# Create database handler helper
helper dbh => sub {
  state $dbh = DBI->connect(
    "dbi:SQLite:dbname=$file", '', '' => {
      sqlite_unicode => 1
    });
};


# Return internal entries
helper own_entries => sub {
  return shift->dbh->selectall_arrayref(<<'ENTRIES', { Slice => {} });
SELECT * FROM PubSub_content WHERE internal = 1 ORDER BY updated DESC LIMIT 20 OFFSET 0
ENTRIES
};


# Register PubSubHubbub plugin
plugin 'PubSubHubbub';


# Add acceptance callback
app->callback(pubsub_accept => sub {
  my ($c, $type, $topics) = @_;

  # create quoted topic string
  my $topic_string = join(',', map(b($_)->quote, grep { $_ } @$topics));

  # Get topics and associated secrets
  my $db_request = <<"SELECT_TOPICS";
SELECT
  topic, secret FROM PubSub
WHERE
  topic in ($topic_string)
  AND mode = "subscribe"
  AND pending = 0
  AND (
    lease_seconds is NULL
    OR (started + lease_seconds) <= date("now")
  )
SELECT_TOPICS

  my $dbh = $c->dbh;

  # Start selection
  my $array = $dbh->selectall_arrayref($db_request);

  # Todo: Is the hub the one I subscribed to?

  my (%topics, $secret);

  # Iterate through all topics
  foreach (@$array) {

    # No secret needed
    unless ($_->[1]) {

      # Topic is valid
      $topics{$_->[0]} = 1;
    }

    # Secret needed
    else {

      # No secret given
      if (!$secret) {

	# Init secret
	$secret = $_->[1] if $_->[1];
      }

      # Secret already given and mismatched for bulk
      elsif ($secret ne $_->[1]) {
	$c->app->log->debug(
	  "Hub for topics $topic_string expects " .
	  'different secrets for bulk.');
	next;
      };

      # Secret matches for bulk
      $topics{$_->[0]} = 1;
    };
  };

  # Return filtered topics and secret
  return ([keys %topics], $secret);
});


# Add verification callback
app->callback(pubsub_verify => sub {
  my ($c, $params) = @_;

  my $dbh = $c->dbh;

  # Get subsrciption
  my $subscr = $dbh->selectrow_hashref(
    'SELECT * FROM PubSub WHERE topic = ? AND mode = ? AND verify_token = ?',
    { Slice => {} },
    @{$params}{qw/topic mode verify_token/}
  );

  $c->app->log->debug(
    'Found subscription with ' .
      join(', ', @{$params}{qw/topic mode verify_token/}) .
	' is ' . $c->dumper($subscr)
      );

  # No subscription of this topic found
  return unless $subscr;

  # Start transaction
  $dbh->begin_work;

  # Is subscription time over?
  if ($subscr->{lease_seconds} &&
	(time > ($subscr->{started} + $subscr->{lease_seconds}))) {

    # Delete Subscription (Maybe too hard?)
    unless ($dbh->do('DELETE FROM PubSub WHERE id = ?', {}, $subscr->{id}) >= 1) {
      $dbh->rollback and return;
    };
  };

  # If pending, update pending status
  if ($subscr->{pending}) {
    unless ($dbh->do(
      'UPDATE PubSub SET pending = 0 WHERE id = ?', {}, $subscr->{id}
    )) {

      # Abort transaction
      $dbh->rollback and return;
    }
  };

  # Commit transaction
  $dbh->commit;

  # Verify subscription
  return 1;
});


# Strip HTML - this is very simplified
sub _strip_html {
  my $string = shift;

  # Good elements
  my $ELEM = qr{p|em|strong|i|u|b};

  for ($string) {

    # Delete escape syntax from source document
    s/\{\{//g;
    s/\}\}//g;

    # Reformulate valid anchors
    s!<a\s+[^\>]*?href=([\'\"]?)(https?:[^\1]+?)\1\s*[^>]*?>(.+?)</a>!\{\{$2\}\{$3\}\}!gi;

    # Delete script and style tags including content
    s!<\s*(script|styles)[^>]*?>(?:.+?)<\s*/\s*\1\s*>!!gi;

    # Escape valid elements
    s!<($ELEM)[^>]*?>(.+?)</\s*\1\s*>!\{\{$1\}\}$2\{\{/$1\}\}!gi;

    # Escape linebreaks
    s!<br[^>]*?/?>!\{\{br /\}\}!gi;

    # Reformulate image tags
    # Todo: Support base64 images
    s!<img\s+[^\>]*?src=([\'\"]?)(https?:[^\1]+?)\1\s*[^>]*?/?>!\{\{img\}\{$2\}\}!gi;

    # Reformulate header tags
    s!<(h\d)[^>]*?>(.+?)</\s*\1\s*>!\{\{strong\}\}$2\{\{/strong\}\}!gi;

    # Delete all invalid markup
    s/<[^>]+?>/ /g;

    # Reintroduce images
    s!\{\{img\}\{([^\}]+?)\}\}!<br /><img src="$1" alt="" /><br />!g;

    # Invalid reformulations are deleted
    s!\{\{([^\}]+?)\}\{\s*\}\}!!g;

    # Reintroduce anchors
    s!\{\{([^\}]+?)\}\{([^\}]+?)\}\}!<a href="$1">$2</a>!g;

    # Reintroduce valid tags
    s/\{\{([^\}]+?)\}\}/<$1>/gi;

    # Cleanup
    # Delete empty elements
    s!<($ELEM|a)[^>]*?>\s*</\1>!!gi;

    # Make paragraphs new linebreaks
    s!<p>(.+?)</p>!$1<br />!gi;

    # Make repeating linebreaks single linebreaks
    s!<br\s*\/>(\s*<br\s*\/>)+!<br />!gi;

    # Delete double linebreaks around starting tags (not images)
    s!<br\s*\/>\s*<\/($ELEM|a)\s*>\s*<br\s*\/>!</$1><br />!gi;

    # Delete linebreaks at documents end
    s!(?:<br\s*/>)+(<\s/\s*(?:a|$ELEM)\s*>\s*)$!$1!;
    s!(?:<br\s*/>)+$!!;

    # Delete linebreaks at documents start
    s!^(<(?:a|$ELEM)[^>]*?>\s*)(?:<br\s*/>)+!$1!;
    s!^(?:<br\s*/>)+!!;

  };
  return b($string)->squish;
};


# How to handle the newly arrived content?
hook on_pubsub_content => sub {
  my ($c, $type, $dom) = @_;

  my (@feed, $author);

  # Get feed creator
  my $elem = $dom->at('creator');
  if ($elem && $elem->namespace eq $DC_NS) {
    $author = $elem->all_text;
  };

  # Feed is Atom
  if ($type eq 'atom') {

    # Get feed author
    $elem = $dom->at('author > name');
    my $author = $elem ? $elem->all_text : $author;

    # Iterate through all entries
    $dom->find('entry')->each(
      sub {
	my $entry = shift;

	# Get topic
	my %info = (
	  topic => $entry->at('source > link[rel="self"][href]')->attrs('href')
	);

	# Set guid
	$elem = $entry->at('id');
	$info{'guid'} = $elem ? $elem->all_text : '';

	# Get title and content information
	foreach (qw/title content/) {
	  $elem = $entry->at($_);
	  my $content;
	  if ($elem) {

	    # xhtml content
	    if ($elem->attrs('type') eq 'xhtml') {
	      $content = $elem->to_xml;
	    }

	    # html or text content
	    else {
	      $content = $elem->all_text;
	    }
	  };

	  # Strip html from content
	  $info{$_} = _strip_html($content);
	};

	# Get entry author
	$elem = $entry->at('author');
	$info{author} = $elem ? $elem->all_text : $author;

	# Set link
	my $link = $entry->at('link[rel="alternate"][href]');
	$info{link} = $link->attrs('href') if $link;

	# Set updated date
	$elem = $entry->at('updated');
	if ($elem) {
	  $info{updated} = XML::Loy::Date::RFC3339->new( $elem->text )->epoch;
	}

	# Dublin core time
	elsif ($elem = $entry->at('date') && $elem->namespace eq $DC_NS) {
	  $info{updated} = XML::Loy::Date::RFC3339->new( $elem->text )->epoch
	};

	# Unknown - use current time
	$info{updated} ||= time;

	# Add info to feed
	push(@feed, \%info);
      }
    );
  }

  # Feed is RSS
  elsif ($type eq 'rss') {

    # Iterate through all items
    $dom->find('item')->each(
      sub {
	my $entry = shift;

	# Get topic
	my %info = (
	  topic => $entry->at('source > link[rel="self"][href]')->attrs('href')
	);

	# Set title, guid, updated and content
	foreach (qw/title guid pubDate description/) {
	  my $p = $_;
	  $elem = $entry->at($p);

	  # Rename pubDate
	  if ($p eq 'pubDate') {
	    $p = 'updated';
	  }

	  # Rename description
	  elsif ($p eq 'description') {
	    $p = 'content';
	  };

	  # Set info
	  $info{$p} = $elem ? _strip_html($elem->all_text) : '';
	};

	# content:encoded element
	$elem = $entry->at('encoded');
	if ($elem && $elem->namespace eq $CONTENT_NS) {
	  $info{content} = _strip_html($elem->all_text);
	};

	# Get author
	$elem = $entry->at('author');
	if ($elem) {
	  $info{author} = $elem->all_text;
	}

	# Get creator
	elsif ($elem = $entry->at('creator')) {
	  $info{author} = $elem->all_text if $elem->namespace eq $DC_NS;
	};

	# Set feed author if not further specified
	$info{author} ||= $author;

	# Check rdf:about for a guid
	$info{guid} //= $entry->attrs('rdf:about');

	# Get link
	my $link = $entry->at('link');
	if ($link && (!$link->namespace || $link->namespace =~ $RSS_NS_RE)) {
	  $info{link} = $link->text;
	};

	# Set updated to epoch time
	if ($info{updated}) {
	  $info{updated} = XML::Loy::Date::RFC822->new( $info{updated} )->epoch;
	}

	# Dublin Core time
	elsif ($elem = $entry->at('date') && $elem->namespace eq $DC_NS) {
	  $info{updated} = XML::Loy::Date::RFC3339->new($elem->text)->epoch
	};

	# Add info to feed
	push(@feed, \%info);
      });
  };

  # Content is there
  $c->app->log->debug("Insert or update content: \n". $c->dumper(\@feed));

  my $dbh = $c->dbh;

  # Prepare Update
  my $sth_update = $dbh->prepare(
    'UPDATE PubSub_content SET ' .
      'author = ?, updated = ?, title = ?, content = ?, link = ? ' .
        'WHERE guid = ? AND topic = ? AND internal = 0'
  );

  # Prepare Insert
  my $sth_insert = $dbh->prepare(
    'INSERT INTO PubSub_content ' .
      '(topic, author, updated, title, content, link, guid, internal) ' .
	'VALUES ' .
	  '(?,?,?,?,?,?,?,0)'
  );

  # Start transaction
  $dbh->begin_work;

  # Import all entries to database
  foreach my $entry (@feed) {
    my $update = $sth_update->execute(@{$entry}{qw/author updated title content link guid topic/});

    # An error occured
    unless ($update) {
      $dbh->rollback and return;
    }

    # Update was not successful
    elsif ($update < 1) {

      # Insert
      unless ($sth_insert->execute(@{$entry}{qw/topic author updated title content link guid/})) {
        $dbh->rollback and return;
      };
    };
  };

  # Commit insertions
  $dbh->commit;

  return;
};


# Store subscription information before subscription or unsubscription
sub _store_subscription {
  my ($c, $param, $post) = @_;

  my $log = $c->app->log;

  my @keys = qw(hub lease_seconds secret verify_token mode pending started mode);

  # Set pending and starting time
  $param->{pending} = 1;
  $param->{started} = time;

  my @values = (@{$param}{@keys}, $param->{topic});

  my $dbh = $c->dbh;

  # Update Subscription SQL
  my $sql =
    'UPDATE PubSub SET ' .
      join(', ', map { $_ . ' = ?' } @keys) .
	' WHERE topic = ?';

  my $sth = $dbh->prepare($sql);

  unless ($sth) {
    $log->warn('Unable to prepare ' . $sql);
    return;
  };

  my $rv = $sth->execute(@values);

  # Execution not successful
  if (!$rv || $rv < 1) {

    # Insert Subscription SQL
    $sql = 'INSERT INTO PubSub (' .
	join(',', @keys, 'topic') . ') VALUES (' . join(',', ('?') x 9) . ')';

    # Prepare statement
    $sth = $dbh->prepare($sql);

    # Execution not successful
    unless ($sth->execute(@values)) {
      $log->warn('Unable to ' . $param->{mode} . ' to ' . $param->{topic});
    };
  };

  # Return
  return;
};


# Debug unsubscription and subscription
if (app->log->level eq 'debug') {
  foreach my $mode (qw/subscribe unsubscribe/) {
    hook 'after_pubsub_' . $mode => sub {
      my ($c, $hub, $param, $code, $body) = @_;
      for ($c->app->log) {
	$_->debug("Successfully ${mode}d to $hub with ". $c->dumper($param));
	$_->debug("Response: $code\n$body");
      };
    };
  };

  hook before_dispatch => sub {
    my $c = shift;
    $c->app->log->debug('Requesting: ' . $c->req->url->to_abs);
  }
};


# Unified event for subscription and unsubscribing
hook before_pubsub_subscribe   => \&_store_subscription;
hook before_pubsub_unsubscribe => \&_store_subscription;



# ------
# ROUTES
# ------


# Set PubSub shortcut
any('/ps-callback')->pubsub;


# -----------------
# SUBSCRIBER ROUTES
# -----------------


# Show last received content from subscription and subscription form
get '/feeds' => sub {
  my $c = shift;

  my $dbh = $c->dbh;

  # Get subscriptions from database
  my $subscriptions =
    $dbh->selectall_arrayref('SELECT * FROM PubSub', { Slice => {} });

  # Get latest entries
  my $entries = $dbh->selectall_arrayref(<<'ENTRIES', { Slice => {} });
SELECT PubSub_content.*, PubSub.id as topic_id
FROM PubSub_content, PubSub
WHERE
  PubSub_content.internal = 0 AND
  PubSub_content.topic = PubSub.topic
ORDER BY updated DESC
LIMIT 20 OFFSET 0
ENTRIES

  # Render page
  $c->render(
    template      => 'feeds',
    entries       => $entries,
    subscriptions => $subscriptions
  );
} => 'feeds';


# Show topic
get '/topic/:id' => [id => qr/\d+/] => sub {
  my $c   = shift;
  my $id  = $c->stash('id');
  my $dbh = $c->dbh;

  # Get latest entries of topic
  my $entries = $dbh->selectall_arrayref(<<'TOPICSELECT', { Slice => {} }, $id);
SELECT PubSub_content.*, PubSub.id AS topic_id
FROM PubSub_content, PubSub
WHERE
  PubSub.topic = PubSub_content.topic AND
  PubSub.id = ? AND
  PubSub_content.internal = 0
ORDER BY updated DESC LIMIT 10
TOPICSELECT

  # Render topic
  if ($entries && @$entries >= 1) {
    return $c->render(
      template => 'topic',
      topic_id => $id,
      entries  => $entries,
      topic    => $entries->[0]->{topic}
    );
  };

  # Topic unknown
  return $c->render_not_found;
} => 'topic';


# Unsubscribe from topic
get '/topic/:id/unsubscribe' => [id => qr/\d+/] => sub {
  my $c = shift;
  my $id   = $c->stash('id');
  my $dbh  = $c->dbh;

  my $msg;

  # Check if subscribed to topic
  my $feed = $dbh->selectrow_hashref(
    'SELECT topic, mode, hub, secret, verify_token FROM PubSub WHERE id = ?',
    { Slice => {} },
    $id
  );

  # Topic is listed
  if ($feed) {

    # Subscribed to topic
    if ($feed->{topic} && $feed->{mode} eq 'subscribe') {

      # Delete mode information
      delete $feed->{mode};

      # Unsubscription successful
      if ($c->pubsub_unsubscribe( %$feed )) {
	$msg = 'You unsubscribed from ' . $feed->{topic};
      }

      # Not successful
      else {
	$msg = 'Unable to unsubscribe from ' . $feed->{topic};
      };
    }

    # Is not subscribed
    else {
      $msg = 'You are not subscribe ' . $feed->{topic};
    };
  }

  # Not subscribed to topic
  else {
    $msg = 'You did not subscribe to that feed';
  };

  # Flash message
  $c->flash(message => $msg);

  return $c->redirect_to('feeds');
} => 'unsubscribe';


# Subscribe to new feed (post or get)
any '/topic/subscribe' => sub {
  my $c = shift;

  my $hub    = $c->param('hub');
  my $topic  = $c->param('topic');
  my $secret = $c->param('secret');

  # Missing information
  unless ($hub && $topic) {

    # Set information to flash
    $c->flash(
      hub    => $hub,
      feed   => $topic,
      secret => $secret
    );

    # Retry
    return $c->redirect_to('feeds');
  };

  # Create new parameter hash
  my %new_param = (
    topic => $topic,
    hub   => $hub
  );

  # Set secret
  $new_param{secret} = $secret if $secret;

  # Subscribe to new feed
  if ($c->pubsub_subscribe( %new_param )) {
    $c->flash(message => 'You subscribed to ' . $topic);
  }

  # Failed to subscribe to new feed
  else {
    $c->flash(message => 'Unable to subscribe to ' . $topic . ':' . $hub);
  };

  # Todo: Update stored database

  # Redirect
  return $c->redirect_to('feeds');
} => 'subscribe';


# Discover topic and hub based on a uri
get '/discover' => sub {
  my $c = shift;
  my $uri = $c->param('uri');

  # No uri given
  return $c->render_not_found unless $uri;

  # Discover uri
  my ($topic, $hub) = $c->pubsub_discover($uri);

  # Set information
  $c->flash(hub   => $hub)   if $hub;
  $c->flash(topic => $topic) if $topic;
  $c->flash(uri   => $uri);

  # Redirect to feeds
  return $c->redirect_to('feeds');
} => 'discover';


# ----------------
# PUBLISHER ROUTES
# ----------------


# Show blog
get '/' => sub {
  my $c = shift;

  # Get internal entries
  my $entries = $c->own_entries;

  # Render latest entries
  return $c->render(
    template => 'blog',
    entries  => $entries,
    is_blog  => 1
  );
} => 'index';


# Get atom feed
get '/atom' => sub {
  my $c = shift;

  # Create new atom object
  my $atom = XML::Loy::Atom->new('feed');

  # Set charset
  $atom->charset('UTF-8');

  # Get this uri
  my $self = $c->url_for('atom')->to_abs->to_string;

  # Set self link
  $atom->link(self => $self);
  $atom->id($self);

  # Set hub
  $atom->link(hub => $c->endpoint('pubsub-hub'));

  # Set feed author (Unknown)
  $atom->author(name => 'Unknown');

  # Get internal entries
  my $own_entries = $c->own_entries;

  # Create entries
  foreach my $own (@$own_entries) {

    # Create new entry
    my $entry = $atom->entry( id => $own->{guid} );

    # Set sub elements
    for ($entry) {

      # Set author
      $_->author(name => $own->{author});

      # Set title
      $_->title(html => $own->{title});

      # Set updated date
      $_->updated($own->{updated});

      # Set content
      $_->content(html => $own->{content});

      # Set alternate representation link
      $_->link(
	rel  => 'alternate',
	href => $own->{link},
	type => 'text/html'
      )
    };
  };

  # Get mime type
  my $mime = $atom->mime;

  # Encode data to utf-8
  $atom = b($atom->to_pretty_xml)->encode->to_string;

  # Render xml data
  $c->render(data => $atom);

  # Set mime type
  $c->res->headers->content_type($mime);

  return;
} => 'atom';


# Show entry
get '/entry/:id' => [id => qr/\d+/] => sub {
  my $c   = shift;
  my $id  = $c->stash('id');
  my $dbh = $c->dbh;

  # Select entry information
  my $entry = $dbh->selectrow_hashref(
    'SELECT * FROM PubSub_content WHERE internal = 1 AND id = ?',
    { Slice => {} },
    $id
  );

  # Entry not found
  return $c->render_not_found unless $entry;

  # Render entry
  return $c->render(
    template => 'entry',
    entry    => $entry
  );
};


# Post new entry
post '/entry' => sub {
  my $c = shift;

  my $dbh = $c->dbh;

  # Get author, title and content
  my $author  = $c->param('author');
  my $title   = $c->param('title');
  my $content = $c->param('content');

  # Everything is given
  if ($author && $title && $content) {

    # Start transaction
    $dbh->begin_work;

    # Prepare new entry insertion SQL
    my $sth = $dbh->prepare(<<'CONTENT');
INSERT INTO PubSub_content (author, title, content, topic, updated, internal)
VALUES (?, ?, ?, ?, ?, 1)
CONTENT

    # Get topic url
    my $topic = $c->url_for('atom')->to_abs->to_string;

    # Insertion was successful
    if ($sth && $sth->execute($author, $title, $content, $topic, time)) {

      # Get latest id for guid
      my $id = $dbh->last_insert_id(undef, undef, undef, undef);

      # Create unique guid
      my $guid = $c->url_for->to_abs . '/' . $id;

      # Prepare update SQL
      $sth = $dbh->prepare('UPDATE PubSub_content SET guid = ?, link = ? WHERE id = ?');

      # Update guid and link information
      if ($guid && $sth && $sth->execute($guid, $guid, $id)) {


	# Successful transaction
	$dbh->commit;

	# Notify hub for new content
	my $msg = 'You posted a new entry';
	if ($c->pubsub_publish('atom')) {
	  $msg .= ' and notified '. $c->endpoint('pubsub-hub') . ' about ' . $topic;
	};

	# Set flash message
	$c->flash(message => $msg);

	# Delete information not to be flashed
	$title   = undef;
	$content = undef;
      }

      # Unable to update guid and link information
      else {
	$c->flash(message => 'Unable to post new entry - please retry');

	# Abort transaction
	$dbh->rollback;
      };
    }

    # Insertion was not successful
    else {
      $c->flash(message => 'Unable to post new entry - please retry');

      # Abort transaction
      $dbh->rollback;
    };
  }

  # Information is missing
  else {
    $c->flash(message => 'Unable to post new entry - Please define author, title and content');
  };

  # Set flash information
  $c->flash(author  => $author)  if $author;
  $c->flash(title   => $title)   if $title;
  $c->flash(content => $content) if $content;

  # Redirect
  return $c->redirect_to('index');
} => 'entry';


# Set styles as a template (for reference)
get '/styles' => sub { shift->render('styles')} => 'styles';


# -------------------
# INITIALIZE DATABASE
# -------------------


# Initialize database
sub _init_db {
  my $file = shift;

  # Get database handle
  my $dbh = DBI->connect(
    "dbi:SQLite:dbname=$file", '', '' => {
      sqlite_unicode => 1
    });

  # Start transaction
  $dbh->begin_work;

  # Topic subscription
  unless ($dbh->do(
    'CREATE TABLE PubSub (
       id            INTEGER PRIMARY KEY,
       topic         TEXT NOT NULL,
       mode          TEXT NOT NULL,
       hub           TEXT,
       pending       INTEGER,
       lease_seconds INTEGER,
       secret        TEXT,
       verify_token  TEXT,
       started       INTEGER
     )'
  )) {
    $dbh->rollback and return;
  };

  # Topic subscription indices
  unless ($dbh->do(
    'CREATE INDEX IF NOT EXISTS pubsub_topic_i on PubSub (topic)'
  )) {
    $dbh->rollback and return;
  };

  # Content
  unless ($dbh->do(
    'CREATE TABLE PubSub_content (
       id       INTEGER PRIMARY KEY,
       author   TEXT,
       guid     TEXT,
       title    TEXT,
       updated  INTEGER,
       content  TEXT,
       link     TEXT,
       topic    TEXT,
       internal BOOLEAN
     )')) {
    $dbh->rollback and return;
  };

  # Content indices
  foreach (qw/guid updated/) {
    unless ($dbh->do(
      "CREATE INDEX IF NOT EXISTS pubsub_content_${_}_i " .
	"on PubSub_content (${_})"
    )) {
      $dbh->rollback and return;
    }
  };

  # Everything went fine
  $dbh->commit and return 1;
};


# Start application
app->start;


__DATA__

@@ layouts/index.html.ep
<!doctype html>
<html>
  <head>
%= stylesheet "https://fonts.googleapis.com/css?family=Chivo:900"
%= stylesheet "https://fonts.googleapis.com/css?family=Inconsolata:400"
%= stylesheet "http://sojolicio.us/stylesheets/styles.css", media => "screen"
%= stylesheet "http://sojolicio.us/stylesheets/prettify-mojo.css", media => "screen"
%= stylesheet url_for 'styles', format => 'css'
    <link rel="icon" href="http://sojolicio.us/images/favicon.ico" type="image/x-icon" />
% if (stash('is_blog')) {
    <link rel="alternate" type="application/atom+xml" href="<%= endpoint 'atom' %>" />
    <link rel="hub" href="<%= endpoint 'pubsub-hub' %>" />
% };
    <title><%= $title %></title>
  </head>
  <body>

%# Flash message
% if (my $m = flash('message')) {
<p style="color: <% if ($m =~ /unable/i) { %>red<% } else { %>green<% } %>"><%= $m %></p>
% };
    <div id="container">
      <div id="logo"></div>
      <a id="github-ribbon" href="https://github.com/Akron/Mojolicious-Plugin-PubSubHubbub">
        <img src="https://s3.amazonaws.com/github/ribbons/forkme_right_orange_ff7600.png" alt="Fork me on GitHub">
      </a>
      <div class="inner">
      <header>
        <h1><%= $title %></h1>
        <h3><%= stash('subtitle') || 'Sojolicious PubSubHubbub-Demo' %></h3>
        <a href="<%= url_for 'index' %>">Blog</a> |
        <a href="<%= url_for 'feeds' %>">Feeds</a>
      </header>
      <section>
%== content
      </section>
    </div>
  </body>
</html>



@@ article.html.ep
<article>
% if ($entry->{link}) {
  <h2><a href="<%= $entry->{link} %>"><%== $entry->{title} %></a></h2>
% } else {
  <h2><%== $entry->{title} %></h2>
% };
  <p class="byline">von
% if ($entry->{topic}) {
   <a href="<%= $entry->{topic} %>"><%= $entry->{author} || 'Feed' %></a>
   [<a href="<%= url_for 'topic', id => $entry->{topic_id} %>">Internal</a>],
% } else {
   <%= $entry->{author} || 'Feed' %>,
% };
% my $date = $entry->{updated} ?
%    XML::Loy::Date::RFC3339->new($entry->{updated})->to_string : '';
   <%= $date %>
  </p>

  <p><%== $entry->{content} %></p>
</article>



@@ feeds.html.ep
% layout 'index', title => 'PubSubHubbub';

% my $subs = stash('subscriptions') || [];
% my $content = stash('entries') || [];

<h2>New Subscription</h2>

<p style="text-align: right;"><a href="<%= endpoint 'pubsub-hub' %>">Hub</a> |
<a href="<%= endpoint 'pubsub-callback' %>">Callback</a></p>

%# Discovery
<form method="get" action="<%= url_for 'discover' %>">
  <input type="text" name="uri" id="uri" value="<%= flash 'uri' %>" />
  <input type="submit" value="Discover" />
</form>

<br />

%# New subscription
<form method="post" action="<%= url_for 'subscribe' %>">
% foreach (qw/topic hub secret/) {
  <label for="<%= $_ %>"><%= ucfirst($_) %></label>
  <input type="text" name="<%= $_ %>" id="<%= $_ %>" value="<%= flash($_) %>" /><% unless ($_ eq 'secret') { %><br /><% } %>
% }
  <input type="submit" value="OK" />
</form>

%# Subscriptions
% if (@$subs) {
<h2>Subscriptions</h2>
<ul id="subscriptions">
%   foreach my $sub ( @$subs ) {
%     if ($sub->{mode} eq 'unsubscribe') {
  <li class="unsubscribed">
%     } elsif ($sub->{pending}) {
  <li class="pending">
%     } else {
  <li>
%     }
    <a class="sub-topic" href="<%= url_for 'topic', id => $sub->{id} %>"><%= $sub->{topic} %></a>
%     if ($sub->{pending} || $sub->{mode} eq 'unsubscribe') {
%       my %new_param =  (
%         topic => $sub->{topic},
%         hub   => $sub->{hub}
%       );
%       $new_param{secret} = $sub->{secret} if $sub->{secret};
%       my $url = url_for('subscribe');
%       $url->query( %new_param );
    [<a href="<%= $url %>">resubscribe</a>]
%     } else {
    [<a href="<%= url_for 'unsubscribe', id => $sub->{id} %>">unsubscribe</a>]
%     };
  </li>
%   };
</ul>
% };

%# Entries
% if (@$entries) {
<h2>Feed</h2>
%   foreach my $entry ( @$entries ) {
  %= include 'article', entry => $entry
%   };
% };



@@ blog.html.ep
% layout 'index', title => 'My Blog';

<h2>New post</h2>

%# New post
<form method="post" action="<%= url_for 'entry' %>">
% foreach (qw/author title/) {
  <label for="<%= $_ %>"><%= ucfirst $_ %></label>
  <input type="text" name="<%= $_ %>" value="<%= flash $_ %>" /><br />
% }
  <textarea name="content"><%= flash 'content' %></textarea>
  <input type="submit" value="Post" />
</form>

%# Entries
% if (@$entries) {
<h2>Feed</h2>
%   foreach my $entry ( @$entries ) {
  %= include 'article', entry => $entry
%   };
% };



@@ topic.html.ep
% layout 'index', title => 'Show Topic', subtitle => $topic;

% my $content = stash('entries') || [];

% foreach my $entry ( @$content ) {
  %= include 'article', entry => $entry
% };



@@ entry.html.ep
% layout 'index', title => 'Show Entry', subtitle => $entry->{guid};
%= include 'article', entry => $entry



@@ styles.css.ep
ul#subscriptions {
  font-size: 80%;
  padding: 2em;
  background-color: #e7e7e7;
}

ul#subscriptions li {
  padding: .2em;
}

ul#subscriptions li.pending a.sub-topic {
  color: #ddffdd;
}

ul#subscriptions li.unsubscribed a.sub-topic {
  color: #ff0000;
  text-decoration: line-through;
}

h2 {
  margin-top: 1em;
}

form {
  padding: .5em;
  background-color: transparent;
}

input, textarea {
  border: 2px solid #00A3BA;
  background-color: #e7e7e7;
  color: #444;
  padding: .1em;
  margin: .2em;
}

textarea {
  width: 100%;
  height: 10em;
}

label {
  display: inline-block;
  width: 4em;
}

article {
  position: relative;
  background-color: white;
  margin: 12px auto 0px auto;
  max-width: 800px;
  min-width: 300px;
  padding: 0px 10px;
  border: 2px solid #00A3BA;
  border-radius: 10px;
  text-align: justify;
  -moz-hyphen: auto;
  -webkit-hyphen: auto;
  hyphen: auto;
}

article h2 {
  font-size: 100%;
  margin-top: .3em;
  margin-bottom: 0;
  padding-bottom: 0;
  border-bottom: 2px solid #999;
}

article h2 a {
  text-decoration: none;
}

article p {
  margin: 0 20px 1.1em 10px;
  line-height: 1.7em;
}

article p img {
  max-width: 100%;
}

p.byline {
  margin: 0 0 5px 0;
  font-size: 80%;
  color: #777;
}

p:last-child {
  margin-bottom: .4em;
}
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)