Working version with push support
This commit is contained in:
Difrex(Denis Zheleztsov)
parent
1a90e47bbd
commit
15e6994d74
36
II/Config.pm
Normal file
36
II/Config.pm
Normal file
@ -0,0 +1,36 @@
|
||||
package II::Config;
|
||||
|
||||
use Config::Tiny;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
|
||||
my $c = Config::Tiny->new();
|
||||
$c = Config::Tiny->read('config.ini');
|
||||
|
||||
my $self = { _config => $c, };
|
||||
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub load {
|
||||
my ($self) = @_;
|
||||
my $config = $self->{_config};
|
||||
|
||||
my $key = $config->{auth}->{key};
|
||||
my $nick = $config->{auth}->{nick};
|
||||
my $host = $config->{node}->{host};
|
||||
my @echoareas = split /,/, $config->{node}->{echoareas};
|
||||
|
||||
$c = {
|
||||
nick => $nick,
|
||||
key => $key,
|
||||
host => $host,
|
||||
echoareas => [@echoareas],
|
||||
};
|
||||
|
||||
return $c;
|
||||
}
|
||||
|
||||
1;
|
||||
258
II/DB.pm
Normal file
258
II/DB.pm
Normal file
@ -0,0 +1,258 @@
|
||||
package II::DB;
|
||||
|
||||
use SQL::Abstract;
|
||||
use DBI;
|
||||
|
||||
use Data::Dumper;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
|
||||
my $dbh = DBI->connect( "dbi:SQLite:dbname=ii.sql", "", "" );
|
||||
my $sql = SQL::Abstract->new();
|
||||
|
||||
my $self = {
|
||||
_dbh => $dbh,
|
||||
_sql => $sql,
|
||||
};
|
||||
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub write_out {
|
||||
my ( $self, %data ) = @_;
|
||||
my $dbh = $self->{_dbh};
|
||||
my $sql = $self->{_sql};
|
||||
|
||||
my ( $stmt, @bind ) = $sql->insert( 'output', \%data );
|
||||
|
||||
my $sth = $dbh->prepare($stmt);
|
||||
$sth->execute(@bind);
|
||||
|
||||
print "Message writed to DB!\n";
|
||||
}
|
||||
|
||||
sub update_out {
|
||||
my ($self, $hash) = @_;
|
||||
my $dbh = $self->{_dbh};
|
||||
|
||||
my $q = "update output set send=1 where hash='$hash'";
|
||||
my $sth = $dbh->prepare($q);
|
||||
$sth->execute();
|
||||
}
|
||||
|
||||
sub write {
|
||||
my ( $self, %data ) = @_;
|
||||
my $dbh = $self->{_dbh};
|
||||
my $sql = $self->{_sql};
|
||||
|
||||
my ( $stmt, @bind ) = $sql->insert( 'messages', \%data );
|
||||
|
||||
my $sth = $dbh->prepare($stmt);
|
||||
$sth->execute(@bind);
|
||||
|
||||
print "Message writed to DB!\n";
|
||||
}
|
||||
|
||||
sub select_out {
|
||||
my ($self) = @_;
|
||||
my $dbh = $self->{_dbh};
|
||||
|
||||
my $q
|
||||
= "select from_user, to_user, subg, time, echo, post, hash, base64 from output where send=0";
|
||||
|
||||
my $sth = $dbh->prepare($q);
|
||||
$sth->execute();
|
||||
|
||||
my @posts;
|
||||
while ( my @hash = $sth->fetchrow_array() ) {
|
||||
my ( $from, $to, $subg, $time, $echo, $post, $h, $base64 ) = @hash;
|
||||
my $data = {
|
||||
from => "$from",
|
||||
to => "$to",
|
||||
subg => "$subg",
|
||||
time => $time,
|
||||
echo => "$echo",
|
||||
post => "$post",
|
||||
hash => $h,
|
||||
base64 => $base64,
|
||||
};
|
||||
push( @posts, $data );
|
||||
}
|
||||
|
||||
return @posts;
|
||||
}
|
||||
|
||||
sub select_index {
|
||||
my ( $self, $limit ) = @_;
|
||||
my $dbh = $self->{_dbh};
|
||||
|
||||
my $q = "select hash from messages order by time desc limit $limit";
|
||||
|
||||
my $sth = $dbh->prepare($q);
|
||||
$sth->execute();
|
||||
|
||||
my @hashes;
|
||||
while ( my @hash = $sth->fetchrow_array() ) {
|
||||
my ($h) = @hash;
|
||||
push( @hashes, $h );
|
||||
}
|
||||
|
||||
return @hashes;
|
||||
}
|
||||
|
||||
sub select_subg {
|
||||
my ( $self, $echo ) = @_;
|
||||
|
||||
}
|
||||
|
||||
sub from_me {
|
||||
my ( $self, $config ) = @_;
|
||||
my $dbh = $self->{_dbh};
|
||||
my $nick = $config->{nick};
|
||||
|
||||
# print Dumper($config);
|
||||
# print "NICK: $nick\n";
|
||||
|
||||
my $q
|
||||
= "select from_user, to_user, subg, time, echo, post, hash from messages where from_user='$nick'";
|
||||
|
||||
my $sth = $dbh->prepare($q);
|
||||
$sth->execute();
|
||||
|
||||
my @posts;
|
||||
while ( my @hash = $sth->fetchrow_array() ) {
|
||||
my ( $from, $to, $subg, $time, $echo, $post, $h ) = @hash;
|
||||
my $data = {
|
||||
from => "$from",
|
||||
to => "$to",
|
||||
subg => "$subg",
|
||||
time => $time,
|
||||
echo => "$echo",
|
||||
post => "$post",
|
||||
hash => $h,
|
||||
};
|
||||
push( @posts, $data );
|
||||
}
|
||||
|
||||
return @posts;
|
||||
}
|
||||
|
||||
sub thread {
|
||||
my ( $self, $subg, $echo ) = @_;
|
||||
my $dbh = $self->{_dbh};
|
||||
|
||||
my $q
|
||||
= "select from_user, to_user, subg, time, echo, post, hash from messages where echo='$echo' and subg like '%$subg%' order by time";
|
||||
|
||||
my $sth = $dbh->prepare($q);
|
||||
$sth->execute();
|
||||
|
||||
my @posts;
|
||||
while ( my @hash = $sth->fetchrow_array() ) {
|
||||
my ( $from, $to, $subg, $time, $echo, $post, $h ) = @hash;
|
||||
my $data = {
|
||||
from => "$from",
|
||||
to => "$to",
|
||||
subg => "$subg",
|
||||
time => $time,
|
||||
echo => "$echo",
|
||||
post => "$post",
|
||||
hash => $h,
|
||||
};
|
||||
push( @posts, $data );
|
||||
}
|
||||
|
||||
return @posts;
|
||||
}
|
||||
|
||||
sub echoes {
|
||||
my ( $self, $echo ) = @_;
|
||||
my $dbh = $self->{_dbh};
|
||||
|
||||
my $q
|
||||
= "select from_user, to_user, subg, time, echo, post, hash from messages where echo='$echo' order by time desc";
|
||||
|
||||
my $sth = $dbh->prepare($q);
|
||||
$sth->execute();
|
||||
|
||||
my @posts;
|
||||
while ( my @hash = $sth->fetchrow_array() ) {
|
||||
my ( $from, $to, $subg, $time, $echo, $post, $h ) = @hash;
|
||||
my $data = {
|
||||
from => "$from",
|
||||
to => "$to",
|
||||
subg => "$subg",
|
||||
time => $time,
|
||||
echo => "$echo",
|
||||
post => "$post",
|
||||
h => $h,
|
||||
};
|
||||
push( @posts, $data );
|
||||
}
|
||||
|
||||
return @posts;
|
||||
}
|
||||
|
||||
sub to_me {
|
||||
my ( $self, $config ) = @_;
|
||||
my $dbh = $self->{_dbh};
|
||||
my $nick = $config->{nick};
|
||||
|
||||
# print Dumper($config);
|
||||
# print "NICK: $nick\n";
|
||||
|
||||
my $q
|
||||
= "select from_user, to_user, subg, time, echo, post, hash from messages where to_user='$nick'";
|
||||
|
||||
my $sth = $dbh->prepare($q);
|
||||
$sth->execute();
|
||||
|
||||
my @posts;
|
||||
while ( my @hash = $sth->fetchrow_array() ) {
|
||||
my ( $from, $to, $subg, $time, $echo, $post, $h ) = @hash;
|
||||
my $data = {
|
||||
from => "$from",
|
||||
to => "$to",
|
||||
subg => "$subg",
|
||||
time => $time,
|
||||
echo => "$echo",
|
||||
post => "$post",
|
||||
hash => "$h",
|
||||
};
|
||||
push( @posts, $data );
|
||||
}
|
||||
|
||||
return @posts;
|
||||
}
|
||||
|
||||
sub select_new {
|
||||
my ( $self, $msg ) = @_;
|
||||
my $dbh = $self->{_dbh};
|
||||
|
||||
my $q
|
||||
= "select from_user, to_user, subg, time, echo, post, hash from messages where hash='$msg'";
|
||||
|
||||
my $sth = $dbh->prepare($q);
|
||||
$sth->execute();
|
||||
my ( $from, $to, $subg, $time, $echo, $post );
|
||||
|
||||
while ( my @hash = $sth->fetchrow_array() ) {
|
||||
( $from, $to, $subg, $time, $echo, $post, $h ) = @hash;
|
||||
}
|
||||
|
||||
my $data = {
|
||||
from => "$from",
|
||||
to => "$to",
|
||||
subg => "$subg",
|
||||
time => $time,
|
||||
echo => "$echo",
|
||||
post => "$post",
|
||||
hash => "$h",
|
||||
};
|
||||
|
||||
return $data;
|
||||
}
|
||||
|
||||
1;
|
||||
65
II/Enc.pm
Normal file
65
II/Enc.pm
Normal file
@ -0,0 +1,65 @@
|
||||
package II::Enc;
|
||||
|
||||
use II::DB;
|
||||
use MIME::Base64;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
|
||||
my $db = II::DB->new();
|
||||
|
||||
my $self = {
|
||||
_config => shift,
|
||||
_data => shift,
|
||||
_db => $db,
|
||||
};
|
||||
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub encode {
|
||||
my ($self) = @_;
|
||||
my $config = $self->{_config};
|
||||
my $data = $self->{_data};
|
||||
my $db = $self->{_db};
|
||||
my $hash = II::Enc->new_hash();
|
||||
|
||||
# Make base64 message
|
||||
my $message = $data->{echo}."\n";
|
||||
$message .= $data->{to}."\n";
|
||||
$message .= $data->{subg}."\n\n";
|
||||
$message .= '@repto:'.$data->{hash}."\n" if defined($data->{hash});
|
||||
$message .= $data->{post};
|
||||
|
||||
my $encoded = `echo "$message" | base64`;
|
||||
$encoded =~ s/\//_/g;
|
||||
$encoded =~ s/\+/-/g;
|
||||
|
||||
# Make data
|
||||
my %out = (
|
||||
hash => $hash,
|
||||
time => $data->{time},
|
||||
echo => $data->{echo},
|
||||
from_user => $data->{from},
|
||||
to_user => $data->{to},
|
||||
subg => $data->{subg},
|
||||
post => $data->{post},
|
||||
base64 => $encoded,
|
||||
send => 0,
|
||||
);
|
||||
|
||||
$db->write_out(%out);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub new_hash {
|
||||
my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9 );
|
||||
my $string;
|
||||
$string .= $chars[ rand @chars ] for 1 .. 21;
|
||||
|
||||
return $string;
|
||||
}
|
||||
|
||||
1;
|
||||
108
II/Get.pm
Normal file
108
II/Get.pm
Normal file
@ -0,0 +1,108 @@
|
||||
package II::Get;
|
||||
use LWP::Simple;
|
||||
|
||||
use II::DB;
|
||||
|
||||
use Data::Dumper;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
|
||||
my $self = { _config => shift, };
|
||||
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub get_echo {
|
||||
my ($self) = @_;
|
||||
my $config = $self->{_config};
|
||||
my $echoareas = $config->{echoareas};
|
||||
my $host = $config->{host};
|
||||
|
||||
my $db = II::DB->new();
|
||||
|
||||
my $echo_url = 'e/';
|
||||
my $msg_url = 'm/';
|
||||
|
||||
my $msgs;
|
||||
foreach my $echo (@$echoareas) {
|
||||
# my @content = get( "$host" . "$echo_url" . "$echo" );
|
||||
my @content = `curl $host$echo_url$echo`;
|
||||
|
||||
# if ( is_success( getprint( "$host" . "$echo_url" . "$echo" ) ) ) {
|
||||
|
||||
# Write echoes file
|
||||
open my $echo_fh, ">", "./echo/$echo"
|
||||
or die "Cannot open file: $!\n";
|
||||
print $echo_fh @content;
|
||||
close $echo_fh;
|
||||
|
||||
# Get messages
|
||||
open my $echo_fh, "<", "./echo/$echo"
|
||||
or die "Cannot open file: $!\n";
|
||||
while (<$echo_fh>) {
|
||||
chomp($_);
|
||||
if ( !( -e "./msg/$_" ) ) {
|
||||
$msgs .= $_ . "\n";
|
||||
# @w_cmd = ( 'wget', '-O',
|
||||
# "./msg/$_", "$host" . "$msg_url" . "$_" );
|
||||
`curl $host$msg_url$_ > ./msg/$_`;
|
||||
# system(@w_cmd) == 0 or die "Cannot download file: $!\n";
|
||||
}
|
||||
}
|
||||
close $echo_fh;
|
||||
|
||||
# }
|
||||
}
|
||||
|
||||
my $new_messages
|
||||
= "<!DOCTYPE html><meta charset=utf8><body><h1>Новые сообщения</h1>\n";
|
||||
if ( defined($msgs) ) {
|
||||
my @msg_list = split /\n/, $msgs;
|
||||
while (<@msg_list>) {
|
||||
my $mes_hash = $_;
|
||||
open my $m, "<", "./msg/$mes_hash"
|
||||
or die "Cannot open message: $!\n";
|
||||
|
||||
my @mes;
|
||||
while (<$m>) {
|
||||
push( @mes, $_ );
|
||||
}
|
||||
close $m;
|
||||
|
||||
my $count = 7;
|
||||
my $post;
|
||||
while ( $count < @mes ) {
|
||||
$post .= $mes[$count];
|
||||
$count++;
|
||||
}
|
||||
|
||||
chomp( $mes[2] );
|
||||
chomp( $mes[1] );
|
||||
chomp( $mes[3] );
|
||||
chomp( $mes[5] );
|
||||
chomp( $mes[6] );
|
||||
|
||||
# Make data
|
||||
my %data = (
|
||||
hash => $mes_hash,
|
||||
time => $mes[2],
|
||||
echo => $mes[1],
|
||||
from_user => $mes[3],
|
||||
to_user => $mes[5],
|
||||
subg => $mes[6],
|
||||
post => "$post",
|
||||
read => 0,
|
||||
);
|
||||
|
||||
# Write message to DB
|
||||
$db->write(%data);
|
||||
|
||||
# $new_messages .= "$post</p>";
|
||||
}
|
||||
}
|
||||
return $msgs;
|
||||
}
|
||||
|
||||
1;
|
||||
204
II/Render.pm
Normal file
204
II/Render.pm
Normal file
@ -0,0 +1,204 @@
|
||||
package II::Render;
|
||||
|
||||
use II::DB;
|
||||
use II::T;
|
||||
|
||||
use Data::Dumper;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
|
||||
my $db = II::DB->new();
|
||||
my $t = II::T->new();
|
||||
|
||||
my $self = {
|
||||
_db => $db,
|
||||
_template => $t,
|
||||
};
|
||||
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub thread {
|
||||
my ( $self, $subg, $echo ) = @_;
|
||||
my $db = $self->{_db};
|
||||
my $t = $self->{_template};
|
||||
|
||||
my @post = $db->thread( $subg, $echo );
|
||||
|
||||
# Render header
|
||||
my $render = $t->head("ii :: $echo");
|
||||
my $count = 0;
|
||||
while ( $count < @post ) {
|
||||
$render .= $t->post( @post[$count] );
|
||||
$count++;
|
||||
}
|
||||
$render .= $t->foot();
|
||||
|
||||
return $render;
|
||||
|
||||
}
|
||||
|
||||
sub out {
|
||||
my ($self) = @_;
|
||||
my $db = $self->{_db};
|
||||
my $t = $self->{_template};
|
||||
|
||||
my @post = $db->select_out();
|
||||
|
||||
# Render header
|
||||
my $render
|
||||
= $t->head('ii :: неотправленные сообщения');
|
||||
|
||||
my $count = 0;
|
||||
while ( $count < @post ) {
|
||||
|
||||
# Render post
|
||||
$render .= $t->out( @post[$count] );
|
||||
|
||||
$count++;
|
||||
}
|
||||
$render .= $t->foot();
|
||||
}
|
||||
|
||||
sub echo_mes {
|
||||
my ( $self, $echo ) = @_;
|
||||
my $db = $self->{_db};
|
||||
my $t = $self->{_template};
|
||||
|
||||
my @post = $db->echoes($echo);
|
||||
|
||||
# Render header
|
||||
my $render = $t->head("ii :: $echo");
|
||||
$render .= "<a href=/new?echo=$echo>Новое сообщение</a>";
|
||||
|
||||
my $count = 0;
|
||||
while ( $count < @post ) {
|
||||
|
||||
# Render post
|
||||
if ( !( @post[$count]->{subg} =~ /Re.+/ ) ) {
|
||||
$render .= $t->tree( @post[$count] );
|
||||
}
|
||||
|
||||
$count++;
|
||||
}
|
||||
$render .= $t->foot();
|
||||
|
||||
return $render;
|
||||
|
||||
}
|
||||
|
||||
sub to_me {
|
||||
my ( $self, $config ) = @_;
|
||||
my $db = $self->{_db};
|
||||
my $t = $self->{_template};
|
||||
|
||||
my @post = $db->to_me($config);
|
||||
my @post_from_me = $db->from_me($config);
|
||||
|
||||
# Render header
|
||||
my $render = $t->head('ii :: Моя переписка');
|
||||
|
||||
my $count = 0;
|
||||
while ( $count < @post ) {
|
||||
|
||||
# Render post
|
||||
$render .= $t->post( @post[$count] );
|
||||
|
||||
$count++;
|
||||
}
|
||||
$render .= $t->foot();
|
||||
|
||||
return $render;
|
||||
}
|
||||
|
||||
sub tree {
|
||||
my ( $self, $config ) = @_;
|
||||
my $db = $self->{_db};
|
||||
}
|
||||
|
||||
# Render index page
|
||||
sub index {
|
||||
my ( $self, $config ) = @_;
|
||||
my $db = $self->{_db};
|
||||
my $echoareas = $config->{echoareas};
|
||||
my $t = $self->{_template};
|
||||
|
||||
my @hashes = $db->select_index(50);
|
||||
|
||||
# Render header
|
||||
my $render = $t->head('ii :: Лента');
|
||||
$render .= $t->index($echoareas);
|
||||
|
||||
while (<@hashes>) {
|
||||
my $message = $_;
|
||||
my $data = $db->select_new($message);
|
||||
|
||||
# Render post
|
||||
$render .= $t->post($data);
|
||||
}
|
||||
$render .= $t->foot();
|
||||
|
||||
return $render;
|
||||
}
|
||||
|
||||
# Render new message form
|
||||
sub send_new {
|
||||
my ( $self, $echo ) = @_;
|
||||
my $t = $self->{_template};
|
||||
|
||||
my $render = $t->head("ii :: Новое сообщение");
|
||||
|
||||
$render .= $t->new_mes($echo);
|
||||
$render .= $t->foot();
|
||||
|
||||
return $render;
|
||||
}
|
||||
|
||||
# Render send form
|
||||
sub send {
|
||||
my ( $self, $hash ) = @_;
|
||||
my $db = $self->{_db};
|
||||
my $t = $self->{_template};
|
||||
|
||||
my $render = $t->head("ii :: Ответ на $hash");
|
||||
|
||||
# Render post
|
||||
my $data = $db->select_new($hash);
|
||||
|
||||
$render .= $t->send($data);
|
||||
$render .= $t->foot();
|
||||
|
||||
return $render;
|
||||
}
|
||||
|
||||
# Render new messages
|
||||
sub new_mes {
|
||||
my ( $self, $msgs ) = @_;
|
||||
my $db = $self->{_db};
|
||||
my $t = $self->{_template};
|
||||
|
||||
my $render = $t->head('ii :: Новые сообщения');
|
||||
|
||||
# Render posts
|
||||
if ( defined($msgs) ) {
|
||||
my @msgs_list = split /\n/, $msgs;
|
||||
while (<@msgs_list>) {
|
||||
my $message = $_;
|
||||
my $data = $db->select_new($message);
|
||||
|
||||
# Render post
|
||||
$render .= $t->post($data);
|
||||
}
|
||||
}
|
||||
|
||||
# else {
|
||||
# $render .= "<p>Новых сообщений нет</p>";
|
||||
# }
|
||||
$render .= $t->foot();
|
||||
|
||||
return $render;
|
||||
}
|
||||
|
||||
1;
|
||||
41
II/Send.pm
Normal file
41
II/Send.pm
Normal file
@ -0,0 +1,41 @@
|
||||
package II::Send;
|
||||
|
||||
use HTTP::Request::Common qw(POST);
|
||||
use LWP::UserAgent;
|
||||
use II::DB;
|
||||
use Data::Dumper;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
|
||||
my $self = {
|
||||
_config => shift,
|
||||
_echo => shift,
|
||||
_base64 => shift,
|
||||
};
|
||||
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub send {
|
||||
my ($self, $hash) = @_;
|
||||
my $config = $self->{_config};
|
||||
my $echo = $self->{_echo};
|
||||
my $base64 = $self->{_base64};
|
||||
|
||||
# Push message to server
|
||||
my $host = $config->{host};
|
||||
my $auth = $config->{key};
|
||||
$host .= "u/point";
|
||||
my $ua = LWP::UserAgent->new();
|
||||
my $response = $ua->post( $host, { 'pauth' => $auth, 'tmsg' => $base64 } );
|
||||
print Dumper($response);
|
||||
|
||||
my $db = II::DB->new();
|
||||
if ($response->{_rc} == 200) {
|
||||
$db->update_out($hash);
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
169
II/T.pm
Normal file
169
II/T.pm
Normal file
@ -0,0 +1,169 @@
|
||||
package II::T;
|
||||
|
||||
use HTML::Template;
|
||||
use Data::Dumper;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $self = {};
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub head {
|
||||
my ( $self, $title ) = @_;
|
||||
my $t = HTML::Template->new( filename => 't/head.html' );
|
||||
|
||||
$t->param( TITLE => $title );
|
||||
|
||||
return $t->output;
|
||||
}
|
||||
|
||||
sub index {
|
||||
my ( $self, $echoareas ) = @_;
|
||||
my $i = HTML::Template->new( filename => 't/index.html' );
|
||||
|
||||
my $index = '<div class="echo">';
|
||||
while (<@$echoareas>) {
|
||||
$i->param( ECHO => $_ );
|
||||
$index .= $i->output();
|
||||
}
|
||||
$index .= '</div>';
|
||||
|
||||
return $index;
|
||||
}
|
||||
|
||||
sub tree {
|
||||
my ( $self, $data ) = @_;
|
||||
|
||||
my $p = HTML::Template->new( filename => 't/tree.html' );
|
||||
|
||||
my $time = localtime( $data->{time} );
|
||||
|
||||
# my $post = II::T->pre( $data->{post} );
|
||||
my $link = $data->{subg};
|
||||
$link =~ s/\s/%20/g;
|
||||
|
||||
$p->param( SUBG => "$data->{subg}" );
|
||||
$p->param( LINK => $link );
|
||||
$p->param( TIME => "$time" );
|
||||
$p->param( FROM => $data->{from} );
|
||||
|
||||
# $p->param( TO => $data->{to} );
|
||||
# $p->param( POST => $post );
|
||||
$p->param( ECHO => $data->{echo} );
|
||||
|
||||
return $p->output();
|
||||
}
|
||||
|
||||
sub out {
|
||||
my ( $self, $data ) = @_;
|
||||
|
||||
my $p = HTML::Template->new( filename => 't/out.html' );
|
||||
|
||||
my $post = II::T->pre( $data->{post} );
|
||||
|
||||
$p->param( SUBG => $data->{subg} );
|
||||
$p->param( TIME => "$time" );
|
||||
$p->param( FROM => $data->{from} );
|
||||
$p->param( TO => $data->{to} );
|
||||
$p->param( POST => $post );
|
||||
$p->param( ECHO => $data->{echo} );
|
||||
$p->param( BASE64 => $data->{base64} );
|
||||
$p->param( HASH => $data->{hash} );
|
||||
|
||||
return $p->output();
|
||||
}
|
||||
|
||||
sub post {
|
||||
my ( $self, $data ) = @_;
|
||||
|
||||
my $p = HTML::Template->new( filename => 't/post.html' );
|
||||
|
||||
my $time = localtime( $data->{time} );
|
||||
|
||||
my $post = II::T->pre( $data->{post} );
|
||||
|
||||
$p->param( SUBG => $data->{subg} );
|
||||
$p->param( TIME => "$time" );
|
||||
$p->param( FROM => $data->{from} );
|
||||
$p->param( TO => $data->{to} );
|
||||
$p->param( POST => $post );
|
||||
$p->param( ECHO => $data->{echo} );
|
||||
$p->param( HASH => $data->{hash} );
|
||||
|
||||
return $p->output();
|
||||
}
|
||||
|
||||
sub new_mes {
|
||||
my ($self, $echo) = @_;
|
||||
|
||||
my $n = HTML::Template->new(filename => 't/new.html');
|
||||
$n->param(ECHO => $echo);
|
||||
|
||||
return $n->output();
|
||||
}
|
||||
|
||||
sub send {
|
||||
my ( $self, $data ) = @_;
|
||||
|
||||
my $p = HTML::Template->new( filename => 't/send.html' );
|
||||
|
||||
my $time = localtime( $data->{time} );
|
||||
|
||||
my $post = II::T->pre( $data->{post} );
|
||||
|
||||
$data->{subg} =~ s/Re:(.+)/$1/g;
|
||||
|
||||
$p->param( SUBG => $data->{subg} );
|
||||
$p->param( TIME => "$time" );
|
||||
$p->param( FROM => $data->{from} );
|
||||
$p->param( TO => $data->{to} );
|
||||
$p->param( POST => $post );
|
||||
$p->param( ECHO => $data->{echo} );
|
||||
$p->param( HASH => $data->{hash} );
|
||||
|
||||
return $p->output();
|
||||
}
|
||||
|
||||
sub pre {
|
||||
my ( $self, $post ) = @_;
|
||||
|
||||
$post =~ s/</</g;
|
||||
$post =~ s/>/>/g;
|
||||
$post =~ s/>(.+)/<font color='green'>>$1<\/font><br>/g;
|
||||
$post =~ s/^$/<br>\n/g;
|
||||
$post =~ s/(.?)\n/$1<br>\n/g;
|
||||
$post
|
||||
=~ s/(https?:\/\/.+\.(jpg|png|gif))/<a href="$1"><img src="$1" width="15%" height="15%" \/><\/a>/g;
|
||||
|
||||
# Not are regexp parsing
|
||||
my $pre = 0;
|
||||
my $txt;
|
||||
open my $fh, '<', \$post or die $!;
|
||||
while (<$fh>) {
|
||||
my $line = $_;
|
||||
if ( ( $line =~ /^====/ ) and ( $pre == 0 ) ) {
|
||||
$txt .= $_;
|
||||
$line =~ s/====/<pre>/g;
|
||||
$pre = 1;
|
||||
}
|
||||
elsif ( ( $line =~ /^====/ ) and ( $pre == 1 ) ) {
|
||||
$line =~ s/====/<\/pre>\n====/g;
|
||||
$pre = 0;
|
||||
}
|
||||
$txt .= $line;
|
||||
}
|
||||
close $fh;
|
||||
return $txt;
|
||||
}
|
||||
|
||||
sub foot {
|
||||
my ($self) = @_;
|
||||
|
||||
my $f = HTML::Template->new( filename => 't/foot.html' );
|
||||
|
||||
return $f->output();
|
||||
}
|
||||
|
||||
1;
|
||||
7
config.ini
Normal file
7
config.ini
Normal file
@ -0,0 +1,7 @@
|
||||
[auth]
|
||||
key = you_auth_key
|
||||
nick = you_nick
|
||||
|
||||
[node]
|
||||
host = http://your_ii_node.ii
|
||||
echoareas = im.100
|
||||
157
iiplc.app
Normal file
157
iiplc.app
Normal file
@ -0,0 +1,157 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Plack::Builder;
|
||||
use Plack::Request;
|
||||
use Plack::Response;
|
||||
|
||||
use II::Config;
|
||||
use II::Get;
|
||||
use II::Send;
|
||||
use II::Render;
|
||||
use II::DB;
|
||||
use II::Enc;
|
||||
|
||||
# Debug
|
||||
use Data::Dumper;
|
||||
|
||||
my $c = II::Config->new();
|
||||
my $config = $c->load();
|
||||
|
||||
my $GET = II::Get->new($config);
|
||||
my $render = II::Render->new();
|
||||
|
||||
my $echo = sub {
|
||||
my $env = shift;
|
||||
|
||||
my $req = Plack::Request->new($env);
|
||||
|
||||
my $query = $req->param('echo');
|
||||
|
||||
my $echo_messages = $render->echo_mes($query);
|
||||
|
||||
return [ 200, [ 'Content-type' => 'text/html' ], ["$echo_messages"], ];
|
||||
};
|
||||
|
||||
my $thread = sub {
|
||||
my $env = shift;
|
||||
|
||||
my $req = Plack::Request->new($env);
|
||||
|
||||
my $subg = $req->param('subg');
|
||||
my $echo = $req->param('echo');
|
||||
|
||||
my $thread = $render->thread( $subg, $echo );
|
||||
|
||||
return [ 200, [ 'Content-type' => 'text/html' ], ["$thread"], ];
|
||||
};
|
||||
|
||||
my $get = sub {
|
||||
my $msgs = $GET->get_echo();
|
||||
my $new_mes = $render->new_mes($msgs);
|
||||
return [ 200, [ 'Content-type' => 'text/html' ], ["$new_mes"], ];
|
||||
};
|
||||
|
||||
my $root = sub {
|
||||
my $index = $render->index($config);
|
||||
return [ 200, [ 'Content-type' => 'text/html' ], [$index], ];
|
||||
};
|
||||
|
||||
my $me = sub {
|
||||
my $messages = $render->to_me($config);
|
||||
return [ 200, [ 'Content-type' => 'text/html' ], [$messages], ];
|
||||
};
|
||||
|
||||
my $tree = sub {
|
||||
my $subges = $render->tree($config);
|
||||
return [ 200, [ 'Content-type' => 'text/html' ], ['Дерево'], ];
|
||||
};
|
||||
|
||||
my $new = sub {
|
||||
my $env = shift;
|
||||
|
||||
my $req = Plack::Request->new($env);
|
||||
my $echo = $req->param('echo');
|
||||
|
||||
my $send = $render->send_new($echo);
|
||||
return [ 200, [ 'Content-type' => 'text/html' ], [$send], ];
|
||||
};
|
||||
|
||||
my $send = sub {
|
||||
my $env = shift;
|
||||
|
||||
my $req = Plack::Request->new($env);
|
||||
my $hash = $req->param('hash');
|
||||
my $send = $render->send($hash);
|
||||
|
||||
return [ 200, [ 'Content-type' => 'text/html' ], [$send], ];
|
||||
};
|
||||
|
||||
my $enc = sub {
|
||||
my $env = shift;
|
||||
|
||||
my $req = Plack::Request->new($env);
|
||||
|
||||
# Get parameters
|
||||
my $echo = $req->param('echo');
|
||||
my $to = $req->param('to');
|
||||
my $post = $req->param('post');
|
||||
my $subg = $req->param('subg');
|
||||
my $hash = $req->param('hash');
|
||||
my $time = time();
|
||||
|
||||
print Dumper($config);
|
||||
my $data = {
|
||||
echo => $echo,
|
||||
to => $to,
|
||||
from => $config->{nick},
|
||||
subg => $subg,
|
||||
post => $post,
|
||||
time => $time,
|
||||
hash => $hash,
|
||||
};
|
||||
|
||||
my $enc = II::Enc->new( $config, $data );
|
||||
$enc->encode() == 0 or die "$!\n";
|
||||
|
||||
return [ 302, [ 'Location' => '/out' ], [], ];
|
||||
};
|
||||
|
||||
my $out = sub {
|
||||
my $out = $render->out();
|
||||
|
||||
return [ 200, [ 'Content-type' => 'text/html' ], [$out], ];
|
||||
};
|
||||
|
||||
# Push message to server
|
||||
my $push = sub {
|
||||
my $env = shift;
|
||||
|
||||
my $req = Plack::Request->new($env);
|
||||
|
||||
my $echo = $req->param('echo');
|
||||
my $base64 = $req->param('base64');
|
||||
my $hash = $req->param('hash');
|
||||
|
||||
my $s = II::Send->new( $config, $echo, $base64 );
|
||||
$s->send($hash);
|
||||
|
||||
my $db = II::DB->new();
|
||||
$db->update_out($hash);
|
||||
|
||||
return [ 302, [ 'Location' => "/e?echo=$echo" ], [], ];
|
||||
};
|
||||
|
||||
builder {
|
||||
mount '/' => $root;
|
||||
mount '/e' => $echo;
|
||||
mount '/s' => $thread;
|
||||
mount '/me' => $me;
|
||||
mount '/tree' => $tree;
|
||||
mount '/get/' => $get;
|
||||
mount '/send' => $send;
|
||||
mount '/enc' => $enc;
|
||||
mount '/out' => $out;
|
||||
mount '/push' => $push;
|
||||
mount '/new' => $new;
|
||||
};
|
||||
7
run.sh
Executable file
7
run.sh
Executable file
@ -0,0 +1,7 @@
|
||||
#!/bin/bash
|
||||
|
||||
# Debug server
|
||||
plackup iiplc.app
|
||||
|
||||
# Production
|
||||
# starman -l 127.0.0.1:5000 run.pl whatever
|
||||
2
t/foot.html
Normal file
2
t/foot.html
Normal file
@ -0,0 +1,2 @@
|
||||
</body>
|
||||
</html>
|
||||
112
t/head.html
Normal file
112
t/head.html
Normal file
@ -0,0 +1,112 @@
|
||||
<!DOCTYPE html>
|
||||
<html>
|
||||
<head>
|
||||
<title><TMPL_VAR NAME=TITLE></title>
|
||||
<meta charset='utf8'>
|
||||
</head>
|
||||
<STYLE type="text/css">
|
||||
.post {
|
||||
border-width: 1;
|
||||
border: solid;
|
||||
border-color: #C7BA6C;
|
||||
border-radius: 10px;
|
||||
margin-top: 0.5em;
|
||||
margin-left: 15%;
|
||||
margin-right: 10%;
|
||||
padding-left: 5pt;
|
||||
}
|
||||
.post h2 {
|
||||
display: block;
|
||||
/*position: relative;*/
|
||||
background-color: #C7BA6C;
|
||||
border-color: #999;
|
||||
border-radius: 5px;
|
||||
padding-left: 10px;
|
||||
margin-right: 10px;
|
||||
margin-top: 0.5em;
|
||||
margin-bottom: 0px;
|
||||
}
|
||||
.post img {
|
||||
display: inline-block;
|
||||
border-radius: 10px;
|
||||
}
|
||||
.subg {
|
||||
display: block;
|
||||
/*background-color: #C7CCCA;*/
|
||||
border-radius: 5px;
|
||||
margin-top: 0.5em;
|
||||
margin-left: 15%;
|
||||
margin-right: 15%;
|
||||
padding-left: 5pt;
|
||||
padding-top: 5pt;
|
||||
}
|
||||
.subg a {
|
||||
color: #222;
|
||||
}
|
||||
.subg a:visited {
|
||||
color: #666;
|
||||
}
|
||||
.mail {
|
||||
display: block;
|
||||
margin-top: 0.1em;
|
||||
margin-left: 0.5em;
|
||||
}
|
||||
.text {
|
||||
display: block;
|
||||
margin-left: 0.5em;
|
||||
margin-top: -0.8em;
|
||||
}
|
||||
.headall {
|
||||
text-align: center;
|
||||
display: block;
|
||||
color: #000;
|
||||
background-color: #C7BA6C;
|
||||
border-radius: 5px;
|
||||
width: 75%;
|
||||
position: top;
|
||||
top: 0px;
|
||||
margin-left: 15%;
|
||||
margin-right: 15%;
|
||||
margin-bottom: 0%;
|
||||
}
|
||||
.headall p {
|
||||
margin-top: -1.5em;
|
||||
text-align: center;
|
||||
}
|
||||
.echo {
|
||||
display: block;
|
||||
background-color: #C7BA6C;
|
||||
/*top: 0px;*/
|
||||
border-width: 1;
|
||||
border: solid;
|
||||
border-color: #C7BA6C;
|
||||
border-radius: 5px;
|
||||
/*margin-top: 1em;*/
|
||||
padding: 0.2em;
|
||||
position: fixed;
|
||||
}
|
||||
.echo a {
|
||||
color: #222;
|
||||
}
|
||||
.answer {
|
||||
color: #222;
|
||||
padding: 0.2em;
|
||||
position: relative;
|
||||
}
|
||||
.answer a {
|
||||
color: #222;
|
||||
}
|
||||
.answer a:visited {
|
||||
color: #222;
|
||||
}
|
||||
</STYLE>
|
||||
<body>
|
||||
<div class='headall'>
|
||||
<h1><TMPL_VAR NAME=TITLE></h1>
|
||||
<p>
|
||||
<a href="/get">Получить</a> новые сообщения или
|
||||
<a href="/me">почитать</a> свою переписку. А еще
|
||||
можно <a href="/">вернуться</a> в ленту.
|
||||
</p>
|
||||
</div>
|
||||
<!-- <hr> -->
|
||||
1
t/index.html
Normal file
1
t/index.html
Normal file
@ -0,0 +1 @@
|
||||
<a href=/e?echo=<TMPL_VAR NAME=ECHO>><TMPL_VAR NAME=ECHO></a><br>
|
||||
12
t/new.html
Normal file
12
t/new.html
Normal file
@ -0,0 +1,12 @@
|
||||
<div class=post>
|
||||
<div class=send_form>
|
||||
<form action='/enc' method='GET'><br>
|
||||
Тема: <input type='hidden' name='echo' value="<TMPL_VAR NAME=ECHO>" />
|
||||
<input type='hidden' name='to' value="All" />
|
||||
<input type='text' size=40 name='subg' value=''><br>
|
||||
<textarea name='post' cols=80 rows=12>
|
||||
</textarea><br>
|
||||
<input type='submit' value='постить'>
|
||||
</form>
|
||||
</div>
|
||||
</div>
|
||||
16
t/out.html
Normal file
16
t/out.html
Normal file
@ -0,0 +1,16 @@
|
||||
<div class=post>
|
||||
<h2><TMPL_VAR NAME=SUBG></h2>
|
||||
<div class=mail>
|
||||
<i><TMPL_VAR NAME=TIME></i><br>
|
||||
From: <strong><TMPL_VAR NAME=FROM></strong><br>
|
||||
To: <strong><TMPL_VAR NAME=TO></strong> in <TMPL_VAR NAME=ECHO>
|
||||
</div>
|
||||
<div class=text>
|
||||
<p>
|
||||
<TMPL_VAR NAME=POST>
|
||||
</p>
|
||||
</div>
|
||||
<div class=answer>
|
||||
<a href="/push?echo=<TMPL_VAR NAME=ECHO>&base64=<TMPL_VAR NAME=BASE64>&hash=<TMPL_VAR NAME=HASH>">Отправить</a>
|
||||
</div>
|
||||
</div>
|
||||
16
t/post.html
Normal file
16
t/post.html
Normal file
@ -0,0 +1,16 @@
|
||||
<div class=post>
|
||||
<h2><TMPL_VAR NAME=SUBG></h2>
|
||||
<div class=mail>
|
||||
<i><TMPL_VAR NAME=TIME></i><br>
|
||||
From: <strong><TMPL_VAR NAME=FROM></strong><br>
|
||||
To: <strong><TMPL_VAR NAME=TO></strong> in <TMPL_VAR NAME=ECHO>
|
||||
</div>
|
||||
<div class=text>
|
||||
<p>
|
||||
<TMPL_VAR NAME=POST>
|
||||
</p>
|
||||
</div>
|
||||
<div class=answer>
|
||||
<a href="/send?hash=<TMPL_VAR NAME=HASH>">Ответить на сообщение</a>
|
||||
</div>
|
||||
</div>
|
||||
24
t/send.html
Normal file
24
t/send.html
Normal file
@ -0,0 +1,24 @@
|
||||
<div class=post>
|
||||
<h2><TMPL_VAR NAME=SUBG></h2>
|
||||
<div class=mail>
|
||||
<i><TMPL_VAR NAME=TIME></i><br>
|
||||
From: <strong><TMPL_VAR NAME=FROM></strong><br>
|
||||
To: <strong><TMPL_VAR NAME=TO></strong> in <TMPL_VAR NAME=ECHO>
|
||||
</div>
|
||||
<div class=text>
|
||||
<p>
|
||||
<TMPL_VAR NAME=POST>
|
||||
</p>
|
||||
</div>
|
||||
<div class=send_form>
|
||||
<form action='/enc' method='GET'><br>
|
||||
<input type='hidden' name='echo' value="<TMPL_VAR NAME=ECHO>" />
|
||||
<input type='hidden' name='to' value="<TMPL_VAR NAME=FROM>" />
|
||||
<input type='hidden' name='hash' value="<TMPL_VAR NAME=HASH>" />
|
||||
<input type='text' size=40 name='subg' value='Re: <TMPL_VAR NAME=SUBG>'><br>
|
||||
<textarea name='post' cols=80 rows=12>
|
||||
</textarea><br>
|
||||
<input type='submit'>
|
||||
</form>
|
||||
</div>
|
||||
</div>
|
||||
9
t/tree.html
Normal file
9
t/tree.html
Normal file
@ -0,0 +1,9 @@
|
||||
<div class=subg>
|
||||
<small><i><TMPL_VAR NAME=TIME></i></small> 
|
||||
<a href=/s?subg=<TMPL_VAR NAME=LINK>&echo=<TMPL_VAR NAME=ECHO>><strong><TMPL_VAR NAME=SUBG></strong></a> by
|
||||
<!-- <div class='subg-from'> -->
|
||||
<a href=/u?user=<TMPL_VAR NAME=FROM>><TMPL_VAR NAME=FROM></a>
|
||||
<!-- </div> -->
|
||||
<!-- <div class='subg-time'> -->
|
||||
<!-- </div> -->
|
||||
</div>
|
||||
Loading…
Reference in New Issue
Block a user