#!/usr/bin/perl

use strict;
use warnings;

use Apache::Htpasswd;
use CGI;
use Getopt::Long qw(:config auto_help);
use JSON::Any;
use HTML::Prototype;
use HTTP::Date;
use HTTP::Status;
use MIME::Base64;
use Pod::Usage;
use POE qw(Component::Server::HTTP);
use Template;
use URI;
use YAML;

our $VERSION = '0.01';

GetOptions(
    '-pass=s'    => \my $htpasswd_path,
    '-dump=s'    => \my $dump_path,
    '-port=s'    => \my $port,
    '-logline=s' => \my $logline,
    '--quiet'    => \my $quiet
);
pod2usage(1) unless $htpasswd_path && $dump_path;

my $htpasswd;
my $status = {
    message_id => 0,
    messages   => [],
    users      => {},
};

$status = YAML::LoadFile($dump_path) or die $! if -f $dump_path;
$port = '' unless $port && $port =~ /^\d+$/;
$logline = 50 unless $logline && $logline =~ /^\d+$/;


my $server = POE::Component::Server::HTTP->new(
    Port => $port || 8888,
    Headers => {
        Server => "Twitterd/$VERSION",
    },
    ContentHandler => {
        '/'            => \&index,
    },
    PreHandler => {
        '/'            => \&auth,
    },
);
$poe_kernel->run();
exit();

1;

sub auth {
    my($req, $res) = @_;

    $res->code(RC_OK);
    $htpasswd = Apache::Htpasswd->new({
        passwdFile => $htpasswd_path,
        ReadOnly   => 1,
    });

    my($user, $pass) = $req->authorization_basic;
    return RC_OK if $user && $htpasswd->htCheckPassword($user, $pass);

    $res->code(RC_UNAUTHORIZED);
    $res->header('WWW-Authenticate' => 'Basic realm="user login"');
    $res->content('ERROR');

    return RC_DENY;
}

sub index {
    my($req, $res) = @_;

    print sprintf "[%s] - - '%s %s'\n", time2str(time), $req->method, $req->uri;
    return RC_DENY unless $res->code eq RC_OK;

    my $query;
    if ($req->method eq 'GET') {
        $query = CGI->new($req->uri->query);
    } elsif ($req->method eq 'POST') {
        $query = CGI->new($req->content);
    } else {
        $res->code(RC_BAD_REQUEST);
        return RC_DENY;
    }
    $query->charset("utf-8");

    my($user) = $req->authorization_basic;
    my $to_user;
    if ($req->uri->path =~ m!^/statuses/update(?:\..+)?$!) {
        update($req, $res, $query, $user);
    } elsif ($req->uri->path =~ m!^/statuses/(friends|public)_timeline(?:/(.+?))?.json$!) {
        friends_timeline($req, $res, $query);
    } elsif ($req->uri->path =~ m!^/statuses/user_timeline(?:/(.+?))?.json$!) {
        my $by_user = $1 || $user;
        user_timeline($req, $res, $query, $by_user);
    } elsif ($req->uri->path eq '/spinner') {
        show_spinner($res);
    } elsif (($to_user) = ($req->uri->path =~ m!^/(.+)!)) {# && print "TO: $to_user,\n" && 
        unless ($htpasswd->fetchPass($to_user)) {
            $res->code(RC_NOT_FOUND);
            return RC_DENY;
        }
        home($req, $res, $query, $user, $to_user);
    } elsif ($req->uri->path eq '/') {
        home($req, $res, $query, $user);
    } else {
        $res->code(RC_NOT_FOUND);
        return RC_DENY;
    }

    return RC_OK;
}

sub home {
    my($req, $res, $query, $user, $to_user) = @_;

    my $tt = Template->new;
    my $template = home_template();

    my $stash;
    $stash->{prototype} = HTML::Prototype->new;
    $stash->{user}      = $user || '';
    $stash->{to_user}   = $to_user || '';

    $tt->process(\$template, $stash, \my $out);

    $res->header('text/html; charset=utf-8');
    $res->content($out);
}

sub update {
    my($req, $res, $query, $user) = @_;

    my $text  = $query->param('status');
    unless ($text) {
        return unless $status->{users}->{$user};
        my @ids = sort { $b <=> $a } keys %{ $status->{users}->{$user} };
        my $last_id = shift @ids;
        my $last_message = $status->{users}->{$user}->{$last_id};
        $res->content(JSON::Any->objToJson($last_message));
        return;
    }

    $status->{message_id}++;
    my $message = {
        created_at => time2str(time),
        text       => $text,
        id         => $status->{message_id},
        user       => {
            name              => $user,
            description       => '',
            location          => '',
            url               => '',
            screen_name       => $user,
            id                => $user,
            protected         => '',
            profile_image_url => '',
        },
    };
    unshift @{ $status->{messages} }, $message;
    $status->{users}->{$user}->{$status->{message_id}} = $message;

    if (scalar(@{ $status->{messages} }) > $logline) {
        my $delete = pop @{ $status->{messages} };
        my $time   = str2time($delete->{created_at});
        delete $status->{users}->{$delete->{user}}->{$delete->{id}};
    }
    $res->content(JSON::Any->objToJson($message));
    YAML::DumpFile($dump_path, $status);
}

sub friends_timeline {
    my($req, $res, $query) = @_;

    return $res->content(JSON::Any->objToJson($status->{messages})) unless $query->param('since');

    my $since = str2time($query->param('since'));
    my $msgs = [];
    for my $msg (@{ $status->{messages} }) {
        next if str2time($msg->{created_at}) < $since;
        push @{ $msgs }, $msg;
    }
    $res->content(JSON::Any->objToJson($msgs));
}

sub user_timeline {
    my($req, $res, $query, $user) = @_;

    my $msgs = [];
    my $since = $query->param('since') ? str2time($query->param('since')) : 0;
    for my $id ( sort {$b <=> $a} keys %{ $status->{users}->{$user} }) {
        my $msg = $status->{users}->{$user}->{$id};
        next if str2time($msg->{created_at}) < $since;
        push @{ $msgs }, $msg;
    }
    $res->content(JSON::Any->objToJson($msgs));
}

sub home_template {
    return <<'TEMPLATE';
[% SET title = "Twitterd" -%]
[% IF to_user %][% SET title = title _ ' - ' _ to_user %][% END %]
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<title>[% title %]</title>
<style>
body,input,td { font-size: 11px; font-family: trebuchet MS }
input { background: #fff }
h1 { font-size: 2em }
h2 { font-size: 1.6em }
.name { color: #00f }
.date { color: #f00 }
</style>
[% prototype.define_javascript_functions %]
<script>
[% IF to_user %]
var timeline_url = '/statuses/user_timeline/[% to_user | uri %].json';
[% ELSE %]
var timeline_url = '/statuses/friends_timeline.json';
[% END %]
function update(status) {
  $('spinner').innerHTML = "<img src=\"/spinner\" style=\"vertical-align:middle\" />";
  var query = "status=" + encodeURIComponent($(status).value);
  new Ajax.Request(
    '/statuses/update',
    { method: 'get',
      parameters: query,
      onComplete: function(req) {
        $(status).value = '';
        get_timeline();
        $('spinner').innerHTML = "";
      }
    }
  );
}

function get_timeline () {
  new Ajax.Request(
    timeline_url,
    { method: 'get',
      parameters: {},
      onComplete: function(req) {
        var messages = eval( req.responseText );
        var html = '<ul>';

        var len = messages.length;
        for (var i = 0;i < len;i++) {
          var message = messages[i];
          var screen_name = sanitize(message.user.screen_name);
          var text = sanitize(message.text);
          html += '<li><a href="/' + screen_name + '">' + screen_name + '</a></span> ' +
            text + ' <span class="date">' + message.created_at + '</span></li>';
        }
        html += '</ul>';
        $('updates').innerHTML = html;
        setTimeout(function(){ get_timeline(); }, 60000);
      }
    }
  );
}

/* THANKS TO http://blog.yappo.jp/cgi-bin/mt-comments.cgi?entry_id=507 and JPCERT */
function sanitize (html) {
  return html.replace(/&/g, '&amp;').replace(/</g, '&lt;').replace(/>/g, '&gt;').replace(/"/g, '&quot;');
}

window.onload = get_timeline;
</script>
</head>
<body>
[<a href="/">home</a>] [<a href="/[% user | uri %]">[% user | html %]</a>]
<h1>[% title %]</h1>
<form>Status: <input type="text" size="80" id="status" /><input type="submit" value="update" onclick="update('status');return false;" /><span id="spinner"></span><br /></form>

<h2>updates</h2>
<div id="updates"></div>
</body></html>
TEMPLATE
}

sub show_spinner {
    my $res = shift;
    $res->header('image/gif');
    $res->content(decode_base64(<<IMAGE));
R0lGODlhEAAQAAAAACH/C05FVFNDQVBFMi4wAwH//wAh+QQLBgAPACwAAAAAEAAQAIMvLy92dnaU
lJSlpaWtra21tbW9vb3GxsbOzs7W1tbe3t7n5+fv7+/39/f///////8EifDJ52QJdeq3QnoC4DSF
snFAAAIPMizaAheAEbrI0yyOEwSGRkCAKAwIO2PjoQikGktK4zAowCauzCTxkRgGYNNmajBQBWix
hlEoEAyTBUIrUVwlUwFy8z0wKEYIUwkNDApBCUdLdhwDCUULjg8MCVokBQ4HBA9UfxsLBDCaIwRd
GiMSCAYVDVoRACH5BAsGAA8ALAAAAAAQABAAgz09PXNzc4uLi6Wlpa2trbW1tb29vcbGxs7OztbW
1t7e3ufn5+/v7/f39////////wSL8Mnn5Ah16reCegHgNICxPUwQgMAjAIe2MM8BhwmwNovjCAJE
IzBAGAYAxqIwaHAugobz0WAwCwtNwpCZJBITYwF7ahwMhjOBQN5YCwSThKHoShTZSQMxIEwnRwc0
DkxCBwlVCgYNCX1OeE8JCFgDYAwJXQ1jDgcENQM0GwsEWZ0jBGAbIxJGFQ1dEQAh+QQLBgAPACwA
AAAAEAAQAIM5OTl/f3+UlJSlpaWtra21tbW9vb3GxsbOzs7W1tbe3t7n5+fv7+/39/f///////8E
i/DJ5yQRdeq3xHpB4DCBsT3k8AjBChzawjxIkLAJ0DaK4xSDRENgUCAIAEYuiTIMCo2GxNEIAACF
DAehlQQEE4TBcJhtOuODgUAofDaMQoFgkjB6G8Vb0kAMCFIaTmUUQAgNB0J3Bg0Jf1J6HEEIbkEo
CVoNcg4HBA8HA2YxBB+dVAQJJ1QSYhUNWhEAIfkECwYADwAsAAAAABAAEACDOjo6fX19mJiYpaWl
ra2ttbW1vb29xsbGzs7O1tbW3t7e5+fn7+/v9/f3////////BI3wyeekGXXqx8p6Q+A0AbI9DVGA
AQiY08I8ypAQggIIqOI4hYGiYTgsEoYA4wAANDiXQiMzCjQNmccCkZUIBhOEoTjbLAICAcFAUH02
uiZgwvBt1poGYkB4ai4HM0ADCA0HCQ11Bg0JfE8KHws2CB42HAlZDQUFDgcEDwcDZRoLBB+eIwQJ
JyMSYhVTExEAIfkECwYADwAsAAAAABAAEACDQUFBb29vi4uLpaWlra2ttbW1vb29xsbGzs7O1tbW
3t7e5+fn7+/v9/f3////////BIvwyeckMnXqxwp7B+E0Q7I9DWGAw1MEirZ8yqAcwxIUqOI4BVvD
gGAoEAIGIhBocAyDQiMzEgACiMxjkd0QeBaD4fDZLARMgYHwXZwUAcB1YtRKCgdNAzEgOCcOcgMf
QAMIDQcJDQwJAWdyTgpuCyUIBZQrCQNaDQUFDiEsZTIEbiEjBCYbI2EVUxMRACH5BAsGAA8ALAAA
AAAQABAAgzw8PH9/f5iYmKWlpa2trbW1tb29vcbGxs7OztbW1t7e3ufn5+/v7/f39////////wSM
8MnnJDJ16scKewfhNIWyPQ1hgMSDDIu2fMqghMyAoIvjFLaGAcFYKAiMhCDQ4BgGhUZmRAgIEjJE
ZnI4TC6Gw2fDWFoNBEIhtlkE3oEJQ7GVFLyTxovQnDgCAAEmPzoNBwkNCwQACwMAAE0KMY0JCAIF
AAUPCQVbJJ0hD49sMgQxIQ4LmScjFhgcWxEAIfkECwYADwAsAAAAABAAEACDQEBAa2tri4uLpaWl
ra2ttbW1vb29xsbGzs7O1tbW3t7e5+fn7+/v9/f3////////BIzwyeckMnXqxwp7B+E0hbI9DWGA
xIMMi7Z8yqCEzICgi+MUtoYBwVgoCI0FsMExDAqNzOgwIJgmC0RmcthZDIbDZ8MgDJ4GAqEQIw8E
gsGEodhKuprGC6lxCAACMT86DVQKCQUBSgEBTAoxC1WMBwByN1skBQ4BAA+cCScLBDEAAA4LACsb
IxKMFVETEQAh+QQLBgAPACwAAAAAEAAQAIM1NTVnZ2eBgYGlpaWtra21tbW9vb3GxsbOzs7W1tbe
3t7n5+fv7+/39/f///////8EjfDJ5yQyderHCnsH4TSFsj0NYYDEgwyLtnzKoITMgKCL4xS2hgHB
WCgIjQWwwTEMCo3M6PCMTRaIzCSRmFwMh8+mcTCADQRCwaphpFUTRkJr6U4arwBz4hgIBh8/TwoB
MDcCDAcCAkwKMQYABQIBCAEtWFoMAAIOAQAPkyYbBwAmng4MAQcnIxKTFVETEQAh+QQLBgAPACwA
AAAAEAAQAIMlJSVkZGSQkJClpaWtra21tbW9vb3GxsbOzs7W1tbe3t7n5+fv7+/39/f///////8E
i/DJ5yQyderHCnsH4TSFsj0NYYDEgwyLtnzKoITMgKCL4xS2hgHBWCgIjQWwwTEMCo3M6PCMTRaI
zCSRmFwMh8+mcTCADQTCoLvpFFTegVaisEoYAQCAqXGGKXoCCwGCCwkCDAkDSA8lIAAEAgEJAQcc
CVp4AQ6SD5F2WwArkg4MAjsbIxIDAhVRExEAIfkECwYADwAsAAAAABAAEACDPj4+b29vkJCQpaWl
ra2ttbW1vb29xsbGzs7O1tbW3t7e5+fn7+/v9/f3////////BIrwyeckMnXqxwp7B+E0hbI9DWGA
xIMMi7Z8yqCEzICgi+MUtoYBwVgoCI0FsMExDAqNzOjwjE0OgswkkZgEAIDAbtM4GAzYgPpw6hRU
24JWorBKGAIwU+M8fBxfAgsCBAwMCQYNCQNIIGwJAG8CNV2HWg1qDgMCD04fGwtiD5sODARdGyMS
ThVRExEAIfkECwYADwAsAAAAABAAEACDPz8/c3NzkJCQpaWlra2ttbW1vb29xsbGzs7O1tbW3t7e
5+fn7+/v9/f3////////BIfwyeckMnXqxwp7B+E0hbI9DWGAxIMMi3aYrxIyA4IujhMAA0bgwFgo
CI1FYdB4LAQAAKNJaRwGhdjkIMhMEomJIEAOb6wGw+EXPZw6BdVEgdkotJLGABCgTgwDRBQ/QSoM
DHQNCQNILjoKQwZZA2EMCV4NAl0GLVcfG09hnCMEZhojFnUNXhEAIfkECwYADwAsAAAAABAAEACD
Li4ub29vjY2NpaWlra2ttbW1vb29xsbGzs7O1tbW3t7e5+fn7+/v9/f3////////BI3wyeckMnXq
pwB6B+E0hbI9DACAxIMMi5aYB0DczPA1i+MEtkYgkFgoCLzCoPFIAAMNJqVxGBRik4MgM0kkJgOB
2LShGgzaIfHEKBQIhskCwZUosJKGQSydGAYHDBQDAQUMBwkNDAoGDQkDSC5fCwMJCFeVKAlcJAUO
ISADghsLBDEhIwRfGyMWGA8NXBEAOw==
IMAGE
}


__END__

=head1 NAME

twitterd.pl - Twitter clone server

=head1 SYNOPSIS

  Usage: twitterd.pl -pass=htpasswd -dump=dumpfile

  Options:
    -pass=htpasswd      user accounts file (genereted by htpasswd command)
    -dump=status.dump   status data save file
    -port=number        server port (default 8888)
    -logline=line       save logsize (default 50 lines)
    --quiet             daemon mode

  Setup:
    $ htpasswd -c twitterdusers.pwd username userpassword
    $ touch twitterdstatus.dump
    $ perl ./twitterd.pl -pass=twitterdusers.pwd -dump=twitterdstatus.dump

  Supported APIs:
    /statuses/public_timeline.json
    /statuses/friends_timeline.json
    /statuses/user_timeline.json
    /statuses/user_timeline/user.json
    /statuses/update

=head1 AUTHOR

Kazuhiro Osawa E<lt>ko@yappo.ne.jpE<gt>

=head1 SEE ALSO

L<POE>, L<Apache::Htpasswd>

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut