Difrex/iiplc
Difrex/iiplc
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Compare commits

base: Difrex:master
Branches Tags
Difrex:master
Difrex:testing
Difrex:V0.2
Difrex:v0.1a
Difrex:v0.1
Difrex:v0.1pre_fix
Difrex:v0.1pre
Difrex:V0.1rc3
Difrex:v0.1rc2
Difrex:v0.1rc1
Difrex:v0.1beta3
Difrex:v0.1beta2a
Difrex:v0.1beta2
Difrex:V0.1beta
..
compare: Difrex:v0.1pre
Branches Tags
Difrex:master
Difrex:testing
Difrex:V0.2
Difrex:v0.1a
Difrex:v0.1
Difrex:v0.1pre_fix
Difrex:v0.1pre
Difrex:V0.1rc3
Difrex:v0.1rc2
Difrex:v0.1rc1
Difrex:v0.1beta3
Difrex:v0.1beta2a
Difrex:v0.1beta2
Difrex:V0.1beta

No commits in common. "master" and "v0.1pre" have entirely different histories.
master ... v0.1pre

14 changed files with 75 additions and 298 deletions
Show Stats Expand all files Collapse all files

8
II/Config.pm
View File

@ -15,16 +15,15 @@ sub new {
sub load {
my ($self) = @_;
my $file = $self->{_file};
my $tiny = Config::Tiny->new();
$config = $tiny->read($file);
my $key = $config->{auth}->{key};
my $nick = $config->{auth}->{nick};
my $host = $config->{node}->{host};
my @echoareas = split /,/, $config->{node}->{echoareas};
my $name = $config->{node}->{name};
my $notify = $config->{notify}->{enabled};
$c = {
nick => $nick,
@ -32,7 +31,6 @@ sub load {
host => $host,
echoareas => [@echoareas],
name => $name,
notify => $notify,
};
return $c;
@ -42,7 +40,7 @@ sub load {
sub reload {
my ($self) = @_;
my $c = II::Config->new();
my $c = II::Config->new();
my $config = $c->load();
return $config;

53
II/DB.pm
View File

@ -2,7 +2,6 @@ package II::DB;
use SQL::Abstract;
use DBI;
use utf8;
use Data::Dumper;
@ -21,7 +20,6 @@ sub new {
return $self;
}
# Check message hash
sub check_hash {
my ( $self, $hash, $echo ) = @_;
my $dbh = $self->{_dbh};
@ -34,13 +32,13 @@ sub check_hash {
my ($base_hash) = @h;
if ( $hash eq $base_hash ) {
return 1;
} else {
}
else {
return 0;
}
}
}
# Begin transaction
sub begin {
my ($self) = @_;
my $dbh = $self->{_dbh};
@ -49,7 +47,6 @@ sub begin {
$dbh->do('BEGIN');
}
# Commit transaction
sub commit {
my ($self) = @_;
my $dbh = $self->{_dbh};
@ -83,16 +80,6 @@ sub write_out {
print "Message writed to DB!\n";
}
sub del_out {
my ( $self, $hash ) = @_;
my $dbh = $self->{_dbh};
my $q = "delete from output where hash='$hash' and send=0";
my $sth = $dbh->prepare($q);
$sth->execute();
$sth->finish();
}
sub update_out {
my ( $self, $hash ) = @_;
my $dbh = $self->{_dbh};
@ -275,7 +262,7 @@ sub echoes {
time => $time,
echo => "$echo",
post => "$post",
hash => $h,
h => $h,
};
push( @posts, $data );
}
@ -292,7 +279,7 @@ sub to_me {
# print "NICK: $nick\n";
my $q
= "select from_user, to_user, subg, time, echo, post, hash from messages where to_user='$nick' order by time desc";
= "select from_user, to_user, subg, time, echo, post, hash from messages where to_user='$nick'";
my $sth = $dbh->prepare($q);
$sth->execute();
@ -343,36 +330,4 @@ sub select_new {
return $data;
}
# Search
sub do_search {
my ( $self, $query ) = @_;
my $dbh = $self->{_dbh};
my $q = "select from_user, to_user, subg, time, echo, post, hash
from messages where subg
like '\%$query\%' COLLATE NOCASE
order by time";
print "SQL: " . $q . "\n";
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;
}
1;

6
II/Get.pm
View File

@ -145,12 +145,6 @@ sub get_echo {
# Commit transaction
$db->commit();
print localtime() . ": messages writed to DB!\n";
# Notify
my @notify_cmd = ('notify-send', 'Сеть ii', 'Есть новые сообщения');
if ($notify == 1) {
system(@notify_cmd) == 0 or warn "Cannot send notify: $!\n";
}
}
return $msgs;
}

94
II/Render.pm
View File

@ -8,9 +8,9 @@ use Data::Dumper;
sub new {
my $class = shift;
my $db = II::DB->new();
my $t = II::T->new();
my $c = II::Config->new();
my $db = II::DB->new();
my $t = II::T->new();
my $c = II::Config->new();
my $config = $c->load();
my $self = {
@ -25,14 +25,14 @@ sub new {
sub thread {
my ( $self, $subg, $echo ) = @_;
my $db = $self->{_db};
my $t = $self->{_template};
my $db = $self->{_db};
my $t = $self->{_template};
my $config = $self->{_config};
my @post = $db->thread( $subg, $echo );
# Render header
my $render = $t->head( "ii " . $config->{name} . " :: $echo" );
my $render = $t->head("ii ". $config->{name} ." :: $echo");
my $count = 0;
while ( $count < @post ) {
$render .= $t->post( @post[$count] );
@ -54,9 +54,7 @@ sub out {
# Render header
my $render
= $t->head( 'ii '
. $config->{name}
. ' :: неотправленные сообщения' );
= $t->head('ii '. $config->{name} .' :: неотправленные сообщения');
my $count = 0;
while ( $count < @post ) {
@ -71,14 +69,14 @@ sub out {
sub echo_mes {
my ( $self, $echo, $view ) = @_;
my $db = $self->{_db};
my $t = $self->{_template};
my $db = $self->{_db};
my $t = $self->{_template};
my $config = $self->{_config};
my @post = $db->echoes($echo);
# Render header
my $render = $t->head( "ii " . $config->{name} . " :: $echo" );
my $render = $t->head("ii ". $config->{name} ." :: $echo");
$render .= $t->echo($echo);
my $count = 0;
@ -93,23 +91,11 @@ sub echo_mes {
$count++;
}
}
elsif ( $view eq 'all' ) {
while ( $count < @post ) {
# Render post
if ( !( @post[$count]->{subg} =~ /Re.+/ ) ) {
$render .= $t->post( @post[$count] );
}
$count++;
}
}
else {
while ( ( $count < @post ) and ( $count < 50 ) ) {
while ( $count < @post ) {
$render .= $t->post( @post[$count] );
$count++;
}
$render .= $t->all($echo);
}
$render .= $t->foot();
@ -119,16 +105,15 @@ sub echo_mes {
sub to_me {
my ( $self, $config ) = @_;
my $db = $self->{_db};
my $t = $self->{_template};
my $db = $self->{_db};
my $t = $self->{_template};
my $config = $self->{_config};
my @post = $db->to_me($config);
my @post_from_me = $db->from_me($config);
# Render header
my $render = $t->head(
'ii ' . $config->{name} . ' :: Моя переписка' );
my $render = $t->head('ii '. $config->{name} .' :: Моя переписка');
my $count = 0;
while ( $count < @post ) {
@ -158,7 +143,7 @@ sub index {
my @hashes = $db->select_index(50);
# Render header
my $render = $t->head( 'ii ' . $config->{name} . ' :: Лента' );
my $render = $t->head('ii '. $config->{name} .' :: Лента');
$render .= $t->index($echoareas);
while (<@hashes>) {
@ -176,15 +161,13 @@ sub index {
# Messages from user
sub user {
my ( $self, $user ) = @_;
my $db = $self->{_db};
my $t = $self->{_template};
my $db = $self->{_db};
my $t = $self->{_template};
my $config = $self->{_config};
# Render header
my $render
= $t->head( "ii "
. $config->{name}
. " :: Сообщения пользователя $user" );
= $t->head("ii ". $config->{name} ." :: Сообщения пользователя $user");
my @post = $db->select_user($user);
@ -202,11 +185,10 @@ sub user {
# Render new message form
sub send_new {
my ( $self, $echo ) = @_;
my $t = $self->{_template};
my $t = $self->{_template};
my $config = $self->{_config};
my $render = $t->head(
"ii " . $config->{name} . " :: Новое сообщение" );
my $render = $t->head("ii ". $config->{name} ." :: Новое сообщение");
$render .= $t->new_mes($echo);
$render .= $t->foot();
@ -217,12 +199,11 @@ sub send_new {
# Render send form
sub send {
my ( $self, $hash ) = @_;
my $db = $self->{_db};
my $t = $self->{_template};
my $db = $self->{_db};
my $t = $self->{_template};
my $config = $self->{_config};
my $render
= $t->head( "ii" . $config->{name} . " :: Ответ на $hash" );
my $render = $t->head("ii". $config->{name} ." :: Ответ на $hash");
# Render post
my $data = $db->select_new($hash);
@ -236,12 +217,11 @@ sub send {
# Render new messages
sub new_mes {
my ( $self, $msgs ) = @_;
my $db = $self->{_db};
my $t = $self->{_template};
my $db = $self->{_db};
my $t = $self->{_template};
my $config = $self->{_config};
my $render = $t->head(
'ii ' . $config->{name} . ' :: Новые сообщения' );
my $render = $t->head('ii '. $config->{name} .' :: Новые сообщения');
# Render posts
if ( defined($msgs) ) {
@ -263,26 +243,4 @@ sub new_mes {
return $render;
}
# Search results
sub search {
my ( $self, @post ) = @_;
my $t = $self->{_template};
# Render header
my $render
= $t->head(
"ii " . $config->{name} . " :: Результаты поиска" );
my $count = 0;
while ( $count < @post ) {
# Render post
$render .= $t->post( @post[$count] );
$count++;
}
$render .= $t->foot();
return $render;
}
1;

2
II/Send.pm
View File

@ -31,7 +31,7 @@ sub send {
my $host = $config->{host};
my $auth = $config->{key};
$host .= "u/point";
my $ua = LWP::UserAgent->new(agent => 'Mozilla/5.0 (X11; Linux x86_64; rv:35.0) Gecko/20100101 Firefox/35.0');
my $ua = LWP::UserAgent->new();
my $response
= $ua->post( $host, { 'pauth' => $auth, 'tmsg' => $base64 } );

62
II/T.pm
View File

@ -1,8 +1,6 @@
package II::T;
use HTML::Template;
use HTML::FromText ();
use Encode;
use Data::Dumper;
sub new {
@ -149,7 +147,7 @@ sub send {
# Preparsing before input to SQL
sub in_pre {
my ( $self, $post ) = @_;
my ($self, $post) = @_;
$post =~ s/'/\\'/g;
$post =~ s/"/\\"/g;
@ -164,38 +162,23 @@ sub in_pre {
sub pre {
my ( $self, $post ) = @_;
my $t2h = HTML::FromText->new(
{ paras => 1,
bullets => 1,
lines => 1,
blockcode => 1,
tables => 0,
numbers => 0,
urls => 0,
email => 1,
bold => 1,
underline => 1,
}
);
$post = $t2h->parse( decode_utf8($post) );
$post =~ s/</&lt;/g;
$post =~ s/>/&gt;/g;
$post =~ s/&gt;(.+)/<font color='green'>>$1<\/font>/g;
$post =~ s/--/&mdash;/g;
# Lists
$post =~ s/\*(.+)/<li>$1<\/li>/g;
$post =~ s/.?\*(.+)\*.?/&nbsp<b>$1<\/b>&nbsp/g;
# Images
$post
=~ s/\[img (.+)\]/<a href="$1"><img src="$1" width="15%" height="15%" \/><\/a>/g;
$post =~ s/\[img (.+)\]/<a href="$1"><img src="$1" width="15%" height="15%" \/><\/a>/g;
# ii uri
$post =~ s/ii:\/\/(\w+(\.)?\w+\.\d{2,4})/<a href="\/e?echo=$1&view=thread">$1<\/a>/g;
$post =~ s/ii:\/\/(\w{20})/<a href="\/send?hash=$1">$1<\/a>/g;
# Users
# $post =~ s/.+? \@(\w+)(.?.+)/<a href="\/u?user=$1">$1<\/a>$2/g;
$post =~ s/ii:\/\/(.{20})/<a href="\/send?hash=$1">$1<\/a>/g;
# $post =~ s/ii:\/\/(.+\.\d+)/<a href="\/e?echo=$1&view=thread">$1<\/a>/g;
$post =~ s/^$/<br>\n/g;
$post =~ s/(.?)\n/$1<br>\n/g;
$post =~ s/\*(.+)/<li>$1<\/li>\n/g;
# Not are regexp parsing
my $pre = 0;
my $txt;
@ -203,7 +186,7 @@ sub pre {
while (<$fh>) {
my $line = $_;
if ( ( $line =~ /^====/ ) and ( $pre == 0 ) ) {
# $txt .= $_;
$line =~ s/====/<pre class="pre">/g;
$pre = 1;
}
@ -212,27 +195,12 @@ sub pre {
$pre = 0;
}
$txt .= $line;
$txt =~ s/<br \/>//g if $pre == 1;
$txt =~ s/<li>//g if $pre == 1;
$txt =~ s/<\/li>//g if $pre == 1;
$txt =~ s/<font.+>(>.+)<\/font>/$1/g if $pre == 1;
}
close $fh;
$txt =~ s/\n/<br>/g;
return $txt;
}
# All messages footer
sub all {
my ( $self, $echo ) = @_;
my $a = HTML::Template->new( filename => 't/all.html' );
$a->param( ECHO => $echo );
return $a->output();
}
# Footer
sub foot {
my ($self) = @_;

6
README.md
View File

@ -19,9 +19,13 @@ Install packages.
On Debian based systems:
apt-get install libplack-perl libhtml-template-perl libsql-abstract-perl \
libdbd-sqlite3-perl libconfig-tiny-perl libhtml-fromtext-perl
libdbd-sqlite3-perl libconfig-tiny-perl
## Run
cd /path/to/iiplc
./run.sh
## TODO
* Check link before send

84
iiplc.app Executable file → Normal file
View File

@ -1,5 +1,5 @@
#!/usr/bin/perl
# Copyright © 2014-2015 Difrex <difrex.punk@gmail.com>
# Copyright © 2014 Difrex <difrex.punk@gmail.com>
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
@ -19,7 +19,6 @@ use warnings;
use Plack::Builder;
use Plack::Request;
use Plack::Response;
# Static files
use Plack::App::File;
@ -30,9 +29,13 @@ 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 {
@ -61,21 +64,8 @@ my $thread = sub {
return [ 200, [ 'Content-type' => 'text/html' ], ["$thread"], ];
};
# Get new messages
my $get = sub {
$config = $c->reload();
my $msgs;
if ( $config->{host} =~ m/.+\,.+/ ) {
my @hosts = split( /,/, $config->{host} );
foreach my $host (@hosts) {
$config->{host} = $host;
my $GET = II::Get->new($config);
$msgs .= $GET->get_echo();
}
} else {
my $GET = II::Get->new($config);
$msgs .= $GET->get_echo();
}
my $msgs = $GET->get_echo();
my $new_mes = $render->new_mes($msgs);
return [ 200, [ 'Content-type' => 'text/html' ], ["$new_mes"], ];
};
@ -165,10 +155,6 @@ my $push = sub {
my $hash = $req->param('hash');
$config = $c->reload();
if ( $config->{host} =~ m/.+\,.+/ ) {
my @hosts = split( /,/, $config->{host} );
$config->{host} = $hosts[0];
}
my $s = II::Send->new( $config, $echo, $base64 );
$s->send($hash);
@ -189,51 +175,19 @@ my $user = sub {
return [ 200, [ 'Content-type' => 'text/html' ], [$mes_from], ];
};
# Search
########
my $search = sub {
my $env = shift;
my $req = Plack::Request->new($env);
my $query = $req->param('q');
my $db = II::DB->new();
my @post = $db->do_search($query);
my $result = $render->search(@post);
return [ 200, [ 'Content-type' => 'text/html' ], [$result], ];
};
# Delete out message
####################
my $del = sub {
my $env = shift;
my $req = Plack::Request->new($env);
my $hash = $req->param('hash');
my $db = II::DB->new();
$db->del_out($hash);
return [301, ['Location' => '/out'], [], ];
};
# Mountpoints
builder {
mount "/static" => Plack::App::File->new( root => './s/' )->to_app;
mount "/search" => $search;
mount '/' => $root;
mount '/e' => $echo;
mount '/s' => $thread;
mount '/u' => $user;
mount '/me' => $me;
mount '/tree' => $tree;
mount '/get/' => $get;
mount '/send' => $send;
mount '/enc' => $enc;
mount '/out' => $out;
mount '/push' => $push;
mount '/new' => $new;
mount '/del' => $del;
mount "/static" => Plack::App::File->new(root => './s/')->to_app;
mount '/' => $root;
mount '/e' => $echo;
mount '/s' => $thread;
mount '/u' => $user;
mount '/me' => $me;
mount '/tree' => $tree;
mount '/get/' => $get;
mount '/send' => $send;
mount '/enc' => $enc;
mount '/out' => $out;
mount '/push' => $push;
mount '/new' => $new;
};

1
run.sh
View File

@ -2,7 +2,6 @@
# Debug server
screen -S ii plackup iiplc.app
# plackup iiplc.app
# Production
# starman -l 127.0.0.1:5000 run.pl whatever

40
s/css/default.css
View File

@ -39,15 +39,6 @@ padding-bottom: 0.15em;
padding-left: 5pt;
padding-top: 5pt;
}
.msg_hash {
float: right;
margin-right: 1.5em;
margin-top: 2em;
color: #222;
opacity: 0.4;
font-family: monospace;
font-size: 8pt;
}
.subg a {
color: #222;
}
@ -157,35 +148,4 @@ margin-bottom: 0%;
border-color: #666;
background-color: #C9C9C9;
margin-right: 5%;
}
.all_link {
display: block;
border-style: solid;
border-width: 1px;
border-color: #999;
border-radius: 5px;
background-color: #C9C9C9;
box-shadow: 0 0 5px rgba(0, 0, 0, 0.7);
text-align: center;
text-decoration: underline;
font-size: 12pt;
color: #222;
width: 8em;
padding: 0.2em;
margin-left: 45%;
margin-right: 55%;
}
/* Search */
.search {
position: fixed;
top: 2em;
left: 0.5em;
opacity: 0.4;
transition-duration: 0.5s;
-webkit-transition-duration: 0.5s;
}
.search:hover {
opacity: 1;
transition-duration: 0.5s;
-webkit-transition-duration: 0.5s;
}

3
t/all.html
View File

@ -1,3 +0,0 @@
<a class='all_link' href="e?echo=<TMPL_VAR NAME=ECHO>&view=all">
Все сообщения
</a>

6
t/head.html
View File

@ -15,10 +15,4 @@
<b>[</b> <a href="/out">неотправленные сообщения</a> <b>]</b>&nbsp
</p>
</div>
<div class='search'>
<form action='/search' method='POST'>
<input type='text' name='q'><br>
<input type='submit' value='Искать'>
</form>
</div>
<!-- <hr> -->

3
t/out.html
View File

@ -12,6 +12,5 @@
</div>
<div class=answer>
<a href="/push?echo=<TMPL_VAR NAME=ECHO>&base64=<TMPL_VAR NAME=BASE64>&hash=<TMPL_VAR NAME=HASH>">Отправить</a>
<a href="/del?hash=<TMPL_VAR NAME=HASH>">Удалить</a>
</div>
</div>
</div>

5
t/post.html
View File

@ -1,7 +1,4 @@
<div class=post>
<div class='msg_hash'>
MsgID: <TMPL_VAR NAME=HASH>
</div>
<a style="text-decoration:none;" href="/s?subg=<TMPL_VAR NAME=CUT>&echo=<TMPL_VAR NAME=ECHO>"><h2><TMPL_VAR NAME=SUBG></h2></a>
<div class=mail>
<i><TMPL_VAR NAME=TIME></i><br>
@ -16,4 +13,4 @@
<div class=answer>
<a href="/send?hash=<TMPL_VAR NAME=HASH>">Ответить на сообщение</a>
</div>
</div>
</div>